[flang-commits] [flang] 7b8c4f5 - [Flang][MIF] Adding support of intrinsics with coarray argument (#192944)
via flang-commits
flang-commits at lists.llvm.org
Wed Jul 1 11:53:30 PDT 2026
Author: Jean-Didier PAILLEUX
Date: 2026-07-01T20:53:26+02:00
New Revision: 7b8c4f5ad69d8fabf4bb71494f748fa0d7c47774
URL: https://github.com/llvm/llvm-project/commit/7b8c4f5ad69d8fabf4bb71494f748fa0d7c47774
DIFF: https://github.com/llvm/llvm-project/commit/7b8c4f5ad69d8fabf4bb71494f748fa0d7c47774.diff
LOG: [Flang][MIF] Adding support of intrinsics with coarray argument (#192944)
Added support for intrinsics that query the coarray in argument:
- Adding lowering and operation in MIF Dialect for UCOBOUND, LCOBOUND,
COSHAPE and IMAGE_INDEX
- Adding support of coarray argument for THIS_IMAGE in MIF Dialect (and
the lowering)
---------
Co-authored-by: Dan Bonachea <dobonachea at lbl.gov>
Co-authored-by: jeanPerier <jean.perier.polytechnique at gmail.com>
Added:
flang/test/Fir/MIF/cobound.mlir
flang/test/Fir/MIF/coshape.mlir
flang/test/Fir/MIF/image_index.mlir
flang/test/Lower/MIF/cobound.f90
flang/test/Lower/MIF/coshape.f90
flang/test/Lower/MIF/image_index.f90
Modified:
flang/include/flang/Lower/ConvertExprToHLFIR.h
flang/include/flang/Optimizer/Builder/BoxValue.h
flang/include/flang/Optimizer/Builder/FIRBuilder.h
flang/include/flang/Optimizer/Builder/HLFIRTools.h
flang/include/flang/Optimizer/Builder/IntrinsicCall.h
flang/include/flang/Optimizer/Dialect/FIROpsSupport.h
flang/include/flang/Optimizer/Dialect/FIRType.h
flang/include/flang/Optimizer/Dialect/FIRTypes.td
flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td
flang/lib/Lower/ConvertCall.cpp
flang/lib/Lower/ConvertExprToHLFIR.cpp
flang/lib/Lower/ConvertType.cpp
flang/lib/Optimizer/Builder/FIRBuilder.cpp
flang/lib/Optimizer/Builder/HLFIRTools.cpp
flang/lib/Optimizer/Builder/IntrinsicCall.cpp
flang/lib/Optimizer/Dialect/FIRType.cpp
flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp
flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
flang/test/Fir/MIF/this_image.mlir
flang/test/Lower/MIF/coarray_allocation.f90
flang/test/Lower/MIF/coarray_allocation2.f90
flang/test/Lower/MIF/this_image.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/ConvertExprToHLFIR.h b/flang/include/flang/Lower/ConvertExprToHLFIR.h
index f4d7701e50a2c..60ecd643be436 100644
--- a/flang/include/flang/Lower/ConvertExprToHLFIR.h
+++ b/flang/include/flang/Lower/ConvertExprToHLFIR.h
@@ -62,7 +62,7 @@ fir::ExtendedValue convertToBox(mlir::Location loc,
Fortran::lower::AbstractConverter &,
hlfir::Entity entity,
Fortran::lower::StatementContext &,
- mlir::Type fortranType);
+ mlir::Type fortranType, unsigned corank = 0);
/// Lower an evaluate::Expr to fir::ExtendedValue address.
/// The address may be a raw fir.ref<T>, or a fir.box<T>/fir.class<T>, or a
diff --git a/flang/include/flang/Optimizer/Builder/BoxValue.h b/flang/include/flang/Optimizer/Builder/BoxValue.h
index 43b70943aced6..2ce8ed486a15c 100644
--- a/flang/include/flang/Optimizer/Builder/BoxValue.h
+++ b/flang/include/flang/Optimizer/Builder/BoxValue.h
@@ -279,6 +279,8 @@ class AbstractIrBox : public AbstractBox, public AbstractArrayBox {
bool isUnlimitedPolymorphic() const {
return fir::isUnlimitedPolymorphicType(getBoxTy());
}
+
+ unsigned corank() const { return fir::getBoxCorank(getBoxTy()); }
};
/// An entity described by a fir.box value that cannot be read into
diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
index a41be5efacb56..3622351c1ef64 100644
--- a/flang/include/flang/Optimizer/Builder/FIRBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
@@ -493,7 +493,8 @@ class FirOpBuilder : public mlir::OpBuilder, public mlir::OpBuilder::Listener {
/// Array entities are boxed with a shape and possibly a shift. Character
/// entities are boxed with a LEN parameter.
mlir::Value createBox(mlir::Location loc, const fir::ExtendedValue &exv,
- bool isPolymorphic = false, bool isAssumedType = false);
+ bool isPolymorphic = false, bool isAssumedType = false,
+ unsigned corank = 0);
mlir::Value createBox(mlir::Location loc, mlir::Type boxType,
mlir::Value addr, mlir::Value shape, mlir::Value slice,
@@ -919,7 +920,8 @@ mlir::Value genCPtrOrCFunptrValue(fir::FirOpBuilder &builder,
/// Create a fir.box from a fir::ExtendedValue and wrap it in a fir::BoxValue
/// to keep all the lower bound and explicit parameter information.
fir::BoxValue createBoxValue(fir::FirOpBuilder &builder, mlir::Location loc,
- const fir::ExtendedValue &exv);
+ const fir::ExtendedValue &exv,
+ unsigned corank = 0);
/// Generate Null BoxProc for procedure pointer null initialization.
mlir::Value createNullBoxProc(fir::FirOpBuilder &builder, mlir::Location loc,
diff --git a/flang/include/flang/Optimizer/Builder/HLFIRTools.h b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
index 13b621f04466e..ce99a37052621 100644
--- a/flang/include/flang/Optimizer/Builder/HLFIRTools.h
+++ b/flang/include/flang/Optimizer/Builder/HLFIRTools.h
@@ -104,7 +104,8 @@ class Entity : public mlir::Value {
if (isBoxAddressOrValue())
return llvm::cast<fir::BaseBoxType>(fir::unwrapRefType(getType()));
const bool isVolatile = fir::isa_volatile_type(getType());
- return fir::BoxType::get(getElementOrSequenceType(), isVolatile);
+ const int64_t corank = fir::getBoxCorank(getType());
+ return fir::BoxType::get(getElementOrSequenceType(), isVolatile, corank);
}
bool hasLengthParameters() const {
@@ -522,7 +523,7 @@ convertToAddress(mlir::Location loc, fir::FirOpBuilder &builder,
std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
convertToBox(mlir::Location loc, fir::FirOpBuilder &builder,
- hlfir::Entity entity, mlir::Type targetType);
+ hlfir::Entity entity, mlir::Type targetType, unsigned corank = 0);
/// Clone an hlfir.elemental_addr into an hlfir.elemental value.
hlfir::ElementalOp cloneToElementalOp(mlir::Location loc,
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 613877c1695b3..30dadc1382f56 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -174,6 +174,7 @@ struct IntrinsicLibrary {
llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genCmplx(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genConjg(mlir::Type, llvm::ArrayRef<mlir::Value>);
+ fir::ExtendedValue genCoshape(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genCount(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
void genCpuTime(llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genCshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
@@ -296,6 +297,8 @@ struct IntrinsicLibrary {
mlir::Value genIeeeUnordered(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genIeeeValue(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genIeor(mlir::Type, llvm::ArrayRef<mlir::Value>);
+ fir::ExtendedValue genImageIndex(mlir::Type,
+ llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genIndex(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genIor(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genIparity(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
@@ -310,6 +313,8 @@ struct IntrinsicLibrary {
mlir::Value genIshft(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genIshftc(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+ fir::ExtendedValue genLcobound(mlir::Type,
+ llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genLeadz(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
@@ -416,6 +421,8 @@ struct IntrinsicLibrary {
llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+ fir::ExtendedValue genUcobound(mlir::Type,
+ llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genUnlink(std::optional<mlir::Type> resultType,
llvm::ArrayRef<fir::ExtendedValue> args);
fir::ExtendedValue genUnpack(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
diff --git a/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h b/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h
index b014d925592cb..9e168ffe90d0d 100644
--- a/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h
+++ b/flang/include/flang/Optimizer/Dialect/FIROpsSupport.h
@@ -136,6 +136,9 @@ static constexpr llvm::StringRef getAccessGroupsAttrName() {
return "access_groups";
}
+/// Attribute to mark coarray Fortran entities with the CORANK attribute.
+constexpr llvm::StringRef getCorankAttrName() { return "fir.corank"; }
+
/// Does the function, \p func, have a host-associations tuple argument?
/// Some internal procedures may have access to host procedure variables.
bool hasHostAssociationArgument(mlir::func::FuncOp func);
diff --git a/flang/include/flang/Optimizer/Dialect/FIRType.h b/flang/include/flang/Optimizer/Dialect/FIRType.h
index daca6d209f553..6684af86a33fa 100644
--- a/flang/include/flang/Optimizer/Dialect/FIRType.h
+++ b/flang/include/flang/Optimizer/Dialect/FIRType.h
@@ -73,6 +73,9 @@ class BaseBoxType : public mlir::Type {
/// Is this a box describing an array or assumed-rank?
bool isArray() const;
+ /// Is this a box describing a coarray?
+ bool isCoarray() const;
+
/// Return the same type, except for the shape, that is taken the shape
/// of shapeMold.
BaseBoxType getBoxTypeWithNewShape(mlir::Type shapeMold) const;
@@ -428,6 +431,9 @@ inline bool boxHasAddendum(fir::BaseBoxType boxTy) {
/// Get the rank from a !fir.box type.
unsigned getBoxRank(mlir::Type boxTy);
+/// Get the corank from a !fir.box type.
+unsigned getBoxCorank(mlir::Type boxTy);
+
/// Return true iff `ty` is a RecordType with members that are allocatable.
bool isRecordWithAllocatableMember(mlir::Type ty);
@@ -475,10 +481,11 @@ inline bool isNoneOrSeqNone(mlir::Type type) {
/// is polymorphic and assumed shape return fir.box<T>.
inline mlir::Type wrapInClassOrBoxType(mlir::Type eleTy,
bool isPolymorphic = false,
- bool isAssumedType = false) {
+ bool isAssumedType = false,
+ unsigned corank = 0) {
if (isPolymorphic && !isAssumedType)
- return fir::ClassType::get(eleTy);
- return fir::BoxType::get(eleTy);
+ return fir::ClassType::get(eleTy, /*isVolatile*/ false, corank);
+ return fir::BoxType::get(eleTy, /*isVolatile*/ false, corank);
}
/// Re-create the given type with the given volatility, if this is a type
diff --git a/flang/include/flang/Optimizer/Dialect/FIRTypes.td b/flang/include/flang/Optimizer/Dialect/FIRTypes.td
index dd7ca8169fd86..1d66507a23545 100644
--- a/flang/include/flang/Optimizer/Dialect/FIRTypes.td
+++ b/flang/include/flang/Optimizer/Dialect/FIRTypes.td
@@ -78,14 +78,15 @@ def fir_BoxType : FIR_Type<"Box", "box", [], "BaseBoxType"> {
to) whether the entity is an array, its size, or what type it has.
}];
- let parameters = (ins "mlir::Type":$eleTy, "bool":$isVolatile);
+ let parameters = (ins "mlir::Type":$eleTy, "bool":$isVolatile, "int64_t":$corank);
let skipDefaultBuilders = 1;
let builders = [
TypeBuilderWithInferredContext<(ins
- "mlir::Type":$eleTy, CArg<"bool", "false">:$isVolatile), [{
- return Base::get(eleTy.getContext(), eleTy, isVolatile);
+ "mlir::Type":$eleTy, CArg<"bool", "false">:$isVolatile,
+ CArg<"int64_t", "0">:$corank), [{
+ return Base::get(eleTy.getContext(), eleTy, isVolatile, corank);
}]>,
];
@@ -147,11 +148,12 @@ def fir_ClassType : FIR_Type<"Class", "class", [], "BaseBoxType"> {
is equivalent to a fir.box type with a dynamic type.
}];
- let parameters = (ins "mlir::Type":$eleTy, "bool":$isVolatile);
+ let parameters = (ins "mlir::Type":$eleTy, "bool":$isVolatile, "int64_t":$corank);
let builders = [
- TypeBuilderWithInferredContext<(ins "mlir::Type":$eleTy, CArg<"bool", "false">:$isVolatile), [{
- return $_get(eleTy.getContext(), eleTy, isVolatile);
+ TypeBuilderWithInferredContext<(ins "mlir::Type":$eleTy, CArg<"bool", "false">:$isVolatile,
+ CArg<"int64_t", "0">:$corank), [{
+ return $_get(eleTy.getContext(), eleTy, isVolatile, corank);
}]>
];
diff --git a/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td b/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td
index 7df274b5697f3..4acbeec47eb2e 100644
--- a/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td
+++ b/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td
@@ -102,11 +102,13 @@ def mif_ThisImageOp : mif_Op<"this_image", [AttrSizedOperandSegments]> {
value 5, `this_image(A)` has the value [5, 0, 0].
}];
- let arguments = (ins Optional<fir_BoxType>:$coarray,
- Optional<AnyInteger>:$dim, Optional<AnyRefOrBoxType>:$team);
- let results = (outs I32:$res);
+ let arguments = (ins Optional<AnyType>:$coarray, Optional<AnyInteger>:$dim,
+ Optional<AnyRefOrBoxType>:$team);
+ let results = (outs AnyType:$res);
- let builders = [OpBuilder<(ins "mlir::Value":$coarray, "mlir::Value":$team)>,
+ let builders = [OpBuilder<(ins "mlir::Value":$coarray, "mlir::Value":$dim,
+ "mlir::Value":$team)>,
+ OpBuilder<(ins "mlir::Value":$coarray, "mlir::Value":$team)>,
OpBuilder<(ins "mlir::Value":$team)>];
let hasVerifier = 1;
@@ -118,6 +120,109 @@ def mif_ThisImageOp : mif_Op<"this_image", [AttrSizedOperandSegments]> {
}];
}
+//===----------------------------------------------------------------------===//
+// Coarray Queries
+//===----------------------------------------------------------------------===//
+
+def mif_ImageIndexOp : mif_Op<"image_index", [AttrSizedOperandSegments]> {
+ let summary = "Image index from cosubscripts.";
+ let description = [{
+ Arguments:
+ - `coarray`: Shall be a coarray of any type.
+ - `sub`: rank-one integer array of size equal to the corank of `coarray`.
+ - `team`: Shall be a scalar of type `team_type` from ISO_FORTRAN_ENV.
+ - `team_number`: It shall identify the initial team or a sibling team
+ of the current team.
+
+ Usage:
+ - Case(1) : `image_index(coarray, sub)`
+ - Case(2) : `image_index(coarray, sub, team)`
+ - Case(3) : `image_index(coarray, sub, team_number)`
+
+ Result: If the value of `sub` is a valid sequence of cosubscripts for `coarray` in the
+ team specified by `team` or `team_number`, or the current team if neither `team` nor
+ `team_number` appears, the result is the index of the corresponding image in that team.
+ Otherwise, the result is zero.
+ }];
+
+ let arguments = (ins AnyType:$coarray, fir_BoxType:$sub,
+ Optional<AnyRefOrBoxType>:$team, Optional<AnyInteger>:$team_number);
+ let builders = [OpBuilder<(ins "mlir::Value":$coarray, "mlir::Value":$sub,
+ "mlir::Value":$team)>];
+
+ let results = (outs I32);
+
+ let hasVerifier = 1;
+ let assemblyFormat = [{
+ `coarray` $coarray `sub` $sub
+ ( `team` $team^ )?
+ ( `team_number` $team_number^ )?
+ attr-dict `:` functional-type(operands, results)
+ }];
+}
+
+def mif_LcoboundOp : mif_Op<"lcobound", [NoMemoryEffect]> {
+ let summary =
+ "Returns the lower cobound for a given codimension of a coarray.";
+ let description = [{
+ This operation returns the lower cobound for a given codimension of a coarray.
+ Arguments:
+ - `coarray`: Shall be a coarray of any type.
+ - `dim` : Shall be an integer scalar. Its value shall be in the range of
+ `1 <= DIM <= N`, where `N` is the corank of the coarray.
+ The result is an integer scalar equal to the lower cobound for codimension `dim`.
+ }];
+
+ let arguments = (ins AnyType:$coarray, AnyInteger:$dim);
+ let results = (outs AnyInteger);
+
+ let hasVerifier = 1;
+ let assemblyFormat = [{
+ `coarray` $coarray `dim` $dim
+ attr-dict `:` functional-type(operands, results)
+ }];
+}
+
+def mif_UcoboundOp : mif_Op<"ucobound", [NoMemoryEffect]> {
+ let summary = "Returns the upper cobound for a given codimension of a coarray.";
+ let description = [{
+ This operation returns the upper cobound(s) associated with a coarray.
+ Arguments:
+ - `coarray`: Shall be a coarray of any type.
+ - `dim` : Shall be an integer scalar. Its value shall be in the range of
+ `1 <= DIM <= N`, where `N` is the corank of the coarray.
+ The result is an integer scalar equal to the upper cobound for codimension `dim`.
+ }];
+
+ let arguments = (ins AnyType:$coarray, AnyInteger:$dim);
+ let results = (outs AnyInteger);
+
+ let hasVerifier = 1;
+ let assemblyFormat = [{
+ `coarray` $coarray `dim` $dim
+ attr-dict `:` functional-type(operands, results)
+ }];
+}
+
+def mif_CoshapeOp : mif_Op<"coshape", [NoMemoryEffect]> {
+ let summary = "Return the sizes of codimensions of a coarray.";
+ let description = [{
+ Argument: `coarray`: Shall be a coarray of any type.
+ Result : Is an array whose size matches the corank of the indicated coarray and
+ returns `UCOBOUND - LCOBOUND + 1`.
+ }];
+
+ let arguments = (ins AnyType:$coarray);
+ let builders = [OpBuilder<(ins "mlir::Value":$coarray)>];
+ let results = (outs AnyBoxedArray);
+
+ let hasVerifier = 1;
+ let assemblyFormat = [{
+ `coarray` $coarray
+ attr-dict `:` functional-type(operands, results)
+ }];
+}
+
//===----------------------------------------------------------------------===//
// Synchronization
//===----------------------------------------------------------------------===//
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index de552e6c943b0..4e862e8ece18a 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -2143,6 +2143,17 @@ static std::optional<hlfir::EntityWithAttributes> genCustomIntrinsicRefCore(
loc, builder, result, ".tmp.custom_intrinsic_result")}};
}
+static unsigned getCorank(const Fortran::lower::SomeExpr &expr) {
+ if (auto dataRef{Fortran::evaluate::ExtractDataRef(expr)}) {
+ const Fortran::semantics::Symbol sym = dataRef->GetLastSymbol();
+ if (const auto *object =
+ sym.GetUltimate()
+ .detailsIf<Fortran::semantics::ObjectEntityDetails>())
+ return object->coshape().size();
+ }
+ return 0;
+}
+
/// Lower calls to intrinsic procedures with actual arguments that have been
/// pre-lowered but have not yet been prepared according to the interface.
static std::optional<hlfir::EntityWithAttributes>
@@ -2166,6 +2177,12 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
const fir::IntrinsicArgumentLoweringRules *argLowering =
intrinsicEntry.getArgumentLoweringRules();
for (auto arg : llvm::enumerate(loweredActuals)) {
+ // Trying to retrieve the corank of a variable if this is a coarray
+ unsigned corank = 0;
+ if (const Fortran::lower::SomeExpr *expr =
+ callContext.procRef.UnwrapArgExpr(arg.index()))
+ corank = getCorank(*expr);
+
if (!arg.value()) {
operands.emplace_back(fir::getAbsentIntrinsicArgument());
continue;
@@ -2244,19 +2261,22 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
llvm_unreachable("bad switch");
}
+ fir::ExtendedValue exv;
hlfir::Entity actual = arg.value()->getActual(loc, builder);
switch (argRules.lowerAs) {
case fir::LowerIntrinsicArgAs::Value:
- operands.emplace_back(
- Fortran::lower::convertToValue(loc, converter, actual, stmtCtx));
+ exv = Fortran::lower::convertToValue(loc, converter, actual, stmtCtx);
+ operands.emplace_back(exv);
continue;
case fir::LowerIntrinsicArgAs::Addr:
- operands.emplace_back(Fortran::lower::convertToAddress(
- loc, converter, actual, stmtCtx, getActualFortranElementType()));
+ exv = Fortran::lower::convertToAddress(loc, converter, actual, stmtCtx,
+ getActualFortranElementType());
+ operands.emplace_back(exv);
continue;
case fir::LowerIntrinsicArgAs::Box:
- operands.emplace_back(Fortran::lower::convertToBox(
- loc, converter, actual, stmtCtx, getActualFortranElementType()));
+ exv = Fortran::lower::convertToBox(loc, converter, actual, stmtCtx,
+ getActualFortranElementType(), corank);
+ operands.emplace_back(exv);
continue;
case fir::LowerIntrinsicArgAs::Inquired:
if (const Fortran::lower::SomeExpr *expr =
@@ -2958,6 +2978,7 @@ genCustomIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
auto getActualFortranElementType = [&]() -> mlir::Type {
return hlfir::getFortranElementType(converter.genType(expr));
};
+ unsigned corank = getCorank(expr);
hlfir::EntityWithAttributes actual = Fortran::lower::convertExprToHLFIR(
loc, converter, expr, callContext.symMap, callContext.stmtCtx);
std::optional<fir::ExtendedValue> exv;
@@ -2971,7 +2992,7 @@ genCustomIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
break;
case fir::LowerIntrinsicArgAs::Box:
exv = Fortran::lower::convertToBox(loc, converter, actual, stmtCtx,
- getActualFortranElementType());
+ getActualFortranElementType(), corank);
break;
case fir::LowerIntrinsicArgAs::Inquired:
exv = Fortran::lower::translateToExtendedValue(loc, builder, actual,
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index ad680269dea5c..c03129f74a889 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -144,7 +144,8 @@ class HlfirDesignatorBuilder {
const Fortran::semantics::Symbol &componentSym, mlir::Type fieldType,
bool isVolatile) {
if (mayHaveNonDefaultLowerBounds(componentSym)) {
- mlir::Type boxType = fir::BoxType::get(fieldType, isVolatile);
+ mlir::Type boxType =
+ fir::BoxType::get(fieldType, isVolatile, componentSym.Corank());
return std::make_tuple(boxType,
fir::FortranVariableFlagsEnum::contiguous);
}
@@ -2315,9 +2316,10 @@ hlfir::EntityWithAttributes Fortran::lower::convertExprToHLFIR(
fir::ExtendedValue Fortran::lower::convertToBox(
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
hlfir::Entity entity, Fortran::lower::StatementContext &stmtCtx,
- mlir::Type fortranType) {
+ mlir::Type fortranType, unsigned corank) {
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
- auto [exv, cleanup] = hlfir::convertToBox(loc, builder, entity, fortranType);
+ auto [exv, cleanup] =
+ hlfir::convertToBox(loc, builder, entity, fortranType, corank);
if (cleanup)
stmtCtx.attachCleanup(*cleanup);
return exv;
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 1f5759acce5bc..0fdbdfcc74424 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -290,14 +290,16 @@ struct TypeBuilderImpl {
ty = fir::SequenceType::get(fir::SequenceType::Shape{}, ty);
}
+ bool isAssumedType = Fortran::semantics::IsAssumedType(symbol);
bool isPolymorphic = (Fortran::semantics::IsPolymorphic(symbol) ||
Fortran::semantics::IsUnlimitedPolymorphic(symbol)) &&
- !Fortran::semantics::IsAssumedType(symbol);
+ !isAssumedType;
if (Fortran::semantics::IsPointer(symbol))
- return fir::wrapInClassOrBoxType(fir::PointerType::get(ty),
- isPolymorphic);
+ return fir::wrapInClassOrBoxType(fir::PointerType::get(ty), isPolymorphic,
+ isAssumedType, symbol.Corank());
if (Fortran::semantics::IsAllocatable(symbol))
- return fir::wrapInClassOrBoxType(fir::HeapType::get(ty), isPolymorphic);
+ return fir::wrapInClassOrBoxType(fir::HeapType::get(ty), isPolymorphic,
+ isAssumedType, symbol.Corank());
// isPtr and isAlloc are variable that were promoted to be on the
// heap or to be pointers, but they do not have Fortran allocatable
// or pointer semantics, so do not use box for them.
@@ -306,7 +308,7 @@ struct TypeBuilderImpl {
if (isAlloc)
return fir::HeapType::get(ty);
if (isPolymorphic)
- return fir::ClassType::get(ty);
+ return fir::ClassType::get(ty, false, symbol.Corank());
return ty;
}
diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
index c7df3abda156c..d97b56af570b4 100644
--- a/flang/lib/Optimizer/Builder/FIRBuilder.cpp
+++ b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
@@ -756,8 +756,8 @@ mlir::Value fir::FirOpBuilder::createSlice(mlir::Location loc,
mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc,
const fir::ExtendedValue &exv,
- bool isPolymorphic,
- bool isAssumedType) {
+ bool isPolymorphic, bool isAssumedType,
+ unsigned corank) {
mlir::Value itemAddr = fir::getBase(exv);
if (mlir::isa<fir::BaseBoxType>(itemAddr.getType()))
return itemAddr;
@@ -774,13 +774,13 @@ mlir::Value fir::FirOpBuilder::createBox(mlir::Location loc,
if (mlir::isa<fir::BaseBoxType>(elementType)) {
boxTy = elementType;
} else {
- boxTy = fir::BoxType::get(elementType, isVolatile);
+ boxTy = fir::BoxType::get(elementType, isVolatile, corank);
if (isPolymorphic) {
elementType = fir::updateTypeForUnlimitedPolymorphic(elementType);
if (isAssumedType)
- boxTy = fir::BoxType::get(elementType, isVolatile);
+ boxTy = fir::BoxType::get(elementType, isVolatile, corank);
else
- boxTy = fir::ClassType::get(elementType, isVolatile);
+ boxTy = fir::ClassType::get(elementType, isVolatile, corank);
}
}
@@ -1852,10 +1852,11 @@ mlir::Value fir::factory::genCPtrOrCFunptrValue(fir::FirOpBuilder &builder,
fir::BoxValue fir::factory::createBoxValue(fir::FirOpBuilder &builder,
mlir::Location loc,
- const fir::ExtendedValue &exv) {
+ const fir::ExtendedValue &exv,
+ unsigned corank) {
if (auto *boxValue = exv.getBoxOf<fir::BoxValue>())
return *boxValue;
- mlir::Value box = builder.createBox(loc, exv);
+ mlir::Value box = builder.createBox(loc, exv, false, false, corank);
llvm::SmallVector<mlir::Value> lbounds;
llvm::SmallVector<mlir::Value> explicitTypeParams;
exv.match(
diff --git a/flang/lib/Optimizer/Builder/HLFIRTools.cpp b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
index d1e009d14bb80..f95af2deb08da 100644
--- a/flang/lib/Optimizer/Builder/HLFIRTools.cpp
+++ b/flang/lib/Optimizer/Builder/HLFIRTools.cpp
@@ -1301,7 +1301,8 @@ static fir::ExtendedValue placeTrivialInMemory(mlir::Location loc,
std::pair<fir::ExtendedValue, std::optional<hlfir::CleanupFunction>>
hlfir::convertToBox(mlir::Location loc, fir::FirOpBuilder &builder,
- hlfir::Entity entity, mlir::Type targetType) {
+ hlfir::Entity entity, mlir::Type targetType,
+ unsigned corank) {
// fir::factory::createBoxValue is not meant to deal with procedures.
// Dereference procedure pointers here.
if (entity.isProcedurePointer())
@@ -1317,7 +1318,7 @@ hlfir::convertToBox(mlir::Location loc, fir::FirOpBuilder &builder,
mlir::Value base = fir::getBase(exv);
if (fir::isa_trivial(base.getType()))
exv = placeTrivialInMemory(loc, builder, base, targetType);
- fir::BoxValue box = fir::factory::createBoxValue(builder, loc, exv);
+ fir::BoxValue box = fir::factory::createBoxValue(builder, loc, exv, corank);
return {box, cleanup};
}
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 04f7741adf943..a2abcba0b81f2 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -254,6 +254,10 @@ static constexpr IntrinsicHandler handlers[]{
{"command_argument_count", &I::genCommandArgumentCount},
{"conjg", &I::genConjg},
{"cosd", &I::genCosd},
+ {"coshape",
+ &I::genCoshape,
+ {{{"coarray", asBox}, {"kind", asValue}}},
+ /*isElemental=*/false},
{"cospi", &I::genCospi},
{"count",
&I::genCount,
@@ -515,6 +519,13 @@ static constexpr IntrinsicHandler handlers[]{
{"ieee_unordered", &I::genIeeeUnordered},
{"ieee_value", &I::genIeeeValue},
{"ieor", &I::genIeor},
+ {"image_index",
+ &I::genImageIndex,
+ {{{"coarray", asBox},
+ {"sub", asBox},
+ {"team", asAddr},
+ {"team_number", asValue}}},
+ /*isElemental*/ false},
{"index",
&I::genIndex,
{{{"string", asAddr},
@@ -545,6 +556,10 @@ static constexpr IntrinsicHandler handlers[]{
&I::genLbound,
{{{"array", asInquired}, {"dim", asValue}, {"kind", asValue}}},
/*isElemental=*/false},
+ {"lcobound",
+ &I::genLcobound,
+ {{{"coarray", asBox}, {"dim", asValue}, {"kind", asValue}}},
+ /*isElemental=*/false},
{"leadz", &I::genLeadz},
{"len",
&I::genLen,
@@ -818,7 +833,7 @@ static constexpr IntrinsicHandler handlers[]{
{"this_image",
&I::genThisImage,
{{{"coarray", asBox},
- {"dim", asAddr},
+ {"dim", asValue},
{"team", asBox, handleDynamicOptional}}},
/*isElemental=*/false},
{"time", &I::genTime, {}, /*isElemental=*/false},
@@ -844,6 +859,10 @@ static constexpr IntrinsicHandler handlers[]{
&I::genUbound,
{{{"array", asBox}, {"dim", asValue}, {"kind", asValue}}},
/*isElemental=*/false},
+ {"ucobound",
+ &I::genUcobound,
+ {{{"coarray", asBox}, {"dim", asValue}, {"kind", asValue}}},
+ /*isElemental=*/false},
{"umaskl", &I::genMask<mlir::arith::ShLIOp>},
{"umaskr", &I::genMask<mlir::arith::ShRUIOp>},
{"unlink",
@@ -3581,6 +3600,17 @@ mlir::Value IntrinsicLibrary::genCospi(mlir::Type resultType,
return getRuntimeCallGenerator("cos", ftype)(builder, loc, {arg});
}
+// COSHAPE
+fir::ExtendedValue
+IntrinsicLibrary::genCoshape(mlir::Type,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ checkCoarrayEnabled(loc, options);
+ assert(args.size() == 2);
+
+ return mif::CoshapeOp::create(builder, loc,
+ /*coarray*/ fir::getBase(args[0]));
+}
+
// COUNT
fir::ExtendedValue
IntrinsicLibrary::genCount(mlir::Type resultType,
@@ -6283,6 +6313,24 @@ mlir::Value IntrinsicLibrary::genIeor(mlir::Type resultType,
args[1]);
}
+// IMAGE_INDEX
+fir::ExtendedValue
+IntrinsicLibrary::genImageIndex(mlir::Type resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ checkCoarrayEnabled(loc, options);
+ assert(args.size() == 2 || args.size() == 3);
+
+ mlir::Value team;
+ if (args.size() > 2) {
+ team = fir::getBase(args[2]);
+ if (fir::isa_integer(fir::unwrapRefType(team.getType())))
+ team = fir::LoadOp::create(builder, loc, team);
+ }
+ return mif::ImageIndexOp::create(builder, loc,
+ /*coarray*/ fir::getBase(args[0]),
+ /*sub*/ fir::getBase(args[1]), team);
+}
+
// INDEX
fir::ExtendedValue
IntrinsicLibrary::genIndex(mlir::Type resultType,
@@ -8297,11 +8345,21 @@ IntrinsicLibrary::genThisImage(mlir::Type resultType,
checkCoarrayEnabled(loc, options);
assert(args.size() >= 1 && args.size() <= 3);
const bool coarrayIsAbsent = args.size() == 1;
+ const bool dimIsAbsent = args.size() < 3;
mlir::Value team = fir::getBase(args[args.size() - 1]);
- if (!coarrayIsAbsent)
- TODO(loc, "coarray: this_image with coarray argument");
- mlir::Value res = mif::ThisImageOp::create(builder, loc, team);
+ if (!coarrayIsAbsent && dimIsAbsent) {
+ mlir::Value res =
+ mif::ThisImageOp::create(builder, loc, fir::getBase(args[0]), team);
+ return res;
+ }
+ mlir::Value res;
+ if (!dimIsAbsent) {
+ mlir::Value coarray = fir::getBase(args[0]);
+ mlir::Value dim = fir::getBase(args[1]);
+ res = mif::ThisImageOp::create(builder, loc, coarray, dim, team);
+ } else
+ res = mif::ThisImageOp::create(builder, loc, team);
return builder.createConvert(loc, resultType, res);
}
@@ -8413,6 +8471,39 @@ IntrinsicLibrary::genLbound(mlir::Type resultType,
fir::runtime::genLboundDim(builder, loc, fir::getBase(box), dim));
}
+// LCOBOUND
+fir::ExtendedValue
+IntrinsicLibrary::genLcobound(mlir::Type resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ checkCoarrayEnabled(loc, options);
+ assert(args.size() == 2 || args.size() == 3);
+
+ mlir::Value coarray = fir::getBase(args[0]);
+ const bool dimIsAbsent = args.size() == 2 || isStaticallyAbsent(args, 1);
+ if (!dimIsAbsent) {
+ mlir::Value dim = fir::getBase(args[1]);
+ return mif::LcoboundOp::create(builder, loc, resultType, coarray, dim);
+ }
+ int corank = fir::getBoxCorank(coarray.getType());
+ mlir::Type arrTy = fir::SequenceType::get(
+ {static_cast<fir::SequenceType::Extent>(corank)}, resultType);
+ mlir::Value lcobound = fir::AllocaOp::create(builder, loc, arrTy);
+
+ mlir::Type idxTy = builder.getIndexType();
+ for (int d = 1; d <= corank; ++d) {
+ mlir::Value dim = builder.createIntegerConstant(loc, resultType, d);
+ mlir::Value lcb =
+ mif::LcoboundOp::create(builder, loc, resultType, coarray, dim);
+
+ mlir::Value idx = builder.createIntegerConstant(loc, idxTy, d - 1);
+ mlir::Value gep = fir::CoordinateOp::create(
+ builder, loc, fir::ReferenceType::get(resultType), lcobound,
+ mlir::ValueRange{idx});
+ fir::StoreOp::create(builder, loc, lcb, gep);
+ }
+ return builder.createBox(loc, lcobound);
+}
+
// UBOUND
fir::ExtendedValue
IntrinsicLibrary::genUbound(mlir::Type resultType,
@@ -8435,6 +8526,40 @@ IntrinsicLibrary::genUbound(mlir::Type resultType,
/*needAccurateLowerBound=*/true);
}
+// UCOBOUND
+fir::ExtendedValue
+IntrinsicLibrary::genUcobound(mlir::Type resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ checkCoarrayEnabled(loc, options);
+ assert(args.size() == 2 || args.size() == 3);
+
+ mlir::Value coarray = fir::getBase(args[0]);
+ const bool dimIsAbsent = args.size() == 2 || isStaticallyAbsent(args, 1);
+ if (!dimIsAbsent) {
+ mlir::Value dim = fir::getBase(args[1]);
+ return mif::UcoboundOp::create(builder, loc, resultType, coarray, dim);
+ }
+
+ int corank = fir::getBoxCorank(coarray.getType());
+ mlir::Type arrTy = fir::SequenceType::get(
+ {static_cast<fir::SequenceType::Extent>(corank)}, resultType);
+ mlir::Value ucobound = fir::AllocaOp::create(builder, loc, arrTy);
+
+ mlir::Type idxTy = builder.getIndexType();
+ for (int d = 1; d <= corank; ++d) {
+ mlir::Value dim = builder.createIntegerConstant(loc, resultType, d);
+ mlir::Value ucb =
+ mif::UcoboundOp::create(builder, loc, resultType, coarray, dim);
+
+ mlir::Value idx = builder.createIntegerConstant(loc, idxTy, d - 1);
+ mlir::Value gep = fir::CoordinateOp::create(
+ builder, loc, fir::ReferenceType::get(resultType), ucobound,
+ mlir::ValueRange{idx});
+ fir::StoreOp::create(builder, loc, ucb, gep);
+ }
+ return builder.createBox(loc, ucobound);
+}
+
// SPACING
mlir::Value IntrinsicLibrary::genSpacing(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
diff --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp
index 8477048d18863..6eaecc69fe742 100644
--- a/flang/lib/Optimizer/Dialect/FIRType.cpp
+++ b/flang/lib/Optimizer/Dialect/FIRType.cpp
@@ -79,6 +79,8 @@ bool verifySameLists(llvm::ArrayRef<RecordType::TypePair> a1,
static llvm::StringRef getVolatileKeyword() { return "volatile"; }
+static llvm::StringRef getCorankKeyword() { return "corank"; }
+
static mlir::ParseResult parseOptionalCommaAndKeyword(mlir::AsmParser &parser,
mlir::StringRef keyword,
bool &parsedKeyword) {
@@ -477,6 +479,12 @@ unsigned getBoxRank(mlir::Type boxTy) {
return 0;
}
+unsigned getBoxCorank(mlir::Type ty) {
+ return llvm::TypeSwitch<mlir::Type, unsigned>(ty)
+ .Case<fir::BoxType, fir::ClassType>([](auto t) { return t.getCorank(); })
+ .Default([](mlir::Type) { return 0; });
+}
+
/// Return the ISO_C_BINDING intrinsic module value of type \p ty.
int getTypeCode(mlir::Type ty, const fir::KindMapping &kindMap) {
if (mlir::IntegerType intTy = mlir::dyn_cast<mlir::IntegerType>(ty)) {
@@ -693,15 +701,16 @@ static mlir::Type changeElementTypeImpl(mlir::Type type,
mlir::Type newInnerType =
changeElementTypeImpl(t.getEleTy(), newElementType, false, false);
if (turnBoxIntoClass)
- return fir::ClassType::get(newInnerType, t.isVolatile());
- return fir::BoxType::get(newInnerType, t.isVolatile());
+ return fir::ClassType::get(newInnerType, t.isVolatile(),
+ t.getCorank());
+ return fir::BoxType::get(newInnerType, t.isVolatile(), t.getCorank());
})
.Case([&](fir::ClassType t) -> mlir::Type {
mlir::Type newInnerType =
changeElementTypeImpl(t.getEleTy(), newElementType, false, false);
if (turnClassIntoBox)
- return fir::BoxType::get(newInnerType, t.isVolatile());
- return fir::ClassType::get(newInnerType, t.isVolatile());
+ return fir::BoxType::get(newInnerType, t.isVolatile(), t.getCorank());
+ return fir::ClassType::get(newInnerType, t.isVolatile(), t.getCorank());
})
.Default([&](mlir::Type t) -> mlir::Type {
assert((fir::isa_trivial(t) || llvm::isa<fir::RecordType>(t) ||
@@ -792,31 +801,44 @@ static bool cannotBePointerOrHeapElementType(mlir::Type eleTy) {
// BoxType
//===----------------------------------------------------------------------===//
-// `box` `<` type (`, volatile` $volatile^)? `>`
+// `box` `<` type (`, volatile` $volatile^)? (`, corank: corank` $corank^)? `>`
mlir::Type fir::BoxType::parse(mlir::AsmParser &parser) {
mlir::Type eleTy;
auto location = parser.getCurrentLocation();
auto *context = parser.getContext();
bool isVolatile = false;
+ int64_t corank = 0;
if (parser.parseLess() || parser.parseType(eleTy))
return {};
- if (parseOptionalCommaAndKeyword(parser, getVolatileKeyword(), isVolatile))
- return {};
+ if (mlir::succeeded(parser.parseOptionalComma())) {
+ // Fortran 2023 C871
+ // VOLATILE attribute shall not be specified for a coarray, so the
+ // "volatile" keyword cannot coexist with the "corank".
+ if (mlir::succeeded(parser.parseOptionalKeyword(getVolatileKeyword())))
+ isVolatile = true;
+ else if (mlir::succeeded(parser.parseKeyword(getCorankKeyword())))
+ if (mlir::succeeded(parser.parseOptionalColon()))
+ if (!mlir::succeeded(parser.parseInteger(corank)))
+ return {};
+ }
if (parser.parseGreater())
return {};
- return parser.getChecked<fir::BoxType>(location, context, eleTy, isVolatile);
+ return parser.getChecked<fir::BoxType>(location, context, eleTy, isVolatile,
+ corank);
}
void fir::BoxType::print(mlir::AsmPrinter &printer) const {
printer << "<" << getEleTy();
if (isVolatile())
printer << ", " << getVolatileKeyword();
+ if (getCorank())
+ printer << ", corank:" << getCorank();
printer << '>';
}
llvm::LogicalResult
fir::BoxType::verify(llvm::function_ref<mlir::InFlightDiagnostic()> emitError,
- mlir::Type eleTy, bool isVolatile) {
+ mlir::Type eleTy, bool isVolatile, int64_t corank) {
if (mlir::isa<fir::BaseBoxType>(eleTy))
return emitError() << "invalid element type\n";
// TODO
@@ -883,32 +905,44 @@ void fir::CharacterType::print(mlir::AsmPrinter &printer) const {
// ClassType
//===----------------------------------------------------------------------===//
-// `class` `<` type (`, volatile` $volatile^)? `>`
+// `class` `<` type (`, volatile` $volatile^)? (`, corank: corank` $corank^)?`>`
mlir::Type fir::ClassType::parse(mlir::AsmParser &parser) {
mlir::Type eleTy;
auto location = parser.getCurrentLocation();
auto *context = parser.getContext();
bool isVolatile = false;
+ int64_t corank = 0;
if (parser.parseLess() || parser.parseType(eleTy))
return {};
- if (parseOptionalCommaAndKeyword(parser, getVolatileKeyword(), isVolatile))
- return {};
+ if (mlir::succeeded(parser.parseOptionalComma())) {
+ // Fortran 2023 C871
+ // VOLATILE attribute shall not be specified for a coarray, so the
+ // "volatile" keyword cannot coexist with the "corank".
+ if (mlir::succeeded(parser.parseOptionalKeyword(getVolatileKeyword())))
+ isVolatile = true;
+ else if (mlir::succeeded(parser.parseKeyword(getCorankKeyword())))
+ if (mlir::succeeded(parser.parseOptionalColon()))
+ if (!mlir::succeeded(parser.parseInteger(corank)))
+ return {};
+ }
if (parser.parseGreater())
return {};
- return parser.getChecked<fir::ClassType>(location, context, eleTy,
- isVolatile);
+ return parser.getChecked<fir::ClassType>(location, context, eleTy, isVolatile,
+ corank);
}
void fir::ClassType::print(mlir::AsmPrinter &printer) const {
printer << "<" << getEleTy();
if (isVolatile())
printer << ", " << getVolatileKeyword();
+ if (getCorank())
+ printer << ", corank:" << getCorank();
printer << '>';
}
llvm::LogicalResult
fir::ClassType::verify(llvm::function_ref<mlir::InFlightDiagnostic()> emitError,
- mlir::Type eleTy, bool isVolatile) {
+ mlir::Type eleTy, bool isVolatile, int64_t corank) {
if (mlir::isa<fir::RecordType, fir::SequenceType, fir::HeapType,
fir::PointerType, mlir::NoneType, mlir::IntegerType,
mlir::FloatType, fir::CharacterType, fir::LogicalType,
@@ -1559,6 +1593,13 @@ bool BaseBoxType::isArray() const {
return llvm::isa<fir::SequenceType>(getElementOrSequenceType());
}
+bool BaseBoxType::isCoarray() const {
+ return llvm::TypeSwitch<mlir::Type, bool>(*this)
+ .Case<fir::BoxType, fir::ClassType>(
+ [](auto t) { return t.getCorank() > 0; })
+ .Default([](mlir::Type) { return false; });
+}
+
//===----------------------------------------------------------------------===//
// FIROpsDialect
//===----------------------------------------------------------------------===//
diff --git a/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp b/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp
index ebeba9aa51494..06f69b8aa07dd 100644
--- a/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp
+++ b/flang/lib/Optimizer/Dialect/MIF/MIFOps.cpp
@@ -10,6 +10,7 @@
#include "flang/Optimizer/Builder/Todo.h"
#include "flang/Optimizer/Dialect/FIRAttr.h"
#include "flang/Optimizer/Dialect/FIROps.h"
+#include "flang/Optimizer/Dialect/FIROpsSupport.h"
#include "flang/Optimizer/Dialect/FIRType.h"
#include "flang/Optimizer/Dialect/MIF/MIFDialect.h"
#include "flang/Optimizer/HLFIR/HLFIROps.h"
@@ -18,6 +19,15 @@
#include "llvm/ADT/SmallVector.h"
#include <tuple>
+template <class T>
+static llvm::LogicalResult checkCorank(T op) {
+ mlir::Type coarrayType = fir::unwrapRefType(op.getCoarray().getType());
+ if (auto boxTy = mlir::dyn_cast<fir::BaseBoxType>(coarrayType))
+ if (boxTy.isCoarray())
+ return mlir::success();
+ return op.emitOpError("`coarray` must have a corank.");
+}
+
// Function used to check if a type has POINTER or ALLOCATABLE component.
// Currently an allocation of coarray with this kind of component are not yet
// supported.
@@ -64,22 +74,35 @@ llvm::LogicalResult mif::NumImagesOp::verify() {
// ThisImageOp
//===----------------------------------------------------------------------===//
+void mif::ThisImageOp::build(mlir::OpBuilder &builder,
+ mlir::OperationState &result, mlir::Value coarray,
+ mlir::Value dim, mlir::Value team) {
+ mlir::Type resultTy = builder.getI64Type();
+ build(builder, result, resultTy, coarray, dim, team);
+}
+
void mif::ThisImageOp::build(mlir::OpBuilder &builder,
mlir::OperationState &result, mlir::Value coarray,
mlir::Value team) {
- build(builder, result, coarray, /*dim*/ mlir::Value{}, team);
+ mlir::Type i64Ty = builder.getI64Type();
+ mlir::Type resultTy = fir::BoxType::get(
+ fir::SequenceType::get({fir::SequenceType::getUnknownExtent()}, i64Ty));
+ build(builder, result, resultTy, coarray, /*dim*/ mlir::Value{}, team);
}
void mif::ThisImageOp::build(mlir::OpBuilder &builder,
mlir::OperationState &result, mlir::Value team) {
- build(builder, result, /*coarray*/ mlir::Value{}, /*dim*/ mlir::Value{},
- team);
+ mlir::Type resultTy = builder.getI32Type();
+ build(builder, result, resultTy, /*coarray*/ mlir::Value{},
+ /*dim*/ mlir::Value{}, team);
}
llvm::LogicalResult mif::ThisImageOp::verify() {
if (getDim() && !getCoarray())
return emitOpError(
"`dim` must be provied at the same time as the `coarray` argument.");
+ if (getCoarray())
+ return checkCorank(*this);
return mlir::success();
}
@@ -269,5 +292,65 @@ llvm::LogicalResult mif::AllocCoarrayOp::verify() {
return mlir::success();
}
+//===----------------------------------------------------------------------===//
+// LcoboundOp
+//===----------------------------------------------------------------------===//
+
+llvm::LogicalResult mif::LcoboundOp::verify() {
+ if (getCoarray())
+ return checkCorank(*this);
+ return mlir::success();
+}
+
+//===----------------------------------------------------------------------===//
+// UcoboundOp
+//===----------------------------------------------------------------------===//
+
+llvm::LogicalResult mif::UcoboundOp::verify() {
+ if (getCoarray())
+ return checkCorank(*this);
+ return mlir::success();
+}
+
+//===----------------------------------------------------------------------===//
+// CoshapeOp
+//===----------------------------------------------------------------------===//
+
+void mif::CoshapeOp::build(mlir::OpBuilder &builder,
+ mlir::OperationState &result, mlir::Value coarray) {
+ mlir::Type i64Ty = builder.getI64Type();
+ mlir::Type resultTy = fir::BoxType::get(
+ fir::SequenceType::get({fir::SequenceType::getUnknownExtent()}, i64Ty));
+ build(builder, result, resultTy, coarray);
+}
+
+llvm::LogicalResult mif::CoshapeOp::verify() {
+ if (getCoarray())
+ return checkCorank(*this);
+ return mlir::success();
+}
+
+//===----------------------------------------------------------------------===//
+// ImageIndexOp
+//===----------------------------------------------------------------------===//
+
+void mif::ImageIndexOp::build(mlir::OpBuilder &builder,
+ mlir::OperationState &result, mlir::Value coarray,
+ mlir::Value sub, mlir::Value teamArg) {
+ bool isTeamNumber =
+ teamArg && fir::unwrapPassByRefType(teamArg.getType()).isInteger();
+ if (!isTeamNumber)
+ build(builder, result, coarray, sub, teamArg, /*team*/ mlir::Value{});
+ else
+ build(builder, result, coarray, sub, /*team_number*/ mlir::Value{},
+ teamArg);
+}
+
+llvm::LogicalResult mif::ImageIndexOp::verify() {
+ if (getCoarray())
+ return checkCorank(*this);
+ return mlir::success();
+}
+
#define GET_OP_CLASSES
#include "flang/Optimizer/Dialect/MIF/MIFOps.cpp.inc"
diff --git a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
index 3eb46efdcd45a..e4085a9ff2359 100644
--- a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
+++ b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
@@ -139,6 +139,11 @@ void storeCoarrayHandle(fir::FirOpBuilder &builder, mlir::Location loc,
fir::StoreOp::create(builder, loc, coarrayHandle, addrOf);
}
+std::int64_t getCorank(mlir::Value coarray) {
+ mlir::Type coarrayType = fir::unwrapRefType(coarray.getType());
+ return fir::getBoxCorank(coarrayType);
+}
+
static int computeElementByteSize(mlir::Location loc, mlir::Type type,
fir::KindMapping &kindMap,
bool emitErrorOnFailure = true) {
@@ -430,27 +435,72 @@ struct MIFThisImageOpConversion
fir::FirOpBuilder builder(rewriter, mod);
mlir::Location loc = op.getLoc();
- if (op.getCoarray())
- TODO(loc, "coarray: mif.this_image op with coarray argument");
- else {
- mlir::Type i32Ty = builder.getI32Type();
- mlir::Type boxTy = fir::BoxType::get(rewriter.getNoneType());
+ mlir::Type i64Ty = builder.getI64Type();
+ mlir::Type i32Ty = builder.getI32Type();
+ mlir::Type boxTy = fir::BoxType::get(rewriter.getNoneType());
+
+ mlir::Value teamArg = op.getTeam();
+ if (!op.getTeam())
+ teamArg = fir::AbsentOp::create(builder, loc, boxTy);
+ else
+ teamArg = builder.createBox(loc, teamArg);
+
+ if (op.getCoarray()) {
+ llvm::SmallVector<mlir::Value> args;
+ mlir::FunctionType ftype;
+ mlir::func::FuncOp funcOp;
+ mlir::Value result;
+ mlir::Value coarrayHandle =
+ getCoarrayHandle(builder, loc, op.getCoarray());
+ if (mlir::Value d = op.getDim()) {
+ mlir::Value dim = builder.createTemporary(loc, i32Ty);
+ d = builder.createConvert(loc, i32Ty, d);
+ fir::StoreOp::create(builder, loc, d, dim);
+ result = builder.createTemporary(loc, i64Ty);
+ ftype = mlir::FunctionType::get(builder.getContext(),
+ /*inputs*/
+ {boxTy, builder.getRefType(i32Ty),
+ boxTy, builder.getRefType(i64Ty)},
+ /*results*/ {});
+ funcOp = builder.createFunction(
+ loc, getPRIFProcName("this_image_with_dim"), ftype);
+ args = fir::runtime::createArguments(builder, loc, ftype, coarrayHandle,
+ dim, teamArg, result);
+ fir::CallOp::create(builder, loc, funcOp, args);
+ result = fir::LoadOp::create(builder, loc, result).getResult();
+ result = builder.createConvert(loc, op.getType(), result);
+ } else {
+ std::int64_t corank = getCorank(op.getCoarray());
+ mlir::Type resTy = fir::SequenceType::get({corank}, i64Ty);
+ // Need to embox the array
+ result = builder.createBox(loc, builder.createTemporary(loc, resTy));
+ ftype = mlir::FunctionType::get(
+ builder.getContext(),
+ /*inputs*/ {boxTy, boxTy, fir::BoxType::get(resTy)},
+ /*results*/ {});
+ funcOp = builder.createFunction(
+ loc, getPRIFProcName("this_image_with_coarray"), ftype);
+ args = fir::runtime::createArguments(builder, loc, ftype, coarrayHandle,
+ teamArg, result);
+ fir::CallOp::create(builder, loc, funcOp, args);
+ result = fir::ConvertOp::create(builder, loc,
+ genBoxedSequenceType(i64Ty), result);
+ }
+ rewriter.replaceOp(op, result);
+ } else {
mlir::Value result = builder.createTemporary(loc, i32Ty);
mlir::FunctionType ftype = mlir::FunctionType::get(
builder.getContext(),
/*inputs*/ {boxTy, builder.getRefType(i32Ty)}, /*results*/ {});
- mlir::Value teamArg = op.getTeam();
- if (!op.getTeam())
- teamArg = fir::AbsentOp::create(builder, loc, boxTy);
-
mlir::func::FuncOp funcOp = builder.createFunction(
loc, getPRIFProcName("this_image_no_coarray"), ftype);
+
llvm::SmallVector<mlir::Value> args =
fir::runtime::createArguments(builder, loc, ftype, teamArg, result);
fir::CallOp::create(builder, loc, funcOp, args);
rewriter.replaceOpWithNewOp<fir::LoadOp>(op, result);
- return mlir::success();
}
+ return mlir::success();
}
};
@@ -1048,10 +1098,8 @@ struct MIFAllocCoarrayOpConversion
mlir::Value coarrayHandle =
builder.createBox(loc, builder.createTemporary(loc, handleTy));
- mlir::Value allocMem = builder.createTemporary(loc, ptrTy);
- mlir::Value addrCvt =
+ mlir::Value allocMem =
fir::ConvertOp::create(builder, loc, ptrTy, op.getBox());
- fir::StoreOp::create(builder, loc, addrCvt, allocMem);
mlir::Value sizeInBytes =
getSizeInBytes(builder, loc, mod, dl, typeConverter, op.getBox());
@@ -1114,6 +1162,161 @@ struct MIFDeallocCoarrayOpConversion
}
};
+/// Convert mif.coshape operation to runtime call of 'prif_coshape'
+struct MIFCoshapeOpConversion : public mlir::OpRewritePattern<mif::CoshapeOp> {
+ using OpRewritePattern::OpRewritePattern;
+
+ mlir::LogicalResult
+ matchAndRewrite(mif::CoshapeOp op,
+ mlir::PatternRewriter &rewriter) const override {
+ auto mod = op->template getParentOfType<mlir::ModuleOp>();
+ fir::FirOpBuilder builder(rewriter, mod);
+ mlir::Location loc = op.getLoc();
+ mlir::Type i64Ty = builder.getI64Type();
+ mlir::Type boxTy = fir::BoxType::get(builder.getNoneType());
+
+ mlir::FunctionType ftype =
+ mlir::FunctionType::get(builder.getContext(),
+ /*inputs*/ {boxTy, genBoxedSequenceType(i64Ty)},
+ /*results*/ {});
+ mlir::func::FuncOp funcOp =
+ builder.createFunction(loc, getPRIFProcName("coshape"), ftype);
+
+ mlir::Value coarrayHandle = getCoarrayHandle(builder, loc, op.getCoarray());
+ std::int64_t corank = getCorank(op.getCoarray());
+ mlir::Type resultType = fir::SequenceType::get(
+ static_cast<fir::SequenceType::Extent>(corank), i64Ty);
+ mlir::Value result =
+ builder.createBox(loc, builder.createTemporary(loc, resultType));
+
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, ftype, coarrayHandle, result);
+ fir::CallOp::create(builder, loc, funcOp, args);
+ result = fir::ConvertOp::create(builder, loc, genBoxedSequenceType(i64Ty),
+ result);
+ rewriter.replaceOp(op, result);
+ return mlir::success();
+ }
+};
+
+template <class T>
+mlir::LogicalResult CoboundOpConversion(T op, mlir::PatternRewriter &rewriter,
+ const std::string &prefix) {
+ auto mod = op->template getParentOfType<mlir::ModuleOp>();
+ fir::FirOpBuilder builder(rewriter, mod);
+ mlir::Location loc = op.getLoc();
+ mlir::Type i64Ty = builder.getI64Type();
+ mlir::Type boxTy = fir::BoxType::get(builder.getNoneType());
+
+ mlir::Value coarrayHandle = getCoarrayHandle(builder, loc, op.getCoarray());
+ mlir::Type i32Ty = builder.getI32Type();
+ mlir::FunctionType ftype = mlir::FunctionType::get(
+ builder.getContext(),
+ /*inputs*/
+ {boxTy, builder.getRefType(i32Ty), builder.getRefType(i64Ty)},
+ /*results*/ {});
+ mlir::func::FuncOp funcOp =
+ builder.createFunction(loc, getPRIFProcName(prefix + "_with_dim"), ftype);
+
+ mlir::Value result = builder.createTemporary(loc, i64Ty);
+ mlir::Value dim = builder.createTemporary(loc, i32Ty);
+ mlir::Value d = fir::ConvertOp::create(builder, loc, i32Ty, op.getDim());
+ fir::StoreOp::create(builder, loc, d, dim);
+
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, ftype, coarrayHandle, dim, result);
+ fir::CallOp::create(builder, loc, funcOp, args);
+ result = fir::LoadOp::create(builder, loc, result).getResult();
+ result = builder.createConvert(loc, op.getType(), result);
+ rewriter.replaceOp(op, result);
+ return mlir::success();
+}
+
+/// Convert mif.lcobound operation to runtime call of
+/// 'prif_lcobound_{with|no}_dim'
+struct MIFLcoboundOpConversion
+ : public mlir::OpRewritePattern<mif::LcoboundOp> {
+ using OpRewritePattern::OpRewritePattern;
+
+ mlir::LogicalResult
+ matchAndRewrite(mif::LcoboundOp op,
+ mlir::PatternRewriter &rewriter) const override {
+ return CoboundOpConversion(op, rewriter, "lcobound");
+ }
+};
+
+/// Convert mif.ucobound operation to runtime call of
+/// 'prif_ucobound_{with|no}_dim'
+struct MIFUcoboundOpConversion
+ : public mlir::OpRewritePattern<mif::UcoboundOp> {
+ using OpRewritePattern::OpRewritePattern;
+
+ mlir::LogicalResult
+ matchAndRewrite(mif::UcoboundOp op,
+ mlir::PatternRewriter &rewriter) const override {
+ return CoboundOpConversion(op, rewriter, "ucobound");
+ }
+};
+
+/// Convert mif.image_index operation to runtime call of
+/// 'prif_image_index[_with_team[_number]]'
+struct MIFImageIndexOpConversion
+ : public mlir::OpRewritePattern<mif::ImageIndexOp> {
+ using OpRewritePattern::OpRewritePattern;
+
+ mlir::LogicalResult
+ matchAndRewrite(mif::ImageIndexOp op,
+ mlir::PatternRewriter &rewriter) const override {
+ auto mod = op->template getParentOfType<mlir::ModuleOp>();
+ fir::FirOpBuilder builder(rewriter, mod);
+ mlir::Location loc = op.getLoc();
+ mlir::Type i64Ty = builder.getI64Type();
+ mlir::Type i32Ty = builder.getI32Type();
+ mlir::Type resTy = builder.getRefType(i32Ty);
+ mlir::Type boxTy = fir::BoxType::get(builder.getNoneType());
+ mlir::Value result = builder.createTemporary(loc, i32Ty);
+
+ mlir::func::FuncOp funcOp;
+ llvm::SmallVector<mlir::Value> args;
+ mlir::Value coarrayHandle = getCoarrayHandle(builder, loc, op.getCoarray());
+ if (!op.getTeam() && !op.getTeamNumber()) {
+ mlir::FunctionType ftype = mlir::FunctionType::get(
+ builder.getContext(),
+ /*inputs*/ {boxTy, genBoxedSequenceType(i64Ty), resTy},
+ /*results*/ {});
+ funcOp =
+ builder.createFunction(loc, getPRIFProcName("image_index"), ftype);
+ args = fir::runtime::createArguments(builder, loc, ftype, coarrayHandle,
+ op.getSub(), result);
+ } else {
+ mlir::Value team = op.getTeam() ? op.getTeam() : op.getTeamNumber();
+ std::string imageIndexName =
+ op.getTeamNumber() ? getPRIFProcName("image_index_with_team_number")
+ : getPRIFProcName("image_index_with_team");
+ mlir::Type teamTy = boxTy;
+ if (op.getTeamNumber()) {
+ teamTy = builder.getRefType(i64Ty);
+ mlir::Value t = builder.createConvert(loc, i64Ty, team);
+ team = builder.createTemporary(loc, i64Ty);
+ fir::StoreOp::create(builder, loc, t, team);
+ } else {
+ team = builder.createBox(loc, team);
+ }
+ mlir::FunctionType ftype = mlir::FunctionType::get(
+ builder.getContext(),
+ /*inputs*/ {boxTy, genBoxedSequenceType(i64Ty), teamTy, resTy},
+ /*results*/ {});
+ funcOp = builder.createFunction(loc, imageIndexName, ftype);
+
+ args = fir::runtime::createArguments(builder, loc, ftype, coarrayHandle,
+ op.getSub(), team, result);
+ }
+ fir::CallOp::create(builder, loc, funcOp, args);
+ rewriter.replaceOpWithNewOp<fir::LoadOp>(op, result);
+ return mlir::success();
+ }
+};
+
class MIFOpConversion : public fir::impl::MIFOpConversionBase<MIFOpConversion> {
public:
void runOnOperation() override {
@@ -1165,6 +1368,8 @@ void mif::populateMIFOpConversionPatterns(
MIFCoMaxOpConversion, MIFCoMinOpConversion,
MIFCoSumOpConversion, MIFFormTeamOpConversion,
MIFChangeTeamOpConversion, MIFGetTeamOpConversion,
- MIFTeamNumberOpConversion, MIFDeallocCoarrayOpConversion>(
+ MIFTeamNumberOpConversion, MIFDeallocCoarrayOpConversion,
+ MIFCoshapeOpConversion, MIFLcoboundOpConversion,
+ MIFUcoboundOpConversion, MIFImageIndexOpConversion>(
patterns.getContext());
}
diff --git a/flang/test/Fir/MIF/cobound.mlir b/flang/test/Fir/MIF/cobound.mlir
new file mode 100644
index 0000000000000..8a354a7094bd4
--- /dev/null
+++ b/flang/test/Fir/MIF/cobound.mlir
@@ -0,0 +1,104 @@
+// RUN: fir-opt --mif-convert %s | FileCheck %s
+
+module attributes {dlti.dl_spec = #dlti.dl_spec<!llvm.ptr<270> = dense<32> : vector<4xi64>, !llvm.ptr<271> = dense<32> : vector<4xi64>, !llvm.ptr<272> = dense<64> : vector<4xi64>, i64 = dense<64> : vector<2xi64>, i128 = dense<128> : vector<2xi64>, f80 = dense<128> : vector<2xi64>, !llvm.ptr = dense<64> : vector<4xi64>, i1 = dense<8> : vector<2xi64>, i8 = dense<8> : vector<2xi64>, i16 = dense<16> : vector<2xi64>, i32 = dense<32> : vector<2xi64>, f16 = dense<16> : vector<2xi64>, f64 = dense<64> : vector<2xi64>, f128 = dense<128> : vector<2xi64>, "dlti.endianness" = "little", "dlti.mangling_mode" = "e", "dlti.legal_int_widths" = array<i32: 8, 16, 32, 64>, "dlti.stack_alignment" = 128 : i64>, fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.data_layout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", llvm.ident = "flang version 23.0.0 (git at github.com:SiPearl/llvm-project.git d31a4730513391710d91c5ad33bb8ea3d68db3cb)", llvm.target_triple = "x86_64-unknown-linux-gnu"} {
+// CHECK-LABEL: func.func @_QQmain
+ func.func @_QQmain() attributes {fir.bindc_name = "TEST"} {
+ %0 = fir.alloca !fir.array<2xi64>
+ %1 = fir.alloca !fir.array<3xi64>
+ %2 = fir.dummy_scope : !fir.dscope
+ %3 = fir.address_of(@_QFEa) : !fir.ref<!fir.box<!fir.heap<i32>, corank:3>>
+ %4:2 = hlfir.declare %3 {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFEa"} : (!fir.ref<!fir.box<!fir.heap<i32>, corank:3>>) -> (!fir.ref<!fir.box<!fir.heap<i32>, corank:3>>, !fir.ref<!fir.box<!fir.heap<i32>, corank:3>>)
+ %c3 = arith.constant 3 : index
+ %5 = fir.alloca !fir.array<3xi32> {bindc_name = "res1", uniq_name = "_QFEres1"}
+ %6 = fir.shape %c3 : (index) -> !fir.shape<1>
+ %7:2 = hlfir.declare %5(%6) {uniq_name = "_QFEres1"} : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<3xi32>>, !fir.ref<!fir.array<3xi32>>)
+ %8 = fir.alloca i32 {bindc_name = "res2", uniq_name = "_QFEres2"}
+ %9:2 = hlfir.declare %8 {uniq_name = "_QFEres2"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %10 = fir.absent !fir.box<none>
+ %c1_i64 = arith.constant 1 : i64
+ %c2_i32 = arith.constant 2 : i32
+ %11 = fir.convert %c2_i32 : (i32) -> i64
+ %c0 = arith.constant 0 : index
+ %12 = fir.coordinate_of %1, %c0 : (!fir.ref<!fir.array<3xi64>>, index) -> !fir.ref<i64>
+ fir.store %c1_i64 to %12 : !fir.ref<i64>
+ %13 = fir.coordinate_of %0, %c0 : (!fir.ref<!fir.array<2xi64>>, index) -> !fir.ref<i64>
+ fir.store %11 to %13 : !fir.ref<i64>
+ %c3_i32 = arith.constant 3 : i32
+ %14 = fir.convert %c3_i32 : (i32) -> i64
+ %c5_i32 = arith.constant 5 : i32
+ %15 = fir.convert %c5_i32 : (i32) -> i64
+ %c1 = arith.constant 1 : index
+ %16 = fir.coordinate_of %1, %c1 : (!fir.ref<!fir.array<3xi64>>, index) -> !fir.ref<i64>
+ fir.store %14 to %16 : !fir.ref<i64>
+ %17 = fir.coordinate_of %0, %c1 : (!fir.ref<!fir.array<2xi64>>, index) -> !fir.ref<i64>
+ fir.store %15 to %17 : !fir.ref<i64>
+ %c2 = arith.constant 2 : index
+ %18 = fir.coordinate_of %1, %c2 : (!fir.ref<!fir.array<3xi64>>, index) -> !fir.ref<i64>
+ fir.store %c1_i64 to %18 : !fir.ref<i64>
+ %19 = fir.embox %1 : (!fir.ref<!fir.array<3xi64>>) -> !fir.box<!fir.array<3xi64>>
+ %20 = fir.embox %0 : (!fir.ref<!fir.array<2xi64>>) -> !fir.box<!fir.array<2xi64>>
+ mif.alloc_coarray %4#0 lcobounds %19 ucobounds %20 errmsg %10 {uniq_name = "_QFEa"} : (!fir.ref<!fir.box<!fir.heap<i32>, corank:3>>, !fir.box<!fir.array<3xi64>>, !fir.box<!fir.array<2xi64>>, !fir.box<none>) -> ()
+ %21 = fir.load %4#0 : !fir.ref<!fir.box<!fir.heap<i32>, corank:3>>
+ %22 = fir.alloca !fir.array<3xi32>
+ %c1_i32 = arith.constant 1 : i32
+ %23 = mif.lcobound coarray %21 dim %c1_i32 : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ %c0_0 = arith.constant 0 : index
+ %24 = fir.coordinate_of %22, %c0_0 : (!fir.ref<!fir.array<3xi32>>, index) -> !fir.ref<i32>
+ fir.store %23 to %24 : !fir.ref<i32>
+ %c2_i32_1 = arith.constant 2 : i32
+ %25 = mif.lcobound coarray %21 dim %c2_i32_1 : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ %c1_2 = arith.constant 1 : index
+ %26 = fir.coordinate_of %22, %c1_2 : (!fir.ref<!fir.array<3xi32>>, index) -> !fir.ref<i32>
+ fir.store %25 to %26 : !fir.ref<i32>
+ %c3_i32_3 = arith.constant 3 : i32
+ %27 = mif.lcobound coarray %21 dim %c3_i32_3 : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ %c2_4 = arith.constant 2 : index
+ %28 = fir.coordinate_of %22, %c2_4 : (!fir.ref<!fir.array<3xi32>>, index) -> !fir.ref<i32>
+ fir.store %27 to %28 : !fir.ref<i32>
+ %29 = fir.embox %22 : (!fir.ref<!fir.array<3xi32>>) -> !fir.box<!fir.array<3xi32>>
+ %30:2 = hlfir.declare %29 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box<!fir.array<3xi32>>) -> (!fir.box<!fir.array<3xi32>>, !fir.box<!fir.array<3xi32>>)
+ %false = arith.constant false
+ %31 = hlfir.as_expr %30#0 move %false : (!fir.box<!fir.array<3xi32>>, i1) -> !hlfir.expr<3xi32>
+ hlfir.assign %31 to %7#0 : !hlfir.expr<3xi32>, !fir.ref<!fir.array<3xi32>>
+ hlfir.destroy %31 : !hlfir.expr<3xi32>
+ %c2_i32_5 = arith.constant 2 : i32
+ %32 = fir.load %4#0 : !fir.ref<!fir.box<!fir.heap<i32>, corank:3>>
+ %33 = mif.lcobound coarray %32 dim %c2_i32_5 : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ hlfir.assign %33 to %9#0 : i32, !fir.ref<i32>
+ %34 = fir.load %4#0 : !fir.ref<!fir.box<!fir.heap<i32>, corank:3>>
+ %35 = fir.alloca !fir.array<3xi32>
+ %c1_i32_6 = arith.constant 1 : i32
+ %36 = mif.ucobound coarray %34 dim %c1_i32_6 : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ %c0_7 = arith.constant 0 : index
+ %37 = fir.coordinate_of %35, %c0_7 : (!fir.ref<!fir.array<3xi32>>, index) -> !fir.ref<i32>
+ fir.store %36 to %37 : !fir.ref<i32>
+ %c2_i32_8 = arith.constant 2 : i32
+ %38 = mif.ucobound coarray %34 dim %c2_i32_8 : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ %c1_9 = arith.constant 1 : index
+ %39 = fir.coordinate_of %35, %c1_9 : (!fir.ref<!fir.array<3xi32>>, index) -> !fir.ref<i32>
+ fir.store %38 to %39 : !fir.ref<i32>
+ %c3_i32_10 = arith.constant 3 : i32
+ %40 = mif.ucobound coarray %34 dim %c3_i32_10 : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ %c2_11 = arith.constant 2 : index
+ %41 = fir.coordinate_of %35, %c2_11 : (!fir.ref<!fir.array<3xi32>>, index) -> !fir.ref<i32>
+ fir.store %40 to %41 : !fir.ref<i32>
+ %42 = fir.embox %35 : (!fir.ref<!fir.array<3xi32>>) -> !fir.box<!fir.array<3xi32>>
+ %43:2 = hlfir.declare %42 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box<!fir.array<3xi32>>) -> (!fir.box<!fir.array<3xi32>>, !fir.box<!fir.array<3xi32>>)
+ %false_12 = arith.constant false
+ %44 = hlfir.as_expr %43#0 move %false_12 : (!fir.box<!fir.array<3xi32>>, i1) -> !hlfir.expr<3xi32>
+ hlfir.assign %44 to %7#0 : !hlfir.expr<3xi32>, !fir.ref<!fir.array<3xi32>>
+ hlfir.destroy %44 : !hlfir.expr<3xi32>
+ %c2_i32_13 = arith.constant 2 : i32
+ %45 = fir.load %4#0 : !fir.ref<!fir.box<!fir.heap<i32>, corank:3>>
+ %46 = mif.ucobound coarray %45 dim %c2_i32_13 : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ hlfir.assign %46 to %9#0 : i32, !fir.ref<i32>
+ return
+ }
+}
+
+// CHECK: fir.call @_QMprifPprif_lcobound_with_dim
+// CHECK: fir.call @_QMprifPprif_lcobound_with_dim
+// CHECK: fir.call @_QMprifPprif_lcobound_with_dim
+// CHECK: fir.call @_QMprifPprif_ucobound_with_dim
+// CHECK: fir.call @_QMprifPprif_ucobound_with_dim
+// CHECK: fir.call @_QMprifPprif_ucobound_with_dim
diff --git a/flang/test/Fir/MIF/coshape.mlir b/flang/test/Fir/MIF/coshape.mlir
new file mode 100644
index 0000000000000..849a3048d8810
--- /dev/null
+++ b/flang/test/Fir/MIF/coshape.mlir
@@ -0,0 +1,80 @@
+// RUN: fir-opt --mif-convert %s | FileCheck %s
+
+module attributes {dlti.dl_spec = #dlti.dl_spec<!llvm.ptr<270> = dense<32> : vector<4xi64>, !llvm.ptr<271> = dense<32> : vector<4xi64>, !llvm.ptr<272> = dense<64> : vector<4xi64>, i64 = dense<64> : vector<2xi64>, i128 = dense<128> : vector<2xi64>, f80 = dense<128> : vector<2xi64>, !llvm.ptr = dense<64> : vector<4xi64>, i1 = dense<8> : vector<2xi64>, i8 = dense<8> : vector<2xi64>, i16 = dense<16> : vector<2xi64>, i32 = dense<32> : vector<2xi64>, f16 = dense<16> : vector<2xi64>, f64 = dense<64> : vector<2xi64>, f128 = dense<128> : vector<2xi64>, "dlti.endianness" = "little", "dlti.mangling_mode" = "e", "dlti.legal_int_widths" = array<i32: 8, 16, 32, 64>, "dlti.stack_alignment" = 128 : i64>, fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.data_layout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", llvm.ident = "flang version 23.0.0 (git at github.com:SiPearl/llvm-project.git d31a4730513391710d91c5ad33bb8ea3d68db3cb)", llvm.target_triple = "x86_64-unknown-linux-gnu"} {
+ func.func @_QQmain() attributes {fir.bindc_name = "TEST"} {
+ %0 = fir.alloca !fir.array<2xi64>
+ %1 = fir.alloca !fir.array<3xi64>
+ %2 = fir.dummy_scope : !fir.dscope
+ %3 = fir.address_of(@_QFEa) : !fir.ref<i32>
+ %c1_i64 = arith.constant 1 : i64
+ %c0 = arith.constant 0 : index
+ %4 = fir.coordinate_of %1, %c0 : (!fir.ref<!fir.array<3xi64>>, index) -> !fir.ref<i64>
+ fir.store %c1_i64 to %4 : !fir.ref<i64>
+ %c3_i64 = arith.constant 3 : i64
+ %c1 = arith.constant 1 : index
+ %5 = fir.coordinate_of %1, %c1 : (!fir.ref<!fir.array<3xi64>>, index) -> !fir.ref<i64>
+ fir.store %c3_i64 to %5 : !fir.ref<i64>
+ %c1_i64_0 = arith.constant 1 : i64
+ %c2 = arith.constant 2 : index
+ %6 = fir.coordinate_of %1, %c2 : (!fir.ref<!fir.array<3xi64>>, index) -> !fir.ref<i64>
+ fir.store %c1_i64_0 to %6 : !fir.ref<i64>
+ %7 = fir.embox %1 : (!fir.ref<!fir.array<3xi64>>) -> !fir.box<!fir.array<3xi64>>
+ %c1_i64_1 = arith.constant 1 : i64
+ %c0_2 = arith.constant 0 : index
+ %8 = fir.coordinate_of %0, %c0_2 : (!fir.ref<!fir.array<2xi64>>, index) -> !fir.ref<i64>
+ fir.store %c1_i64_1 to %8 : !fir.ref<i64>
+ %c3_i64_3 = arith.constant 3 : i64
+ %c1_4 = arith.constant 1 : index
+ %9 = fir.coordinate_of %0, %c1_4 : (!fir.ref<!fir.array<2xi64>>, index) -> !fir.ref<i64>
+ fir.store %c3_i64_3 to %9 : !fir.ref<i64>
+ %10 = fir.embox %0 : (!fir.ref<!fir.array<2xi64>>) -> !fir.box<!fir.array<2xi64>>
+ mif.alloc_coarray %3 lcobounds %7 ucobounds %10 {uniq_name = "_QFEa"} : (!fir.ref<i32>, !fir.box<!fir.array<3xi64>>, !fir.box<!fir.array<2xi64>>) -> ()
+ %11:2 = hlfir.declare %3 {uniq_name = "_QFEa"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %c3 = arith.constant 3 : index
+ %12 = fir.alloca !fir.array<3xi32> {bindc_name = "res", uniq_name = "_QFEres"}
+ %13 = fir.shape %c3 : (index) -> !fir.shape<1>
+ %14:2 = hlfir.declare %12(%13) {uniq_name = "_QFEres"} : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<3xi32>>, !fir.ref<!fir.array<3xi32>>)
+ %c3_5 = arith.constant 3 : index
+ %15 = fir.alloca !fir.array<3xi64> {bindc_name = "res2", uniq_name = "_QFEres2"}
+ %16 = fir.shape %c3_5 : (index) -> !fir.shape<1>
+ %17:2 = hlfir.declare %15(%16) {uniq_name = "_QFEres2"} : (!fir.ref<!fir.array<3xi64>>, !fir.shape<1>) -> (!fir.ref<!fir.array<3xi64>>, !fir.ref<!fir.array<3xi64>>)
+ %18 = fir.embox %11#0 : (!fir.ref<i32>) -> !fir.box<i32, corank:3>
+ %19 = mif.coshape coarray %18 : (!fir.box<i32, corank:3>) -> !fir.box<!fir.array<?xi64>>
+ %20:2 = hlfir.declare %19 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box<!fir.array<?xi64>>) -> (!fir.box<!fir.array<?xi64>>, !fir.box<!fir.array<?xi64>>)
+ %false = arith.constant false
+ %21 = hlfir.as_expr %20#0 move %false : (!fir.box<!fir.array<?xi64>>, i1) -> !hlfir.expr<?xi64>
+ %c0_6 = arith.constant 0 : index
+ %22:3 = fir.box_dims %20#0, %c0_6 : (!fir.box<!fir.array<?xi64>>, index) -> (index, index, index)
+ %23 = fir.shape %22#1 : (index) -> !fir.shape<1>
+ %24 = hlfir.elemental %23 unordered : (!fir.shape<1>) -> !hlfir.expr<?xi32> {
+ ^bb0(%arg0: index):
+ %32 = hlfir.apply %21, %arg0 : (!hlfir.expr<?xi64>, index) -> i64
+ %33 = fir.convert %32 : (i64) -> i32
+ hlfir.yield_element %33 : i32
+ }
+ hlfir.assign %24 to %14#0 : !hlfir.expr<?xi32>, !fir.ref<!fir.array<3xi32>>
+ hlfir.destroy %24 : !hlfir.expr<?xi32>
+ hlfir.destroy %21 : !hlfir.expr<?xi64>
+ %25 = fir.embox %11#0 : (!fir.ref<i32>) -> !fir.box<i32, corank:3>
+ %26 = mif.coshape coarray %25 : (!fir.box<i32, corank:3>) -> !fir.box<!fir.array<?xi64>>
+ %27:2 = hlfir.declare %26 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box<!fir.array<?xi64>>) -> (!fir.box<!fir.array<?xi64>>, !fir.box<!fir.array<?xi64>>)
+ %false_7 = arith.constant false
+ %28 = hlfir.as_expr %27#0 move %false_7 : (!fir.box<!fir.array<?xi64>>, i1) -> !hlfir.expr<?xi64>
+ %c0_8 = arith.constant 0 : index
+ %29:3 = fir.box_dims %27#0, %c0_8 : (!fir.box<!fir.array<?xi64>>, index) -> (index, index, index)
+ %30 = fir.shape %29#1 : (index) -> !fir.shape<1>
+ %31 = hlfir.elemental %30 unordered : (!fir.shape<1>) -> !hlfir.expr<?xi64> {
+ ^bb0(%arg0: index):
+ %32 = hlfir.apply %28, %arg0 : (!hlfir.expr<?xi64>, index) -> i64
+ hlfir.yield_element %32 : i64
+ }
+ hlfir.assign %31 to %17#0 : !hlfir.expr<?xi64>, !fir.ref<!fir.array<3xi64>>
+ hlfir.destroy %31 : !hlfir.expr<?xi64>
+ hlfir.destroy %28 : !hlfir.expr<?xi64>
+ return
+ }
+}
+
+// CHECK-LABEL: func.func @_QQmain
+// CHECK: fir.call @_QMprifPprif_coshape
+// CHECK: fir.call @_QMprifPprif_coshape
diff --git a/flang/test/Fir/MIF/image_index.mlir b/flang/test/Fir/MIF/image_index.mlir
new file mode 100644
index 0000000000000..fc91063a5edc6
--- /dev/null
+++ b/flang/test/Fir/MIF/image_index.mlir
@@ -0,0 +1,78 @@
+// RUN: fir-opt --mif-convert %s | FileCheck %s
+
+module attributes {dlti.dl_spec = #dlti.dl_spec<!llvm.ptr<270> = dense<32> : vector<4xi64>, !llvm.ptr<271> = dense<32> : vector<4xi64>, !llvm.ptr<272> = dense<64> : vector<4xi64>, i64 = dense<64> : vector<2xi64>, i128 = dense<128> : vector<2xi64>, f80 = dense<128> : vector<2xi64>, !llvm.ptr = dense<64> : vector<4xi64>, i1 = dense<8> : vector<2xi64>, i8 = dense<8> : vector<2xi64>, i16 = dense<16> : vector<2xi64>, i32 = dense<32> : vector<2xi64>, f16 = dense<16> : vector<2xi64>, f64 = dense<64> : vector<2xi64>, f128 = dense<128> : vector<2xi64>, "dlti.endianness" = "little", "dlti.mangling_mode" = "e", "dlti.legal_int_widths" = array<i32: 8, 16, 32, 64>, "dlti.stack_alignment" = 128 : i64>, fir.defaultkind = "a1c4d8i4l4r4", fir.kindmap = "", llvm.data_layout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-i128:128-f80:128-n8:16:32:64-S128", llvm.ident = "flang version 23.0.0 (git at github.com:SiPearl/llvm-project.git d31a4730513391710d91c5ad33bb8ea3d68db3cb)", llvm.target_triple = "x86_64-unknown-linux-gnu"} {
+// CHECK-LABEL: func.func @_QQmain
+ func.func @_QQmain() attributes {fir.bindc_name = "TEST"} {
+ %0 = fir.alloca !fir.array<2xi64>
+ %1 = fir.alloca !fir.array<3xi64>
+ %2 = fir.dummy_scope : !fir.dscope
+ %3 = fir.address_of(@_QFEa) : !fir.ref<i32>
+ %c1_i64 = arith.constant 1 : i64
+ %c0 = arith.constant 0 : index
+ %4 = fir.coordinate_of %1, %c0 : (!fir.ref<!fir.array<3xi64>>, index) -> !fir.ref<i64>
+ fir.store %c1_i64 to %4 : !fir.ref<i64>
+ %c3_i64 = arith.constant 3 : i64
+ %c1 = arith.constant 1 : index
+ %5 = fir.coordinate_of %1, %c1 : (!fir.ref<!fir.array<3xi64>>, index) -> !fir.ref<i64>
+ fir.store %c3_i64 to %5 : !fir.ref<i64>
+ %c1_i64_0 = arith.constant 1 : i64
+ %c2 = arith.constant 2 : index
+ %6 = fir.coordinate_of %1, %c2 : (!fir.ref<!fir.array<3xi64>>, index) -> !fir.ref<i64>
+ fir.store %c1_i64_0 to %6 : !fir.ref<i64>
+ %7 = fir.embox %1 : (!fir.ref<!fir.array<3xi64>>) -> !fir.box<!fir.array<3xi64>>
+ %c1_i64_1 = arith.constant 1 : i64
+ %c0_2 = arith.constant 0 : index
+ %8 = fir.coordinate_of %0, %c0_2 : (!fir.ref<!fir.array<2xi64>>, index) -> !fir.ref<i64>
+ fir.store %c1_i64_1 to %8 : !fir.ref<i64>
+ %c3_i64_3 = arith.constant 3 : i64
+ %c1_4 = arith.constant 1 : index
+ %9 = fir.coordinate_of %0, %c1_4 : (!fir.ref<!fir.array<2xi64>>, index) -> !fir.ref<i64>
+ fir.store %c3_i64_3 to %9 : !fir.ref<i64>
+ %10 = fir.embox %0 : (!fir.ref<!fir.array<2xi64>>) -> !fir.box<!fir.array<2xi64>>
+ mif.alloc_coarray %3 lcobounds %7 ucobounds %10 {uniq_name = "_QFEa"} : (!fir.ref<i32>, !fir.box<!fir.array<3xi64>>, !fir.box<!fir.array<2xi64>>) -> ()
+ %11:2 = hlfir.declare %3 {uniq_name = "_QFEa"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %12 = fir.alloca i32 {bindc_name = "idx", uniq_name = "_QFEidx"}
+ %13:2 = hlfir.declare %12 {uniq_name = "_QFEidx"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %14 = fir.address_of(@_QFEsub) : !fir.ref<!fir.array<3xi32>>
+ %c3 = arith.constant 3 : index
+ %15 = fir.shape %c3 : (index) -> !fir.shape<1>
+ %16:2 = hlfir.declare %14(%15) {uniq_name = "_QFEsub"} : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<3xi32>>, !fir.ref<!fir.array<3xi32>>)
+ %17 = fir.address_of(@_QFEsub2) : !fir.ref<!fir.array<3xi64>>
+ %c3_5 = arith.constant 3 : index
+ %18 = fir.shape %c3_5 : (index) -> !fir.shape<1>
+ %19:2 = hlfir.declare %17(%18) {uniq_name = "_QFEsub2"} : (!fir.ref<!fir.array<3xi64>>, !fir.shape<1>) -> (!fir.ref<!fir.array<3xi64>>, !fir.ref<!fir.array<3xi64>>)
+ %20 = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}> {bindc_name = "team", uniq_name = "_QFEteam"}
+ %21:2 = hlfir.declare %20 {uniq_name = "_QFEteam"} : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>) -> (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>, !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>)
+ %22 = fir.address_of(@_QQ_QM__fortran_builtinsT__builtin_team_type.DerivedInit) : !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>
+ fir.copy %22 to %21#0 no_overlap : !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>, !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>
+ %23 = fir.alloca i32 {bindc_name = "team_number", uniq_name = "_QFEteam_number"}
+ %24:2 = hlfir.declare %23 {uniq_name = "_QFEteam_number"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %25 = fir.embox %11#0 : (!fir.ref<i32>) -> !fir.box<i32, corank:3>
+ %26 = fir.shape %c3 : (index) -> !fir.shape<1>
+ %27 = fir.embox %16#0(%26) : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<3xi32>>
+ %28 = mif.image_index coarray %25 sub %27 : (!fir.box<i32, corank:3>, !fir.box<!fir.array<3xi32>>) -> i32
+ hlfir.assign %28 to %13#0 : i32, !fir.ref<i32>
+ %29 = fir.embox %11#0 : (!fir.ref<i32>) -> !fir.box<i32, corank:3>
+ %30 = fir.shape %c3_5 : (index) -> !fir.shape<1>
+ %31 = fir.embox %19#0(%30) : (!fir.ref<!fir.array<3xi64>>, !fir.shape<1>) -> !fir.box<!fir.array<3xi64>>
+ %32 = mif.image_index coarray %29 sub %31 : (!fir.box<i32, corank:3>, !fir.box<!fir.array<3xi64>>) -> i32
+ hlfir.assign %32 to %13#0 : i32, !fir.ref<i32>
+ %33 = fir.embox %11#0 : (!fir.ref<i32>) -> !fir.box<i32, corank:3>
+ %34 = fir.shape %c3 : (index) -> !fir.shape<1>
+ %35 = fir.embox %16#0(%34) : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<3xi32>>
+ %36 = mif.image_index coarray %33 sub %35 team %21#0 : (!fir.box<i32, corank:3>, !fir.box<!fir.array<3xi32>>, !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>) -> i32
+ hlfir.assign %36 to %13#0 : i32, !fir.ref<i32>
+ %37 = fir.embox %11#0 : (!fir.ref<i32>) -> !fir.box<i32, corank:3>
+ %38 = fir.shape %c3 : (index) -> !fir.shape<1>
+ %39 = fir.embox %16#0(%38) : (!fir.ref<!fir.array<3xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<3xi32>>
+ %40 = fir.load %24#0 : !fir.ref<i32>
+ %41 = mif.image_index coarray %37 sub %39 team_number %40 : (!fir.box<i32, corank:3>, !fir.box<!fir.array<3xi32>>, i32) -> i32
+ hlfir.assign %41 to %13#0 : i32, !fir.ref<i32>
+ return
+ }
+}
+
+// CHECK: fir.call @_QMprifPprif_image_index(
+// CHECK: fir.call @_QMprifPprif_image_index(
+// CHECK: fir.call @_QMprifPprif_image_index_with_team(
+// CHECK: fir.call @_QMprifPprif_image_index_with_team_number(
diff --git a/flang/test/Fir/MIF/this_image.mlir b/flang/test/Fir/MIF/this_image.mlir
index 13aec81ec3755..d97e2466ce54a 100644
--- a/flang/test/Fir/MIF/this_image.mlir
+++ b/flang/test/Fir/MIF/this_image.mlir
@@ -1,14 +1,67 @@
// RUN: fir-opt --mif-convert %s | FileCheck %s
func.func @_QQmain() attributes {fir.bindc_name = "TEST"} {
- %0 = fir.dummy_scope : !fir.dscope
- %1 = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFEi"}
- %2:2 = hlfir.declare %1 {uniq_name = "_QFEi"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
- %3 = mif.this_image : () -> i32
- hlfir.assign %3 to %2#0 : i32, !fir.ref<i32>
+ %0 = fir.alloca !fir.array<1xi64>
+ %1 = fir.alloca !fir.array<2xi64>
+ %2 = fir.dummy_scope : !fir.dscope
+ %3 = fir.address_of(@_QFEa) : !fir.ref<i32>
+ %c1_i64 = arith.constant 1 : i64
+ %c0 = arith.constant 0 : index
+ %4 = fir.coordinate_of %1, %c0 : (!fir.ref<!fir.array<2xi64>>, index) -> !fir.ref<i64>
+ fir.store %c1_i64 to %4 : !fir.ref<i64>
+ %c1_i64_0 = arith.constant 1 : i64
+ %c1 = arith.constant 1 : index
+ %5 = fir.coordinate_of %1, %c1 : (!fir.ref<!fir.array<2xi64>>, index) -> !fir.ref<i64>
+ fir.store %c1_i64_0 to %5 : !fir.ref<i64>
+ %6 = fir.embox %1 : (!fir.ref<!fir.array<2xi64>>) -> !fir.box<!fir.array<2xi64>>
+ %c1_i64_1 = arith.constant 1 : i64
+ %c0_2 = arith.constant 0 : index
+ %7 = fir.coordinate_of %0, %c0_2 : (!fir.ref<!fir.array<1xi64>>, index) -> !fir.ref<i64>
+ fir.store %c1_i64_1 to %7 : !fir.ref<i64>
+ %8 = fir.embox %0 : (!fir.ref<!fir.array<1xi64>>) -> !fir.box<!fir.array<1xi64>>
+ mif.alloc_coarray %3 lcobounds %6 ucobounds %8 {uniq_name = "_QFEa"} : (!fir.ref<i32>, !fir.box<!fir.array<2xi64>>, !fir.box<!fir.array<1xi64>>) -> ()
+ %9:2 = hlfir.declare %3 {uniq_name = "_QFEa"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %10 = fir.alloca i32 {bindc_name = "i", uniq_name = "_QFEi"}
+ %11:2 = hlfir.declare %10 {uniq_name = "_QFEi"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %c2 = arith.constant 2 : index
+ %12 = fir.alloca !fir.array<2xi32> {bindc_name = "j", uniq_name = "_QFEj"}
+ %13 = fir.shape %c2 : (index) -> !fir.shape<1>
+ %14:2 = hlfir.declare %12(%13) {uniq_name = "_QFEj"} : (!fir.ref<!fir.array<2xi32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<2xi32>>, !fir.ref<!fir.array<2xi32>>)
+ %15 = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}> {bindc_name = "team", uniq_name = "_QFEteam"}
+ %16:2 = hlfir.declare %15 {uniq_name = "_QFEteam"} : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>) -> (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>, !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>)
+ %17 = fir.address_of(@_QQ_QM__fortran_builtinsT__builtin_team_type.DerivedInit) : !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>
+ fir.copy %17 to %16#0 no_overlap : !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>, !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>
+ %18 = mif.this_image : () -> i32
+ hlfir.assign %18 to %11#0 : i32, !fir.ref<i32>
+ %19 = fir.embox %16#0 : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>) -> !fir.box<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>
+ %20 = mif.this_image team %19 : (!fir.box<!fir.type<_QM__fortran_builtinsT__builtin_team_type{_QM__fortran_builtinsT__builtin_team_type.__id:i64}>>) -> i32
+ hlfir.assign %20 to %11#0 : i32, !fir.ref<i32>
+ %21 = fir.embox %9#0 : (!fir.ref<i32>) -> !fir.box<i32, corank:2>
+ %22 = mif.this_image coarray %21 : (!fir.box<i32, corank:2>) -> !fir.box<!fir.array<?xi64>>
+ %23:2 = hlfir.declare %22 {uniq_name = ".tmp.intrinsic_result"} : (!fir.box<!fir.array<?xi64>>) -> (!fir.box<!fir.array<?xi64>>, !fir.box<!fir.array<?xi64>>)
+ %false = arith.constant false
+ %24 = hlfir.as_expr %23#0 move %false : (!fir.box<!fir.array<?xi64>>, i1) -> !hlfir.expr<?xi64>
+ %c0_3 = arith.constant 0 : index
+ %25:3 = fir.box_dims %23#0, %c0_3 : (!fir.box<!fir.array<?xi64>>, index) -> (index, index, index)
+ %26 = fir.shape %25#1 : (index) -> !fir.shape<1>
+ %27 = hlfir.elemental %26 unordered : (!fir.shape<1>) -> !hlfir.expr<?xi32> {
+ ^bb0(%arg0: index):
+ %31 = hlfir.apply %24, %arg0 : (!hlfir.expr<?xi64>, index) -> i64
+ %32 = fir.convert %31 : (i64) -> i32
+ hlfir.yield_element %32 : i32
+ }
+ hlfir.assign %27 to %14#0 : !hlfir.expr<?xi32>, !fir.ref<!fir.array<2xi32>>
+ hlfir.destroy %27 : !hlfir.expr<?xi32>
+ hlfir.destroy %24 : !hlfir.expr<?xi64>
+ %c1_i32 = arith.constant 1 : i32
+ %28 = fir.embox %9#0 : (!fir.ref<i32>) -> !fir.box<i32, corank:2>
+ %29 = mif.this_image coarray %28 dim %c1_i32 : (!fir.box<i32, corank:2>, i32) -> i64
+ %30 = fir.convert %29 : (i64) -> i32
+ hlfir.assign %30 to %14#0 : i32, !fir.ref<!fir.array<2xi32>>
return
}
-
// CHECK-LABEL: func.func @_QQmain
-// CHECK: fir.call @_QMprifPprif_this_image_no_coarray(
+// CHECK: fir.call @_QMprifPprif_this_image_no_coarray
+// CHECK: fir.call @_QMprifPprif_this_image_with_coarray
+// CHECK: fir.call @_QMprifPprif_this_image_with_dim
diff --git a/flang/test/Lower/MIF/coarray_allocation.f90 b/flang/test/Lower/MIF/coarray_allocation.f90
index f33229a63165b..8b918e30ade75 100644
--- a/flang/test/Lower/MIF/coarray_allocation.f90
+++ b/flang/test/Lower/MIF/coarray_allocation.f90
@@ -14,19 +14,19 @@ program alloc_test
! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QFEa) : !fir.ref<i32>
! CHECK: mif.alloc_coarray %[[VAL_1]] lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] {uniq_name = "_QFEa"} : (!fir.ref<i32>, !fir.box<!fir.array<2xi64>>, !fir.box<!fir.array<1xi64>>) -> ()
- ! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[ADDR_1:.*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFEa2"} : (!fir.ref<!fir.box<!fir.heap<i32>>>) -> (!fir.ref<!fir.box<!fir.heap<i32>>>, !fir.ref<!fir.box<!fir.heap<i32>>>)
+ ! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[ADDR_1:.*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFEa2"} : (!fir.ref<!fir.box<!fir.heap<i32>, corank:2>>) -> (!fir.ref<!fir.box<!fir.heap<i32>, corank:2>>, !fir.ref<!fir.box<!fir.heap<i32>, corank:2>>)
integer :: a[2, *]
! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QFEb) : !fir.ref<f32>
! CHECK: mif.alloc_coarray %[[VAL_2]] lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] {uniq_name = "_QFEb"} : (!fir.ref<f32>, !fir.box<!fir.array<3xi64>>, !fir.box<!fir.array<2xi64>>) -> ()
- ! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[ADDR_2:.*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFEb2"} : (!fir.ref<!fir.box<!fir.heap<f32>>>) -> (!fir.ref<!fir.box<!fir.heap<f32>>>, !fir.ref<!fir.box<!fir.heap<f32>>>)
+ ! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[ADDR_2:.*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFEb2"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:3>>) -> (!fir.ref<!fir.box<!fir.heap<f32>, corank:3>>, !fir.ref<!fir.box<!fir.heap<f32>, corank:3>>)
real :: b[3:4, 5, *]
! CHECK: %[[VAL_3:.*]] = fir.address_of(@_QFEc) : !fir.ref<!fir.char<1,10>>
! CHECK: mif.alloc_coarray %[[VAL_3]] lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] {uniq_name = "_QFEc"} : (!fir.ref<!fir.char<1,10>>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>) -> ()
- ! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[ADDR_3:.*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFEc2"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>)
+ ! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[ADDR_3:.*]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFEc2"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>, corank:1>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>, corank:1>>)
character(len=10) :: c[*]
type(my_type) :: d
@@ -35,29 +35,29 @@ program alloc_test
integer, allocatable :: a2[:,:]
! CHECK: %[[VAL_7:.*]] = fir.absent !fir.box<none>
- ! CHECK: mif.alloc_coarray %[[VAL_4]]#0 lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] errmsg %[[VAL_7]] {uniq_name = "_QFEa2"} : (!fir.ref<!fir.box<!fir.heap<i32>>>, !fir.box<!fir.array<2xi64>>, !fir.box<!fir.array<1xi64>>, !fir.box<none>) -> ()
+ ! CHECK: mif.alloc_coarray %[[VAL_4]]#0 lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] errmsg %[[VAL_7]] {uniq_name = "_QFEa2"} : (!fir.ref<!fir.box<!fir.heap<i32>, corank:2>>, !fir.box<!fir.array<2xi64>>, !fir.box<!fir.array<1xi64>>, !fir.box<none>) -> ()
allocate(a2[2,*])
! CHECK: %[[VAL_8:.*]] = fir.absent !fir.box<none>
- ! CHECK: mif.alloc_coarray %[[VAL_5]]#0 lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] errmsg %[[VAL_8]] {uniq_name = "_QFEb2"} : (!fir.ref<!fir.box<!fir.heap<f32>>>, !fir.box<!fir.array<3xi64>>, !fir.box<!fir.array<2xi64>>, !fir.box<none>) -> ()
+ ! CHECK: mif.alloc_coarray %[[VAL_5]]#0 lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] errmsg %[[VAL_8]] {uniq_name = "_QFEb2"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:3>>, !fir.box<!fir.array<3xi64>>, !fir.box<!fir.array<2xi64>>, !fir.box<none>) -> ()
allocate(b2[3:4, 5, *])
! CHECK: %[[VAL_9:.*]] = fir.absent !fir.box<none>
- ! CHECK: mif.alloc_coarray %[[VAL_6]]#0 lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] errmsg %[[VAL_9]] {uniq_name = "_QFEc2"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>, !fir.box<none>) -> ()
+ ! CHECK: mif.alloc_coarray %[[VAL_6]]#0 lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] errmsg %[[VAL_9]] {uniq_name = "_QFEc2"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>, corank:1>>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>, !fir.box<none>) -> ()
allocate(character(100) :: c2(5)[*])
! CHECK: %[[VAL_10:.*]] = fir.absent !fir.box<none>
! CHECK: %[[VAL_12:.*]] = hlfir.designate %[[VAL_11:.*]]{"co"}
- ! CHECK: mif.alloc_coarray %[[VAL_12]] lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] errmsg %[[VAL_10]] {uniq_name = "_QFEd.z.co"} : (!fir.ref<!fir.box<!fir.heap<i32>>>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>, !fir.box<none>) -> ()
+ ! CHECK: mif.alloc_coarray %[[VAL_12]] lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] errmsg %[[VAL_10]] {uniq_name = "_QFEd.z.co"} : (!fir.ref<!fir.box<!fir.heap<i32>, corank:1>>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>, !fir.box<none>) -> ()
allocate(d%z%co[*])
- ! CHECK: mif.dealloc_coarray %[[VAL_4]]#0 stat %[[STAT:.*]] errmsg %[[ERRMSG:.*]] : (!fir.ref<!fir.box<!fir.heap<i32>>>, !fir.ref<i32>, !fir.box<none>) -> ()
- ! CHECK: mif.dealloc_coarray %[[VAL_5]]#0 stat %[[STAT:.*]] errmsg %[[ERRMSG:.*]] : (!fir.ref<!fir.box<!fir.heap<f32>>>, !fir.ref<i32>, !fir.box<none>) -> ()
- ! CHECK: mif.dealloc_coarray %[[VAL_6]]#0 stat %[[STAT:.*]] errmsg %[[ERRMSG:.*]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>, !fir.ref<i32>, !fir.box<none>) -> ()
+ ! CHECK: mif.dealloc_coarray %[[VAL_4]]#0 stat %[[STAT:.*]] errmsg %[[ERRMSG:.*]] : (!fir.ref<!fir.box<!fir.heap<i32>, corank:2>>, !fir.ref<i32>, !fir.box<none>) -> ()
+ ! CHECK: mif.dealloc_coarray %[[VAL_5]]#0 stat %[[STAT:.*]] errmsg %[[ERRMSG:.*]] : (!fir.ref<!fir.box<!fir.heap<f32>, corank:3>>, !fir.ref<i32>, !fir.box<none>) -> ()
+ ! CHECK: mif.dealloc_coarray %[[VAL_6]]#0 stat %[[STAT:.*]] errmsg %[[ERRMSG:.*]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>, corank:1>>, !fir.ref<i32>, !fir.box<none>) -> ()
deallocate(a2, b2, c2)
! CHECK: %[[VAL_14:.*]] = hlfir.designate %[[VAL_13:.*]]{"co"} {{.*}}
- ! CHECK: mif.dealloc_coarray %[[VAL_14]] stat %[[STAT:.*]] errmsg %[[ERRMSG:.*]] : (!fir.ref<!fir.box<!fir.heap<i32>>>, !fir.ref<i32>, !fir.box<none>) -> ()
+ ! CHECK: mif.dealloc_coarray %[[VAL_14]] stat %[[STAT:.*]] errmsg %[[ERRMSG:.*]] : (!fir.ref<!fir.box<!fir.heap<i32>, corank:1>>, !fir.ref<i32>, !fir.box<none>) -> ()
deallocate(d%z%co)
end program
@@ -68,9 +68,9 @@ subroutine test_alloc2
class(*),allocatable :: b[:]
integer :: ierr
- ! CHECK: mif.alloc_coarray %[[VAL_1:.*]]#0 lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] errmsg %[[ERRMSG:.*]] {uniq_name = "_QFtest_alloc2Ea"} : (!fir.ref<!fir.class<!fir.heap<none>>>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>, !fir.box<none>) -> ()
+ ! CHECK: mif.alloc_coarray %[[VAL_1:.*]]#0 lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] errmsg %[[ERRMSG:.*]] {uniq_name = "_QFtest_alloc2Ea"} : (!fir.ref<!fir.class<!fir.heap<none>, corank:1>>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>, !fir.box<none>) -> ()
allocate(real::a[1:*])
- ! CHECK: mif.alloc_coarray %[[VAL_2:.*]]#0 lcobounds %[[LCOBOUNDS2:.*]] ucobounds %[[UCOBOUNDS2:.*]] stat %[[STAT:.*]] errmsg %[[ERRMSG2:.*]] {uniq_name = "_QFtest_alloc2Eb"} : (!fir.ref<!fir.class<!fir.heap<none>>>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>, !fir.ref<i32>, !fir.box<none>) -> ()
+ ! CHECK: mif.alloc_coarray %[[VAL_2:.*]]#0 lcobounds %[[LCOBOUNDS2:.*]] ucobounds %[[UCOBOUNDS2:.*]] stat %[[STAT:.*]] errmsg %[[ERRMSG2:.*]] {uniq_name = "_QFtest_alloc2Eb"} : (!fir.ref<!fir.class<!fir.heap<none>, corank:1>>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>, !fir.ref<i32>, !fir.box<none>) -> ()
allocate(real::b[2:*], STAT=ierr)
end subroutine
diff --git a/flang/test/Lower/MIF/coarray_allocation2.f90 b/flang/test/Lower/MIF/coarray_allocation2.f90
index 89000203925d8..aad348108c002 100644
--- a/flang/test/Lower/MIF/coarray_allocation2.f90
+++ b/flang/test/Lower/MIF/coarray_allocation2.f90
@@ -12,18 +12,18 @@ end subroutine test_coarray_cleanup
!CHECK: %[[VAL_0:.*]] = fir.alloca !fir.array<0xi64>
!CHECK: %[[VAL_1:.*]] = fir.alloca !fir.array<1xi64>
!CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope
-!CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>> {bindc_name = "n", uniq_name = "_QFtest_coarray_cleanupEn"}
+!CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xf32>>, corank:1> {bindc_name = "n", uniq_name = "_QFtest_coarray_cleanupEn"}
!CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
!CHECK: %[[C0:.*]] = arith.constant 0 : index
!CHECK: %[[VAL_5:.*]] = fir.shape %[[C0]] : (index) -> !fir.shape<1>
-!CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_4]](%[[VAL_5]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xf32>>>
-!CHECK: fir.store %[[VAL_6]] to %[[VAL_3]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
-!CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_3]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest_coarray_cleanupEn"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>)
+!CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_4]](%[[VAL_5]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.heap<!fir.array<?xf32>>, corank:1>
+!CHECK: fir.store %[[VAL_6]] to %[[VAL_3]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>, corank:1>>
+!CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_3]] {fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest_coarray_cleanupEn"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>, corank:1>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>, corank:1>>)
!CHECK: %[[VAL_8:.*]] = fir.absent !fir.box<none>
!CHECK: %[[C1:.*]] = arith.constant 1 : index
!CHECK: %[[C10_i32:.*]] = arith.constant 10 : i32
!CHECK: %[[C0_i32:.*]] = arith.constant 0 : i32
-!CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> !fir.ref<!fir.box<none>>
+!CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>, corank:1>>) -> !fir.ref<!fir.box<none>>
!CHECK: %[[VAL_10:.*]] = fir.convert %[[C1]] : (index) -> i64
!CHECK: %[[VAL_11:.*]] = fir.convert %[[C10_i32]] : (i32) -> i64
!CHECK: fir.call @_FortranAAllocatableSetBounds(%[[VAL_9:.*]], %[[C0_i32]], %[[VAL_10]], %[[VAL_11]]) fastmath<contract> : (!fir.ref<!fir.box<none>>, i32, i64, i64) -> ()
@@ -33,17 +33,17 @@ end subroutine test_coarray_cleanup
!CHECK: fir.store %[[C1_i64]] to %[[VAL_12]] : !fir.ref<i64>
!CHECK: %[[VAL_13:.*]] = fir.embox %[[VAL_1]] : (!fir.ref<!fir.array<1xi64>>) -> !fir.box<!fir.array<1xi64>>
!CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.array<0xi64>>) -> !fir.box<!fir.array<0xi64>>
-!CHECK: mif.alloc_coarray %[[VAL_7]]#0 lcobounds %[[VAL_13]] ucobounds %[[VAL_14]] errmsg %[[VAL_8]] {uniq_name = "_QFtest_coarray_cleanupEn"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>, !fir.box<none>) -> ()
+!CHECK: mif.alloc_coarray %[[VAL_7]]#0 lcobounds %[[VAL_13]] ucobounds %[[VAL_14]] errmsg %[[VAL_8]] {uniq_name = "_QFtest_coarray_cleanupEn"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>, corank:1>>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>, !fir.box<none>) -> ()
!CHECK: mif.sync_all : () -> ()
-!CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
-!CHECK: %[[VAL_16:.*]] = fir.box_addr %[[VAL_15]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.heap<!fir.array<?xf32>>
+!CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>, corank:1>>
+!CHECK: %[[VAL_16:.*]] = fir.box_addr %[[VAL_15]] : (!fir.box<!fir.heap<!fir.array<?xf32>>, corank:1>) -> !fir.heap<!fir.array<?xf32>>
!CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_16]] : (!fir.heap<!fir.array<?xf32>>) -> i64
!CHECK: %[[C0_i64:.*]] = arith.constant 0 : i64
!CHECK: %[[VAL_18:.*]] = arith.cmpi ne, %[[VAL_17]], %[[C0_i64]] : i64
!CHECK: fir.if %[[VAL_18]] {
!CHECK: %[[VAL_19:.*]] = fir.absent !fir.box<none>
!CHECK: %[[VAL_20:.*]] = fir.absent !fir.ref<i32>
-!CHECK: mif.dealloc_coarray %[[VAL_7]]#0 stat %[[VAL_20]] errmsg %[[VAL_19]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>, !fir.ref<i32>, !fir.box<none>) -> ()
+!CHECK: mif.dealloc_coarray %[[VAL_7]]#0 stat %[[VAL_20]] errmsg %[[VAL_19]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>, corank:1>>, !fir.ref<i32>, !fir.box<none>) -> ()
!CHECK: }
!CHECK: return
diff --git a/flang/test/Lower/MIF/cobound.f90 b/flang/test/Lower/MIF/cobound.f90
new file mode 100644
index 0000000000000..7794320b87fb8
--- /dev/null
+++ b/flang/test/Lower/MIF/cobound.f90
@@ -0,0 +1,25 @@
+! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s
+
+program test
+ integer :: res1(3), res2
+ integer, allocatable :: a[:,:,:]
+
+ allocate(a[2,3:5,*])
+
+ ! CHECK: mif.lcobound coarray %[[COARRAY:.*]] dim %[[C1_I32:.*]] : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ ! CHECK: mif.lcobound coarray %[[COARRAY]] dim %[[C2_I32:.*]] : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ ! CHECK: mif.lcobound coarray %[[COARRAY]] dim %[[C3_I32:.*]] : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ res1 = lcobound(a)
+
+ ! CHECK: mif.lcobound coarray %[[COARRAY:.*]] dim %[[C2_I32:.*]] : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ res2 = lcobound(a, DIM=2)
+
+ ! CHECK: mif.ucobound coarray %[[COARRAY:.*]] dim %[[C1_I32:.*]] : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ ! CHECK: mif.ucobound coarray %[[COARRAY]] dim %[[C2_I32:.*]] : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ ! CHECK: mif.ucobound coarray %[[COARRAY]] dim %[[C3_I32:.*]] : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ res1 = ucobound(a)
+
+ ! CHECK: mif.ucobound coarray %[[COARRAY:.*]] dim %[[C2_I32:.*]] : (!fir.box<!fir.heap<i32>, corank:3>, i32) -> i32
+ res2 = ucobound(a, DIM=2)
+
+end program
diff --git a/flang/test/Lower/MIF/coshape.f90 b/flang/test/Lower/MIF/coshape.f90
new file mode 100644
index 0000000000000..2cf6d50f084a0
--- /dev/null
+++ b/flang/test/Lower/MIF/coshape.f90
@@ -0,0 +1,14 @@
+! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s
+
+program test
+ integer :: res(3)
+ integer(kind=8) :: res2(3)
+ integer :: a[2,3:5,*]
+
+ ! CHECK: mif.coshape coarray %[[COARRAY:.*]] : (!fir.box<i32, corank:3>) -> !fir.box<!fir.array<?xi64>>
+ res = coshape(a)
+
+ ! CHECK: mif.coshape coarray %[[COARRAY:.*]] : (!fir.box<i32, corank:3>) -> !fir.box<!fir.array<?xi64>>
+ res2 = coshape(a)
+
+end program
diff --git a/flang/test/Lower/MIF/image_index.f90 b/flang/test/Lower/MIF/image_index.f90
new file mode 100644
index 0000000000000..a3dff822a0636
--- /dev/null
+++ b/flang/test/Lower/MIF/image_index.f90
@@ -0,0 +1,24 @@
+! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s
+
+program test
+ use iso_fortran_env, only: team_type
+ integer(kind=4) :: sub(3) = (/1, 4, 2/)
+ integer(kind=8) :: sub2(3) = (/1, 4, 2/)
+ integer(kind=4) :: a[2,3:5,*], idx
+ type(team_type) :: team
+ integer :: team_number
+
+ ! CHECK: mif.image_index coarray %[[COARRAY:.*]] sub %[[SUB:.*]] : (!fir.box<i32, corank:3>, !fir.box<!fir.array<3xi32>>) -> i32
+ idx = image_index(a, SUB=sub)
+
+ ! CHECK: mif.image_index coarray %[[COARRAY:.*]] sub %[[SUB2:.*]] : (!fir.box<i32, corank:3>, !fir.box<!fir.array<3xi64>>) -> i32
+ idx = image_index(a, SUB=sub2)
+
+ ! CHECK: mif.image_index coarray %[[COARRAY:.*]] sub %[[SUB:.*]] team %[[TEAM:.*]]#0 : (!fir.box<i32, corank:3>,
+ ! !fir.box<!fir.array<3xi32>>, !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_team_type{{.*}}>>) -> i32
+ idx = image_index(a, SUB=sub, TEAM=team)
+
+ ! CHECK: mif.image_index coarray %[[COARRAY:.*]] sub %[[SUB:.*]] team_number %[[TEAM_NUMBER:.*]]: (!fir.box<i32, corank:3>, !fir.box<!fir.array<3xi32>>, i32) -> i32
+ idx = image_index(a, SUB=sub, TEAM_NUMBER=team_number)
+
+end program
diff --git a/flang/test/Lower/MIF/this_image.f90 b/flang/test/Lower/MIF/this_image.f90
index c6674c309f3f4..95d9ab1dedd39 100644
--- a/flang/test/Lower/MIF/this_image.f90
+++ b/flang/test/Lower/MIF/this_image.f90
@@ -1,9 +1,10 @@
! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s
program test
- use iso_fortran_env
- integer :: i
+ use iso_fortran_env, only: team_type
+ integer :: i, j(2)
type(team_type) :: team
+ integer :: a[2,*]
! CHECK: mif.this_image : () -> i32
i = this_image()
@@ -11,4 +12,9 @@ program test
! CHECK: mif.this_image team %[[TEAM:.*]] : ({{.*}}) -> i32
i = this_image(TEAM=team)
+ ! CHECK: mif.this_image coarray %[[A:.*]] : (!fir.box<i32, corank:2>) -> !fir.box<!fir.array<?xi64>>
+ j = this_image(COARRAY=a)
+
+ ! CHECK: mif.this_image coarray %[[A:.*]] dim %[[DIM:.*]] : (!fir.box<i32, corank:2>, i32) -> i64
+ j = this_image(COARRAY=a, DIM=1)
end program
More information about the flang-commits
mailing list