diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h --- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h +++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h @@ -67,10 +67,7 @@ : mlir::Value(variable.getBase()) {} bool isValue() const { return isFortranValue(*this); } bool isVariable() const { return !isValue(); } - bool isMutableBox() const { - mlir::Type type = fir::dyn_cast_ptrEleTy(getType()); - return type && type.isa(); - } + bool isMutableBox() const { return hlfir::isBoxAddressType(getType()); } bool isArray() const { mlir::Type type = fir::unwrapPassByRefType(fir::unwrapRefType(getType())); if (type.isa()) @@ -82,11 +79,7 @@ bool isScalar() const { return !isArray(); } mlir::Type getFortranElementType() const { - mlir::Type type = fir::unwrapSequenceType( - fir::unwrapPassByRefType(fir::unwrapRefType(getType()))); - if (auto exprType = type.dyn_cast()) - return exprType.getEleTy(); - return type; + return hlfir::getFortranElementType(getType()); } bool hasLengthParameters() const { diff --git a/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h b/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h --- a/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h +++ b/flang/include/flang/Optimizer/HLFIR/HLFIRDialect.h @@ -14,6 +14,7 @@ #ifndef FORTRAN_OPTIMIZER_HLFIR_HLFIRDIALECT_H #define FORTRAN_OPTIMIZER_HLFIR_HLFIRDIALECT_H +#include "flang/Optimizer/Dialect/FIRType.h" #include "mlir/IR/Dialect.h" namespace hlfir { @@ -29,4 +30,38 @@ #define GET_ATTRDEF_CLASSES #include "flang/Optimizer/HLFIR/HLFIRAttributes.h.inc" +namespace hlfir { +/// Get the element type of a Fortran entity type. +inline mlir::Type getFortranElementType(mlir::Type type) { + type = fir::unwrapSequenceType( + fir::unwrapPassByRefType(fir::unwrapRefType(type))); + if (auto exprType = type.dyn_cast()) + return exprType.getEleTy(); + if (auto boxCharType = type.dyn_cast()) + return boxCharType.getEleTy(); + return type; +} + +/// If this is the type of a Fortran array entity, get the related +/// fir.array type. Otherwise, returns the Fortran element typeof the entity. +inline mlir::Type getFortranElementOrSequenceType(mlir::Type type) { + type = fir::unwrapPassByRefType(fir::unwrapRefType(type)); + if (auto exprType = type.dyn_cast()) { + if (exprType.isArray()) + return fir::SequenceType::get(exprType.getShape(), exprType.getEleTy()); + return exprType.getEleTy(); + } + if (auto boxCharType = type.dyn_cast()) + return boxCharType.getEleTy(); + return type; +} + +/// Is this a fir.box or fir.class address type? +inline bool isBoxAddressType(mlir::Type type) { + type = fir::dyn_cast_ptrEleTy(type); + return type && type.isa(); +} + +} // namespace hlfir + #endif // FORTRAN_OPTIMIZER_HLFIR_HLFIRDIALECT_H diff --git a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td --- a/flang/include/flang/Optimizer/HLFIR/HLFIROps.td +++ b/flang/include/flang/Optimizer/HLFIR/HLFIROps.td @@ -133,4 +133,79 @@ }]; } +def hlfir_DesignateOp : hlfir_Op<"designate", [AttrSizedOperandSegments, + DeclareOpInterfaceMethods]> { + let summary = "Designate a Fortran variable"; + + let description = [{ + This operation represents a Fortran "part-ref", except that it can embed a + substring or or complex part directly, and that vector subscripts cannot be + used. It returns a Fortran variable that is a part of the input variable. + + The operands are as follow: + - memref is the variable being designated. + - component may be provided if the memref is a derived type to + represent a reference to a component. It must be the name of a + component of memref derived type. + - component_shape represents the shape of the component and must be + provided if and only if both component and indices appear. + - indices can be provided to index arrays. The indices may be simple + indices or triplets. + If indices are provided and there is a component, the component must be + an array component and the indices index the array component. + If memref is an array, and component is provided and is an array + component, indices must be provided and must not be triplets. This + ensures hlfir.designate does not create arrays of arrays (which is not + possible in Fortran). + - substring may contain two values to represent a substring lower and + upper bounds. + - complex_part may be provided to represent a complex part (true + represents the imaginary part, and false the real part). + - shape represents the shape of the result and must be provided if the + result is an array that is not a box address. + - typeparams represents the length parameters of the result and must be + provided if the result type has length parameters and is not a box + address. + }]; + + let arguments = (ins AnyFortranVariable:$memref, + OptionalAttr:$component, + Optional:$component_shape, + Variadic:$indices, + DenseBoolArrayAttr:$is_triplet, + Variadic:$substring, + OptionalAttr:$complex_part, + Optional:$shape, + Variadic:$typeparams, + OptionalAttr:$fortran_attrs + ); + + let results = (outs AnyFortranVariable); + + let assemblyFormat = [{ + $memref (`{` $component^ `}`)? (`<` $component_shape^ `>`)? + custom($indices, $is_triplet) + (`substr` $substring^)? + custom($complex_part) + (`shape` $shape^)? (`typeparams` $typeparams^)? + attr-dict `:` functional-type(operands, results) + }]; + + let extraClassDeclaration = [{ + using Triplet = std::tuple; + using Subscript = std::variant; + }]; + + let builders = [ + OpBuilder<(ins "mlir::Type":$result_type, "mlir::Value":$memref, + "llvm::StringRef":$component, "mlir::Value":$component_shape, + "llvm::ArrayRef>>":$subscripts, + CArg<"mlir::ValueRange", "{}">:$substring, + CArg<"llvm::Optional", "{}">:$complex_part, + CArg<"mlir::Value", "{}">:$shape, CArg<"mlir::ValueRange", "{}">:$typeparams, + CArg<"fir::FortranVariableFlagsAttr", "{}">:$fortran_attrs)>]; + + let hasVerifier = 1; +} + #endif // FORTRAN_DIALECT_HLFIR_OPS diff --git a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp --- a/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp +++ b/flang/lib/Optimizer/HLFIR/IR/HLFIROps.cpp @@ -79,5 +79,263 @@ return fortranVar.verifyDeclareLikeOpImpl(getMemref()); } +//===----------------------------------------------------------------------===// +// DesignateOp +//===----------------------------------------------------------------------===// + +void hlfir::DesignateOp::build( + mlir::OpBuilder &builder, mlir::OperationState &result, + mlir::Type result_type, mlir::Value memref, llvm::StringRef component, + mlir::Value component_shape, llvm::ArrayRef subscripts, + mlir::ValueRange substring, llvm::Optional complex_part, + mlir::Value shape, mlir::ValueRange typeparams, + fir::FortranVariableFlagsAttr fortran_attrs) { + auto componentAttr = + component.empty() ? mlir::StringAttr{} : builder.getStringAttr(component); + llvm::SmallVector indices; + llvm::SmallVector isTriplet; + for (auto subscript : subscripts) { + if (auto *triplet = std::get_if(&subscript)) { + isTriplet.push_back(true); + indices.push_back(std::get<0>(*triplet)); + indices.push_back(std::get<1>(*triplet)); + indices.push_back(std::get<2>(*triplet)); + } else { + isTriplet.push_back(false); + indices.push_back(std::get(subscript)); + } + } + auto isTripletAttr = + mlir::DenseBoolArrayAttr::get(builder.getContext(), isTriplet); + auto complexPartAttr = + complex_part.has_value() + ? mlir::BoolAttr::get(builder.getContext(), *complex_part) + : mlir::BoolAttr{}; + build(builder, result, result_type, memref, componentAttr, component_shape, + indices, isTripletAttr, substring, complexPartAttr, shape, typeparams, + fortran_attrs); +} + +static mlir::ParseResult parseDesignatorIndices( + mlir::OpAsmParser &parser, + llvm::SmallVectorImpl &indices, + mlir::DenseBoolArrayAttr &isTripletAttr) { + llvm::SmallVector isTriplet; + if (mlir::succeeded(parser.parseOptionalLParen())) { + do { + mlir::OpAsmParser::UnresolvedOperand i1, i2, i3; + if (parser.parseOperand(i1)) + return mlir::failure(); + indices.push_back(i1); + if (mlir::succeeded(parser.parseOptionalColon())) { + if (parser.parseOperand(i2) || parser.parseColon() || + parser.parseOperand(i3)) + return mlir::failure(); + indices.push_back(i2); + indices.push_back(i3); + isTriplet.push_back(true); + } else { + isTriplet.push_back(false); + } + } while (mlir::succeeded(parser.parseOptionalComma())); + if (parser.parseRParen()) + return mlir::failure(); + } + isTripletAttr = mlir::DenseBoolArrayAttr::get(parser.getContext(), isTriplet); + return mlir::success(); +} + +static void +printDesignatorIndices(mlir::OpAsmPrinter &p, hlfir::DesignateOp designateOp, + mlir::OperandRange indices, + const mlir::DenseBoolArrayAttr &isTripletAttr) { + if (!indices.empty()) { + p << '('; + unsigned i = 0; + for (auto isTriplet : isTripletAttr.asArrayRef()) { + if (isTriplet) { + assert(i + 2 < indices.size() && "ill-formed indices"); + p << indices[i] << ":" << indices[i + 1] << ":" << indices[i + 2]; + i += 3; + } else { + p << indices[i++]; + } + if (i != indices.size()) + p << ", "; + } + p << ')'; + } +} + +static mlir::ParseResult +parseDesignatorComplexPart(mlir::OpAsmParser &parser, + mlir::BoolAttr &complexPart) { + if (mlir::succeeded(parser.parseOptionalKeyword("imag"))) + complexPart = mlir::BoolAttr::get(parser.getContext(), true); + else if (mlir::succeeded(parser.parseOptionalKeyword("real"))) + complexPart = mlir::BoolAttr::get(parser.getContext(), false); + return mlir::success(); +} + +static void printDesignatorComplexPart(mlir::OpAsmPrinter &p, + hlfir::DesignateOp designateOp, + mlir::BoolAttr complexPartAttr) { + if (complexPartAttr) { + if (complexPartAttr.getValue()) + p << "imag"; + else + p << "real"; + } +} + +mlir::LogicalResult hlfir::DesignateOp::verify() { + mlir::Type memrefType = getMemref().getType(); + mlir::Type baseType = getFortranElementOrSequenceType(memrefType); + mlir::Type baseElementType = fir::unwrapSequenceType(baseType); + unsigned numSubscripts = getIsTriplet().size(); + unsigned subscriptsRank = + llvm::count_if(getIsTriplet(), [](bool isTriplet) { return isTriplet; }); + unsigned outputRank = 0; + mlir::Type outputElementType; + bool hasBoxComponent; + if (getComponent()) { + auto component = getComponent().value(); + auto recType = baseElementType.dyn_cast(); + if (!recType) + return emitOpError( + "component must be provided only when the memref is a derived type"); + unsigned fieldIdx = recType.getFieldIndex(component); + if (fieldIdx > recType.getNumFields()) { + return emitOpError("component ") + << component << " is not a component of memref element type " + << recType; + } + mlir::Type fieldType = recType.getType(fieldIdx); + mlir::Type componentBaseType = getFortranElementOrSequenceType(fieldType); + hasBoxComponent = fieldType.isa(); + if (componentBaseType.isa() && + baseType.isa() && + (numSubscripts == 0 || subscriptsRank > 0)) + return emitOpError("indices must be provided and must not contain " + "triplets when both memref and component are arrays"); + if (numSubscripts != 0) { + if (!componentBaseType.isa()) + return emitOpError("indices must not be provided if component appears " + "and is not an array component"); + if (!getComponentShape()) + return emitOpError( + "component_shape must be provided when indexing a component"); + mlir::Type compShapeType = getComponentShape().getType(); + unsigned componentRank = + componentBaseType.cast().getDimension(); + auto shapeType = compShapeType.dyn_cast(); + auto shapeShiftType = compShapeType.dyn_cast(); + if (!((shapeType && shapeType.getRank() == componentRank) || + (shapeShiftType && shapeShiftType.getRank() == componentRank))) + return emitOpError("component_shape must be a fir.shape or " + "fir.shapeshift with the rank of the component"); + if (numSubscripts > componentRank) + return emitOpError("indices number must match array component rank"); + } + if (auto baseSeqType = baseType.dyn_cast()) + // This case must come first to cover "array%array_comp(i, j)" that has + // subscripts for the component but whose rank come from the base. + outputRank = baseSeqType.getDimension(); + else if (numSubscripts != 0) + outputRank = subscriptsRank; + else if (auto componentSeqType = + componentBaseType.dyn_cast()) + outputRank = componentSeqType.getDimension(); + outputElementType = fir::unwrapSequenceType(componentBaseType); + } else { + outputElementType = baseElementType; + unsigned baseTypeRank = + baseType.isa() + ? baseType.cast().getDimension() + : 0; + if (numSubscripts != 0) { + if (baseTypeRank != numSubscripts) + return emitOpError("indices number must match memref rank"); + outputRank = subscriptsRank; + } else if (auto baseSeqType = baseType.dyn_cast()) { + outputRank = baseSeqType.getDimension(); + } + } + + if (!getSubstring().empty()) { + if (!outputElementType.isa()) + return emitOpError("memref or component must have character type if " + "substring indices are provided"); + if (getSubstring().size() != 2) + return emitOpError("substring must contain 2 indices when provided"); + } + if (getComplexPart()) { + if (!fir::isa_complex(outputElementType)) + return emitOpError("memref or component must have complex type if " + "complex_part is provided"); + if (auto firCplx = outputElementType.dyn_cast()) + outputElementType = firCplx.getElementType(); + else + outputElementType = + outputElementType.cast().getElementType(); + } + mlir::Type resultBaseType = + getFortranElementOrSequenceType(getResult().getType()); + unsigned resultRank = 0; + if (auto resultSeqType = resultBaseType.dyn_cast()) + resultRank = resultSeqType.getDimension(); + if (resultRank != outputRank) + return emitOpError("result type rank is not consistent with operands, " + "expected rank ") + << outputRank; + mlir::Type resultElementType = fir::unwrapSequenceType(resultBaseType); + // result type must match the one that was inferred here, except the character + // length may differ because of substrings. + if (resultElementType != outputElementType && + !(resultElementType.isa() && + outputElementType.isa())) + return emitOpError( + "result element type is not consistent with operands, expected ") + << outputElementType; + + if (isBoxAddressType(getResult().getType())) { + if (!hasBoxComponent || numSubscripts != 0 || !getSubstring().empty() || + getComplexPart()) + return emitOpError( + "result type must only be a box address type if it designates a " + "component that is a fir.box or fir.class and if there are no " + "indices, substrings, and complex part"); + + } else { + if ((resultRank == 0) != !getShape()) + return emitOpError("shape must be provided if and only if the result is " + "an array that is not a box address"); + if (resultRank != 0) { + auto shapeType = getShape().getType().dyn_cast(); + auto shapeShiftType = + getShape().getType().dyn_cast(); + if (!((shapeType && shapeType.getRank() == resultRank) || + (shapeShiftType && shapeShiftType.getRank() == resultRank))) + return emitOpError("shape must be a fir.shape or fir.shapeshift with " + "the rank of the result"); + } + auto numLenParam = getTypeparams().size(); + if (outputElementType.isa()) { + if (numLenParam != 1) + return emitOpError("must be provided one length parameter when the " + "result is a character"); + } else if (fir::isRecordWithTypeParameters(outputElementType)) { + if (numLenParam != + outputElementType.cast().getNumLenParams()) + return emitOpError("must be provided the same number of length " + "parameters as in the result derived type"); + } else if (numLenParam != 0) { + return emitOpError("must not be provided length parameters if the result " + "type does not have length parameters"); + } + } + return mlir::success(); +} + #define GET_OP_CLASSES #include "flang/Optimizer/HLFIR/HLFIROps.cpp.inc" diff --git a/flang/test/HLFIR/designate.fir b/flang/test/HLFIR/designate.fir new file mode 100644 --- /dev/null +++ b/flang/test/HLFIR/designate.fir @@ -0,0 +1,135 @@ +// Test hlfir.designate operation parse, verify (no errors), and unparse. + +// RUN: fir-opt %s | fir-opt | FileCheck %s + +// array(1) +func.func @array_ref(%arg0 : !fir.ref>) { + %c1 = arith.constant 1 : index + %0 = hlfir.designate %arg0 (%c1) : (!fir.ref>, index) -> !fir.ref + return +} +// CHECK-LABEL: func.func @array_ref( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>) { +// CHECK: %[[VAL_1:.*]] = arith.constant 1 : index +// CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_0]] (%[[VAL_1]]) : (!fir.ref>, index) -> !fir.ref + +// array(1, 2:3:4, 5) +func.func @array_section(%arg0 : !fir.box>) { + %c1 = arith.constant 1 : index + %c2 = arith.constant 2 : index + %c3 = arith.constant 3 : index + %c4 = arith.constant 4 : index + %c5 = arith.constant 5 : index + %shape = fir.undefined !fir.shape<1> + %0 = hlfir.designate %arg0 (%c1, %c2:%c3:%c4, %c5) shape %shape: (!fir.box>, index, index, index, index, index, !fir.shape<1>) -> !fir.box> + return +} +// CHECK-LABEL: func.func @array_section( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.box>) { +// CHECK: %[[VAL_1:.*]] = arith.constant 1 : index +// CHECK: %[[VAL_2:.*]] = arith.constant 2 : index +// CHECK: %[[VAL_3:.*]] = arith.constant 3 : index +// CHECK: %[[VAL_4:.*]] = arith.constant 4 : index +// CHECK: %[[VAL_5:.*]] = arith.constant 5 : index +// CHECK: %[[VAL_6:.*]] = fir.undefined !fir.shape<1> +// CHECK: %[[VAL_7:.*]] = hlfir.designate %[[VAL_0]] (%[[VAL_1]], %[[VAL_2]]:%[[VAL_3]]:%[[VAL_4]], %[[VAL_5]]) shape %[[VAL_6]] : (!fir.box>, index, index, index, index, index, !fir.shape<1>) -> !fir.box> + +// array%comp +func.func @component_ref(%arg0 : !fir.box>>) { + %shape = fir.undefined !fir.shape<1> + %0 = hlfir.designate %arg0 {"i"} shape %shape: (!fir.box>>, !fir.shape<1>) -> !fir.box> + return +} +// CHECK-LABEL: func.func @component_ref( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.box>>) { +// CHECK: %[[VAL_1:.*]] = fir.undefined !fir.shape<1> +// CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_0]]{"i"} shape %[[VAL_1]] : (!fir.box>>, !fir.shape<1>) -> !fir.box> + +// array%array_comp(1) +func.func @component_array_ref(%arg0 : !fir.box}>>>) { + %c1 = arith.constant 1 : index + %component_shape = fir.undefined !fir.shapeshift<1> + %result_shape = fir.undefined !fir.shape<1> + %0 = hlfir.designate %arg0 {"array_comp"}<%component_shape>(%c1) shape %result_shape : (!fir.box}>>>, !fir.shapeshift<1>, index, !fir.shape<1>) -> !fir.box> + return +} +// CHECK-LABEL: func.func @component_array_ref( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.box}>>>) { +// CHECK: %[[VAL_1:.*]] = arith.constant 1 : index +// CHECK: %[[VAL_2:.*]] = fir.undefined !fir.shapeshift<1> +// CHECK: %[[VAL_3:.*]] = fir.undefined !fir.shape<1> +// CHECK: %[[VAL_4:.*]] = hlfir.designate %[[VAL_0]]{"array_comp"} <%[[VAL_2]]> (%[[VAL_1]]) shape %[[VAL_3]] : (!fir.box}>>>, !fir.shapeshift<1>, index, !fir.shape<1>) -> !fir.box> + +// char(3:4) +func.func @substring(%arg0 : !fir.boxchar<1>) { + %c2 = arith.constant 2 : index + %c3 = arith.constant 3 : index + %c4 = arith.constant 4 : index + %0 = hlfir.designate %arg0 substr %c3, %c4 typeparams %c2: (!fir.boxchar<1>, index, index, index) -> !fir.boxchar<1> + return +} +// CHECK-LABEL: func.func @substring( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1>) { +// CHECK: %[[VAL_1:.*]] = arith.constant 2 : index +// CHECK: %[[VAL_2:.*]] = arith.constant 3 : index +// CHECK: %[[VAL_3:.*]] = arith.constant 4 : index +// CHECK: %[[VAL_4:.*]] = hlfir.designate %[[VAL_0]] substr %[[VAL_2]], %[[VAL_3]] typeparams %[[VAL_1]] : (!fir.boxchar<1>, index, index, index) -> !fir.boxchar<1> + +// char_array(3:4) +func.func @array_substring(%arg0 : !fir.box>>) { + %c2 = arith.constant 2 : index + %c3 = arith.constant 3 : index + %c4 = arith.constant 4 : index + %shape = fir.undefined !fir.shape<1> + %0 = hlfir.designate %arg0 substr %c3, %c4 shape %shape typeparams %c2 : (!fir.box>>, index, index, !fir.shape<1>, index) -> !fir.box>> + return +} +// CHECK-LABEL: func.func @array_substring( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.box>>) { +// CHECK: %[[VAL_1:.*]] = arith.constant 2 : index +// CHECK: %[[VAL_2:.*]] = arith.constant 3 : index +// CHECK: %[[VAL_3:.*]] = arith.constant 4 : index +// CHECK: %[[VAL_4:.*]] = fir.undefined !fir.shape<1> +// CHECK: %[[VAL_5:.*]] = hlfir.designate %[[VAL_0]] substr %[[VAL_2]], %[[VAL_3]] shape %[[VAL_4]] typeparams %[[VAL_1]] : (!fir.box>>, index, index, !fir.shape<1>, index) -> !fir.box>> + +func.func @real_part(%arg0 : !fir.ref>) { + %0 = hlfir.designate %arg0 real : (!fir.ref>) -> !fir.ref> + return +} +// CHECK-LABEL: func.func @real_part( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>) { +// CHECK: %[[VAL_1:.*]] = hlfir.designate %[[VAL_0]] real : (!fir.ref>) -> !fir.ref> + +func.func @imag_part_mlir_complex(%arg0 : !fir.ref>) { + %0 = hlfir.designate %arg0 imag : (!fir.ref>) -> !fir.ref + return +} +// CHECK-LABEL: func.func @imag_part_mlir_complex( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.ref>) { +// CHECK: %[[VAL_1:.*]] = hlfir.designate %[[VAL_0]] imag : (!fir.ref>) -> !fir.ref + +// array%array_complex_comp(1)%im +func.func @component_array_ref_cplx_part(%arg0 : !fir.box>}>>>) { + %c1 = arith.constant 1 : index + %component_shape = fir.undefined !fir.shapeshift<1> + %result_shape = fir.undefined !fir.shape<1> + %0 = hlfir.designate %arg0 {"array_comp"}<%component_shape>(%c1) imag shape %result_shape : (!fir.box>}>>>, !fir.shapeshift<1>, index, !fir.shape<1>) -> !fir.box>> + return +} +// CHECK-LABEL: func.func @component_array_ref_cplx_part( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.box>}>>>) { +// CHECK: %[[VAL_1:.*]] = arith.constant 1 : index +// CHECK: %[[VAL_2:.*]] = fir.undefined !fir.shapeshift<1> +// CHECK: %[[VAL_3:.*]] = fir.undefined !fir.shape<1> +// CHECK: %[[VAL_4:.*]] = hlfir.designate %[[VAL_0]]{"array_comp"} <%[[VAL_2]]> (%[[VAL_1]]) imag shape %[[VAL_3]] : (!fir.box>}>>>, !fir.shapeshift<1>, index, !fir.shape<1>) -> !fir.box>> + +// pdt_array(1) +func.func @pdt(%arg0 : !fir.box>>) { + %c1 = arith.constant 1 : index + %0 = hlfir.designate %arg0(%c1) typeparams %c1 : (!fir.box>>, index, index) -> !fir.box> + return +} +// CHECK-LABEL: func.func @pdt( +// CHECK-SAME: %[[VAL_0:.*]]: !fir.box>>) { +// CHECK: %[[VAL_1:.*]] = arith.constant 1 : index +// CHECK: %[[VAL_2:.*]] = hlfir.designate %[[VAL_0]] (%[[VAL_1]]) typeparams %[[VAL_1]] : (!fir.box>>, index, index) -> !fir.box> diff --git a/flang/test/HLFIR/invalid.fir b/flang/test/HLFIR/invalid.fir --- a/flang/test/HLFIR/invalid.fir +++ b/flang/test/HLFIR/invalid.fir @@ -70,3 +70,188 @@ hlfir.assign %arg0 to %arg1 : !fir.ref>, !hlfir.expr return } + +// ----- +func.func @bad_designate_component(%arg0 : !fir.ref) { + // expected-error@+1 {{'hlfir.designate' op component must be provided only when the memref is a derived type}} + %0 = hlfir.designate %arg0 {"some_component"} : (!fir.ref) -> !fir.ref + return +} + +// ----- +func.func @bad_designate_component_2(%arg0 : !fir.ref>) { + // expected-error@+1 {{'hlfir.designate' op component "bad_comp" is not a component of memref element type '!fir.type'}} + %0 = hlfir.designate %arg0 {"bad_comp"} : (!fir.ref>) -> !fir.ref + return +} + +// ----- +func.func @bad_designate_component_3(%arg0 : !fir.ref}>>>) { + // expected-error@+1 {{'hlfir.designate' op indices must be provided and must not contain triplets when both memref and component are arrays}} + %0 = hlfir.designate %arg0 {"i"} : (!fir.ref}>>>) -> !fir.ref + return +} + +// ----- +func.func @bad_designate_component_4(%arg0 : !fir.ref}>>>) { + %component_shape = fir.undefined !fir.shape<1> + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op indices must be provided and must not contain triplets when both memref and component are arrays}} + %0 = hlfir.designate %arg0 {"i"}<%component_shape>(%c1:%c1:%c1): (!fir.ref}>>>, !fir.shape<1>, index, index, index) -> !fir.ref> + return +} + +// ----- +func.func @bad_designate_component_5(%arg0 : !fir.ref}>>>) { + %component_shape = fir.undefined !fir.shape<2> + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op component_shape must be a fir.shape or fir.shapeshift with the rank of the component}} + %0 = hlfir.designate %arg0 {"i"}<%component_shape>(%c1): (!fir.ref}>>>, !fir.shape<2>, index) -> !fir.ref> + return +} + +// ----- +func.func @bad_designate_component_6(%arg0 : !fir.ref}>>>) { + %component_shape = fir.undefined !fir.shift<1> + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op component_shape must be a fir.shape or fir.shapeshift with the rank of the component}} + %0 = hlfir.designate %arg0 {"i"}<%component_shape>(%c1): (!fir.ref}>>>, !fir.shift<1>, index) -> !fir.ref> + return +} + +// ----- +func.func @bad_designate_component_7(%arg0 : !fir.ref}>>>) { + %component_shape = fir.undefined !fir.shapeshift<2> + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op component_shape must be a fir.shape or fir.shapeshift with the rank of the component}} + %0 = hlfir.designate %arg0 {"i"}<%component_shape>(%c1): (!fir.ref}>>>, !fir.shapeshift<2>, index) -> !fir.ref> + return +} + +// ----- +func.func @bad_designate_component_8(%arg0 : !fir.ref}>>) { + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op component_shape must be provided when indexing a component}} + %0 = hlfir.designate %arg0 {"i"}(%c1): (!fir.ref}>>, index) -> !fir.ref + return +} + +// ----- +func.func @bad_designate_component_9(%arg0 : !fir.ref>>) { + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op indices must not be provided if component appears and is not an array component}} + %0 = hlfir.designate %arg0 {"i"}(%c1): (!fir.ref>>, index) -> !fir.ref + return +} + +// ----- +func.func @bad_designate_component_10(%arg0 : !fir.ref}>>) { + %component_shape = fir.undefined !fir.shapeshift<1> + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op indices number must match array component rank}} + %0 = hlfir.designate %arg0 {"i"}<%component_shape>(%c1, %c1): (!fir.ref}>>, !fir.shapeshift<1>, index, index) -> !fir.ref + return +} + +// ----- +func.func @bad_designate_substring_1(%arg0 : !fir.ref>) { + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op substring must contain 2 indices when provided}} + %0 = hlfir.designate %arg0 substr %c1, %c1, %c1: (!fir.ref>, index, index, index) -> !fir.boxchar<1> + return +} + +// ----- +func.func @bad_designate_indices_1(%arg0 : !fir.ref) { + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op indices number must match memref rank}} + %0 = hlfir.designate %arg0 (%c1, %c1): (!fir.ref, index, index) -> !fir.ref + return +} + +// ----- +func.func @bad_designate_indices_2(%arg0 : !fir.ref>) { + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op indices number must match memref rank}} + %0 = hlfir.designate %arg0 (%c1, %c1): (!fir.ref>, index, index) -> !fir.ref + return +} + +// ----- +func.func @bad_designate_substring_2(%arg0 : !fir.ref) { + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op memref or component must have character type if substring indices are provided}} + %0 = hlfir.designate %arg0 substr %c1, %c1: (!fir.ref, index, index) -> !fir.boxchar<1> + return +} + +// ----- +func.func @bad_designate_cmplx_part(%arg0 : !fir.ref>) { + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op memref or component must have complex type if complex_part is provided}} + %0 = hlfir.designate %arg0 (%c1) imag: (!fir.ref>, index) -> !fir.ref + return +} + +// ----- +func.func @bad_designate_out_rank(%arg0 : !fir.ref>) { + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op result type rank is not consistent with operands, expected rank 1}} + %0 = hlfir.designate %arg0 (%c1:%c1:%c1): (!fir.ref>, index, index, index) -> !fir.ref + return +} + +// ----- +func.func @bad_designate_out_type(%arg0 : !fir.ref>) { + // expected-error@+1 {{'hlfir.designate' op result element type is not consistent with operands, expected '!fir.real<4>'}} + %0 = hlfir.designate %arg0 imag: (!fir.ref>) -> !fir.ref> + return +} + +// ----- +func.func @bad_designate_out_type(%arg0 : !fir.ref>>) { + // expected-error@+1 {{'hlfir.designate' op result type must only be a box address type if it designates a component that is a fir.box or fir.class and if there are no indices, substrings, and complex part}} + %0 = hlfir.designate %arg0 imag: (!fir.ref>>) -> !fir.ref>> + return +} + +// ----- +func.func @bad_designate_shape(%arg0 : !fir.ref>) { + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op shape must be provided if and only if the result is an array that is not a box address}} + %0 = hlfir.designate %arg0 (%c1:%c1:%c1): (!fir.ref>, index, index, index) -> !fir.box> + return +} + +// ----- +func.func @bad_designate_shape_2(%arg0 : !fir.ref>) { + %c1 = arith.constant 1 : index + %shape = fir.undefined !fir.shape<1> + // expected-error@+1 {{'hlfir.designate' op shape must be provided if and only if the result is an array that is not a box address}} + %0 = hlfir.designate %arg0 (%c1) shape %shape: (!fir.ref>, index, !fir.shape<1>) -> !fir.ref + return +} + +// ----- +func.func @bad_designate_len_params(%arg0 : !fir.ref>) { + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op must be provided one length parameter when the result is a character}} + %0 = hlfir.designate %arg0 substr %c1, %c1: (!fir.ref>, index, index) -> !fir.boxchar<1> + return +} + +// ----- +func.func @bad_designate_len_params_2(%arg0 : !fir.box>>) { + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op must be provided the same number of length parameters as in the result derived type}} + %0 = hlfir.designate %arg0(%c1) typeparams %c1, %c1 : (!fir.box>>, index, index, index) -> !fir.box> + return +} + +// ----- +func.func @bad_designate_len_params_3(%arg0 : !fir.box>) { + %c1 = arith.constant 1 : index + // expected-error@+1 {{'hlfir.designate' op must not be provided length parameters if the result type does not have length parameters}} + %0 = hlfir.designate %arg0(%c1) typeparams %c1 : (!fir.box>, index, index) -> !fir.ref + return +}