[flang-commits] [flang] [flang][MIF] Starting adding coarray access support (PR #212777)
Jean-Didier PAILLEUX via flang-commits
flang-commits at lists.llvm.org
Wed Jul 29 06:57:33 PDT 2026
https://github.com/JDPailleux created https://github.com/llvm/llvm-project/pull/212777
This PR introduces support for coarrays access with MIF and PRIF.
- 2 new operations have been added: `mif::GetCoarrayOp` and `mif::PutCoarrayOp`
- Intrinsic types are supported for these operations.
- Strides and notify are not supported
- It is now assumed that all allocations for coarrays are made on the heap. (This was not the case before).
>From 8057c1a4fdfecbf04cff96fcdc8034fc9ec9e3f4 Mon Sep 17 00:00:00 2001
From: Jean-Didier Pailleux <jean-didier.pailleux at sipearl.com>
Date: Thu, 16 Jul 2026 11:49:38 +0200
Subject: [PATCH 1/3] [flang] Lower CoarrayRef to hlfir.designate
---
flang/lib/Lower/ConvertExprToHLFIR.cpp | 112 ++++++++++++++++++++++++-
1 file changed, 109 insertions(+), 3 deletions(-)
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index b30a2dfcba90e..009725fff9c33 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -402,11 +402,117 @@ class HlfirDesignatorBuilder {
fir::FortranVariableOpInterface
gen(const Fortran::evaluate::CoarrayRef &coarrayRef) {
- TODO(getLoc(), "coarray: lowering a reference to a coarray object");
+ PartInfo partInfo;
+ mlir::Type resultType = visit(coarrayRef, partInfo);
+ return genDesignate(resultType, partInfo, coarrayRef);
}
- mlir::Type visit(const Fortran::evaluate::CoarrayRef &, PartInfo &) {
- TODO(getLoc(), "coarray: lowering a reference to a coarray object");
+ mlir::Type visit(const Fortran::evaluate::CoarrayRef &coarrayRef,
+ PartInfo &partInfo) {
+ // Coarray is a data entity with corank > 0 that must be scalar
+ // or array.
+ mlir::Type baseType = visit(coarrayRef.base().GetLastSymbol(), partInfo);
+ if (auto seqType = mlir::dyn_cast<fir::SequenceType>(baseType)) {
+ fir::FirOpBuilder &builder = getBuilder();
+ mlir::Location loc = getLoc();
+ mlir::Type idxTy = builder.getIndexType();
+ llvm::SmallVector<std::pair<mlir::Value, mlir::Value>> bounds;
+ auto getBaseBounds = [&](unsigned i) {
+ if (bounds.empty()) {
+ bounds = hlfir::genBounds(loc, builder, partInfo.base.value());
+ assert(!bounds.empty() &&
+ "failed to compute implicit array section bounds");
+ }
+ return bounds[i];
+ };
+
+ auto frontEndResultShape = Fortran::evaluate::GetShape(
+ converter.getFoldingContext(), coarrayRef);
+ auto tryGettingExtentFromFrontEnd = [&](unsigned dim)
+ -> std::pair<mlir::Value, fir::SequenceType::Extent> {
+ // Use constant extent if possible. The main advantage to do this now
+ // is to get the best FIR array types as possible while lowering.
+ if (frontEndResultShape)
+ if (auto maybeI64 =
+ Fortran::evaluate::ToInt64(frontEndResultShape->at(dim)))
+ return {builder.createIntegerConstant(loc, idxTy, *maybeI64),
+ *maybeI64};
+ return {mlir::Value{}, fir::SequenceType::getUnknownExtent()};
+ };
+
+ llvm::SmallVector<mlir::Value> resultExtents;
+ fir::SequenceType::Shape resultTypeShape;
+ bool sawVectorSubscripts = false;
+ if (auto *arrayRef{
+ std::get_if<Fortran::evaluate::ArrayRef>(&coarrayRef.base().u)}) {
+ for (auto subscript : llvm::enumerate(arrayRef->subscript())) {
+ if (const auto *triplet = std::get_if<Fortran::evaluate::Triplet>(
+ &subscript.value().u)) {
+ mlir::Value lb, ub;
+ if (const auto &lbExpr = triplet->lower())
+ lb = genSubscript(*lbExpr);
+ else
+ lb = getBaseBounds(subscript.index()).first;
+ if (const auto &ubExpr = triplet->upper())
+ ub = genSubscript(*ubExpr);
+ else
+ ub = getBaseBounds(subscript.index()).second;
+ lb = builder.createConvert(loc, idxTy, lb);
+ ub = builder.createConvert(loc, idxTy, ub);
+ mlir::Value stride = genSubscript(triplet->stride());
+ stride = builder.createConvert(loc, idxTy, stride);
+ auto [extentValue, shapeExtent] =
+ tryGettingExtentFromFrontEnd(resultExtents.size());
+ resultTypeShape.push_back(shapeExtent);
+ if (!extentValue)
+ extentValue =
+ builder.genExtentFromTriplet(loc, lb, ub, stride, idxTy);
+ resultExtents.push_back(extentValue);
+ partInfo.subscripts.emplace_back(
+ hlfir::DesignateOp::Triplet{lb, ub, stride});
+ } else {
+ const auto &expr =
+ std::get<Fortran::evaluate::IndirectSubscriptIntegerExpr>(
+ subscript.value().u)
+ .value();
+ hlfir::Entity subscript = genSubscript(expr);
+ partInfo.subscripts.push_back(subscript);
+ if (expr.Rank() > 0) {
+ sawVectorSubscripts = true;
+ auto [extentValue, shapeExtent] =
+ tryGettingExtentFromFrontEnd(resultExtents.size());
+ resultTypeShape.push_back(shapeExtent);
+ if (!extentValue)
+ extentValue =
+ hlfir::genExtent(loc, builder, subscript, /*dim=*/0);
+ resultExtents.push_back(extentValue);
+ }
+ }
+ }
+ }
+ assert(resultExtents.size() == resultTypeShape.size() &&
+ "inconsistent hlfir.designate shape");
+
+ // For vector subscripts, create an hlfir.elemental_addr and continue
+ // lowering the designator inside it as if it was addressing an element of
+ // the vector subscripts.
+ if (sawVectorSubscripts)
+ return createVectorSubscriptElementAddrOp(partInfo, baseType,
+ resultExtents);
+
+ mlir::Type resultType = seqType.getEleTy();
+ if (!resultTypeShape.empty()) {
+ // Ranked array section. The result shape comes from the array section
+ // subscripts.
+ resultType = fir::SequenceType::get(resultTypeShape, resultType);
+ assert(!partInfo.resultShape &&
+ "Fortran designator can only have one ranked part");
+ partInfo.resultShape = builder.genShape(loc, resultExtents);
+ }
+ return resultType;
+ } else {
+ return baseType;
+ }
}
fir::FortranVariableOpInterface
>From 31cb5557cecf9556eb3309c74521f13f8700cecc Mon Sep 17 00:00:00 2001
From: Jean-Didier Pailleux <jean-didier.pailleux at sipearl.com>
Date: Tue, 28 Jul 2026 09:03:11 +0200
Subject: [PATCH 2/3] [flang][MIF] Update allocation for coarrays
---
flang/lib/Lower/ConvertType.cpp | 3 +-
flang/lib/Lower/ConvertVariable.cpp | 52 ++++++++++++++++++++
flang/test/Lower/MIF/coarray_allocation.f90 | 12 ++---
flang/test/Lower/MIF/coarray_allocation4.f90 | 30 +++++------
flang/test/Lower/MIF/coarray_allocation5.f90 | 4 +-
flang/test/Lower/MIF/coshape.f90 | 6 +--
flang/test/Lower/MIF/image_index.f90 | 8 +--
flang/test/Lower/MIF/this_image.f90 | 4 +-
8 files changed, 86 insertions(+), 33 deletions(-)
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 0fdbdfcc74424..fdde2683e980d 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -297,7 +297,8 @@ struct TypeBuilderImpl {
if (Fortran::semantics::IsPointer(symbol))
return fir::wrapInClassOrBoxType(fir::PointerType::get(ty), isPolymorphic,
isAssumedType, symbol.Corank());
- if (Fortran::semantics::IsAllocatable(symbol))
+ if (Fortran::semantics::IsAllocatable(symbol) ||
+ Fortran::evaluate::IsCoarray(symbol))
return fir::wrapInClassOrBoxType(fir::HeapType::get(ty), isPolymorphic,
isAssumedType, symbol.Corank());
// isPtr and isAlloc are variable that were promoted to be on the
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 007b536d97098..fe85d08469da9 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -332,6 +332,33 @@ mlir::Value Fortran::lower::genInitialDataTarget(
/*slice=*/mlir::Value{});
}
+static mlir::Value
+genCoarrayDefaultInitializerValue(Fortran::lower::AbstractConverter &converter,
+ mlir::Location loc, mlir::Type boxType,
+ unsigned allocator) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ auto baseBoxType = mlir::cast<fir::BaseBoxType>(boxType);
+ auto baseAddrType = baseBoxType.getBaseAddressType();
+ auto type = fir::unwrapRefType(baseAddrType);
+ auto eleTy = fir::unwrapSequenceType(type);
+ auto nullAddr = builder.createNullConstant(loc, baseAddrType);
+ mlir::Value shape, slice;
+ if (auto seqTy = mlir::dyn_cast<fir::SequenceType>(type)) {
+ llvm::SmallVector<mlir::Value> extents;
+ for (int64_t extent : seqTy.getShape())
+ extents.push_back(
+ builder.createIntegerConstant(loc, builder.getIndexType(), extent));
+ shape = builder.createShape(
+ loc, fir::ArrayBoxValue{nullAddr, extents, /*lbounds=*/{}});
+ }
+ auto embox =
+ fir::EmboxOp::create(builder, loc, baseBoxType, nullAddr, shape, slice,
+ /*lenParams=*/{}, /*typeSourceBox=*/{});
+ if (allocator != 0)
+ embox.setAllocatorIdx(allocator);
+ return embox;
+}
+
/// Generate default initial value for a derived type object \p sym with mlir
/// type \p symTy.
static mlir::Value genDefaultInitializerValue(
@@ -555,6 +582,22 @@ fir::GlobalOp Fortran::lower::defineGlobal(
fir::HasValueOp::create(b, loc, box);
});
}
+ } else if (Fortran::evaluate::IsCoarray(sym)) {
+ if (oeDetails && oeDetails->init()) {
+ auto expr = *oeDetails->init();
+ createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &b) {
+ mlir::Value box =
+ Fortran::lower::genInitialDataTarget(converter, loc, symTy, expr);
+ fir::HasValueOp::create(b, loc, box);
+ });
+ } else {
+ createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &b) {
+ unsigned allocatorIdx = Fortran::lower::getAllocatorIdx(sym);
+ mlir::Value box = genCoarrayDefaultInitializerValue(
+ converter, loc, symTy, allocatorIdx);
+ fir::HasValueOp::create(b, loc, box);
+ });
+ }
} else if (oeDetails) {
if (oeDetails->init()) {
createGlobalInitialization(
@@ -2101,6 +2144,15 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
argNo = converter.getDummyArgPosition(sym);
}
auto [storage, storageOffset] = converter.getSymbolStorage(sym);
+
+ if (Fortran::evaluate::IsCoarray(sym) &&
+ !Fortran::semantics::IsAllocatableOrPointer(sym)) {
+ auto newBase = hlfir::DeclareOp::create(
+ builder, loc, base, name, /*shape=*/nullptr, lenParams, dummyScope,
+ storage, storageOffset, attributes, dataAttr, argNo);
+ symMap.addVariableDefinition(sym, newBase, force);
+ return;
+ }
auto newBase = hlfir::DeclareOp::create(
builder, loc, base, name, shapeOrShift, lenParams, dummyScope, storage,
storageOffset, attributes, dataAttr, argNo);
diff --git a/flang/test/Lower/MIF/coarray_allocation.f90 b/flang/test/Lower/MIF/coarray_allocation.f90
index 8b918e30ade75..789c3e2fd1a6d 100644
--- a/flang/test/Lower/MIF/coarray_allocation.f90
+++ b/flang/test/Lower/MIF/coarray_allocation.f90
@@ -11,20 +11,20 @@ program alloc_test
type(my_type2) :: z
end type
- ! 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_1:.*]] = fir.address_of(@_QFEa) : !fir.ref<!fir.box<!fir.heap<i32>, corank:2>>
+ ! CHECK: mif.alloc_coarray %[[VAL_1]] lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] {uniq_name = "_QFEa"} : (!fir.ref<!fir.box<!fir.heap<i32>, corank:2>>, !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>, 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_2:.*]] = fir.address_of(@_QFEb) : !fir.ref<!fir.box<!fir.heap<f32>, corank:3>>
+ ! CHECK: mif.alloc_coarray %[[VAL_2]] lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] {uniq_name = "_QFEb"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:3>>, !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>, 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_3:.*]] = fir.address_of(@_QFEc) : !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>, corank:1>>
+ ! CHECK: mif.alloc_coarray %[[VAL_3]] lcobounds %[[LCOBOUNDS:.*]] ucobounds %[[UCOBOUNDS:.*]] {uniq_name = "_QFEc"} : (!fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>, corank:1>>, !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,?>>>, 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[*]
diff --git a/flang/test/Lower/MIF/coarray_allocation4.f90 b/flang/test/Lower/MIF/coarray_allocation4.f90
index 450fad07f9933..643a7da80519a 100644
--- a/flang/test/Lower/MIF/coarray_allocation4.f90
+++ b/flang/test/Lower/MIF/coarray_allocation4.f90
@@ -16,12 +16,12 @@ program main
! CHECK-LABEL: func.func @_QPtest_coarray_save()
! CHECK: %0 = fir.dummy_scope : !fir.dscope
-! CHECK: %1 = fir.address_of(@_QFtest_coarray_saveEm) : !fir.ref<f32>
-! CHECK: %2:2 = hlfir.declare %1 {uniq_name = "_QFtest_coarray_saveEm"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
-! CHECK: %3 = fir.address_of(@_QFtest_coarray_saveEn) : !fir.ref<f32>
-! CHECK: %4:2 = hlfir.declare %3 {uniq_name = "_QFtest_coarray_saveEn"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
-! CHECK: %5 = fir.address_of(@_QFtest_coarray_saveEp) : !fir.ref<f32>
-! CHECK: %6:2 = hlfir.declare %5 {uniq_name = "_QFtest_coarray_saveEp"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+! CHECK: %1 = fir.address_of(@_QFtest_coarray_saveEm) : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+! CHECK: %2:2 = hlfir.declare %1 {uniq_name = "_QFtest_coarray_saveEm"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>, !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>)
+! CHECK: %3 = fir.address_of(@_QFtest_coarray_saveEn) : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+! CHECK: %4:2 = hlfir.declare %3 {uniq_name = "_QFtest_coarray_saveEn"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>, !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>)
+! CHECK: %5 = fir.address_of(@_QFtest_coarray_saveEp) : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+! CHECK: %6:2 = hlfir.declare %5 {uniq_name = "_QFtest_coarray_saveEp"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>, !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>)
! CHECK: return
! CHECK-LABEL: func.func @_QQmain() attributes {fir.bindc_name = "MAIN"}
@@ -29,7 +29,7 @@ program main
! CHECK: fir.call @_QPtest_coarray_save() fastmath<contract> : () -> ()
! CHECK: return
-! CHECK: fir.global internal @_QFtest_coarray_saveEm : f32
+! CHECK: fir.global internal @_QFtest_coarray_saveEm : !fir.box<!fir.heap<f32>, corank:1>
! CHECK-LABEL: func.func @__mif_save_coarrays_allocate()
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.array<0xi64>
@@ -39,7 +39,7 @@ program main
! CHECK: %[[VAL_4:.*]] = fir.alloca !fir.array<0xi64>
! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.array<1xi64>
! CHECK: %[[INIT_STAT:.*]] = mif.init -> i32
-! CHECK: %[[VAL_6:.*]] = fir.address_of(@_QFtest_coarray_saveEm) : !fir.ref<f32>
+! CHECK: %[[VAL_6:.*]] = fir.address_of(@_QFtest_coarray_saveEm) : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
! CHECK: %[[C1_I64:.*]] = arith.constant 1 : i64
! CHECK: %[[C1_I64_0:.*]] = arith.constant 1 : i64
! CHECK: %[[C0:.*]] = arith.constant 0 : index
@@ -48,8 +48,8 @@ program main
! CHECK: %[[VAL_8:.*]] = fir.embox %[[VAL_5]] : (!fir.ref<!fir.array<1xi64>>) -> !fir.box<!fir.array<1xi64>>
! CHECK: %[[C1_I64_1:.*]] = arith.constant 1 : i64
! CHECK: %[[VAL_9:.*]] = fir.embox %[[VAL_4]] : (!fir.ref<!fir.array<0xi64>>) -> !fir.box<!fir.array<0xi64>>
-! CHECK: mif.alloc_coarray %[[VAL_6]] lcobounds %[[VAL_8]] ucobounds %[[VAL_9]] {uniq_name = "_QFtest_coarray_saveEm"} : (!fir.ref<f32>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>) -> ()
-! CHECK: %[[VAL_10:.*]] = fir.address_of(@_QFtest_coarray_saveEn) : !fir.ref<f32>
+! CHECK: mif.alloc_coarray %[[VAL_6]] lcobounds %[[VAL_8]] ucobounds %[[VAL_9]] {uniq_name = "_QFtest_coarray_saveEm"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>) -> ()
+! CHECK: %[[VAL_10:.*]] = fir.address_of(@_QFtest_coarray_saveEn) : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
! CHECK: %[[C1_I64_2:.*]] = arith.constant 1 : i64
! CHECK: %[[C1_I64_3:.*]] = arith.constant 1 : i64
! CHECK: %[[C0_4:.*]] = arith.constant 0 : index
@@ -58,8 +58,8 @@ program main
! CHECK: %[[VAL_12:.*]] = fir.embox %[[VAL_3]] : (!fir.ref<!fir.array<1xi64>>) -> !fir.box<!fir.array<1xi64>>
! CHECK: %[[C1_I64_5:.*]] = arith.constant 1 : i64
! CHECK: %[[VAL_13:.*]] = fir.embox %[[VAL_2]] : (!fir.ref<!fir.array<0xi64>>) -> !fir.box<!fir.array<0xi64>>
-! CHECK: mif.alloc_coarray %[[VAL_10]] lcobounds %[[VAL_12]] ucobounds %[[VAL_13]] {uniq_name = "_QFtest_coarray_saveEn"} : (!fir.ref<f32>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>) -> ()
-! CHECK: %[[VAL_14:.*]] = fir.address_of(@_QFtest_coarray_saveEp) : !fir.ref<f32>
+! CHECK: mif.alloc_coarray %[[VAL_10]] lcobounds %[[VAL_12]] ucobounds %[[VAL_13]] {uniq_name = "_QFtest_coarray_saveEn"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>) -> ()
+! CHECK: %[[VAL_14:.*]] = fir.address_of(@_QFtest_coarray_saveEp) : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
! CHECK: %[[C1_I64_6:.*]] = arith.constant 1 : i64
! CHECK: %[[C1_I64_7:.*]] = arith.constant 1 : i64
! CHECK: %[[C0_8:.*]] = arith.constant 0 : index
@@ -68,9 +68,9 @@ program main
! CHECK: %[[VAL_16:.*]] = fir.embox %[[VAL_1]] : (!fir.ref<!fir.array<1xi64>>) -> !fir.box<!fir.array<1xi64>>
! CHECK: %[[VAL_C1_I64_9:.*]] = arith.constant 1 : i64
! CHECK: %[[VAL_17:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.array<0xi64>>) -> !fir.box<!fir.array<0xi64>>
-! CHECK: mif.alloc_coarray %[[VAL_14:.*]] lcobounds %[[VAL_16]] ucobounds %[[VAL_17]] {uniq_name = "_QFtest_coarray_saveEp"} : (!fir.ref<f32>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>) -> ()
+! CHECK: mif.alloc_coarray %[[VAL_14:.*]] lcobounds %[[VAL_16]] ucobounds %[[VAL_17]] {uniq_name = "_QFtest_coarray_saveEp"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>) -> ()
! CHECK: return
-! CHECK: fir.global internal @_QFtest_coarray_saveEn : f32
-! CHECK: fir.global internal @_QFtest_coarray_saveEp : f32
+! CHECK: fir.global internal @_QFtest_coarray_saveEn : !fir.box<!fir.heap<f32>, corank:1>
+! CHECK: fir.global internal @_QFtest_coarray_saveEp : !fir.box<!fir.heap<f32>, corank:1>
diff --git a/flang/test/Lower/MIF/coarray_allocation5.f90 b/flang/test/Lower/MIF/coarray_allocation5.f90
index c1a7958b67454..bf83cc1409dec 100644
--- a/flang/test/Lower/MIF/coarray_allocation5.f90
+++ b/flang/test/Lower/MIF/coarray_allocation5.f90
@@ -16,7 +16,7 @@ program test
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.array<0xi64>
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.array<1xi64>
! CHECK: %[[INIT_STAT:.*]] = mif.init -> i32
-! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QMm_coarray_testEmodule_coarray) : !fir.ref<f32>
+! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QMm_coarray_testEmodule_coarray) : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
! CHECK: %c1_i64 = arith.constant 1 : i64
! CHECK: %c1_i64_0 = arith.constant 1 : i64
! CHECK: %c0 = arith.constant 0 : index
@@ -25,5 +25,5 @@ program test
! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_1]] : (!fir.ref<!fir.array<1xi64>>) -> !fir.box<!fir.array<1xi64>>
! CHECK: %c1_i64_1 = arith.constant 1 : i64
! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.array<0xi64>>) -> !fir.box<!fir.array<0xi64>>
-! CHECK: mif.alloc_coarray %[[VAL_2]] lcobounds %[[VAL_4]] ucobounds %[[VAL_5]] {uniq_name = "_QMm_coarray_testEmodule_coarray"} : (!fir.ref<f32>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>) -> ()
+! CHECK: mif.alloc_coarray %[[VAL_2]] lcobounds %[[VAL_4]] ucobounds %[[VAL_5]] {uniq_name = "_QMm_coarray_testEmodule_coarray"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>, !fir.box<!fir.array<1xi64>>, !fir.box<!fir.array<0xi64>>) -> ()
! CHECK: return
diff --git a/flang/test/Lower/MIF/coshape.f90 b/flang/test/Lower/MIF/coshape.f90
index c7ba488bf70dd..65e3489f076ec 100644
--- a/flang/test/Lower/MIF/coshape.f90
+++ b/flang/test/Lower/MIF/coshape.f90
@@ -7,15 +7,15 @@ program test
integer :: a[2,3:5,*]
! COSHAPE without KIND returns default integer kind (4 = i32).
- ! CHECK: mif.coshape coarray %[[COARRAY:.*]] : (!fir.box<i32, corank:3>) -> !fir.box<!fir.array<?xi32>>
+ ! CHECK: mif.coshape coarray %[[COARRAY:.*]] : (!fir.box<!fir.heap<i32>, corank:3>) -> !fir.box<!fir.array<?xi32>>
res = coshape(a)
! Assignment to integer(kind=8) widens; COSHAPE result type is still i32.
- ! CHECK: mif.coshape coarray %[[COARRAY:.*]] : (!fir.box<i32, corank:3>) -> !fir.box<!fir.array<?xi32>>
+ ! CHECK: mif.coshape coarray %[[COARRAY:.*]] : (!fir.box<!fir.heap<i32>, corank:3>) -> !fir.box<!fir.array<?xi32>>
res2 = coshape(a)
! Explicit KIND=8 yields i64 elements.
- ! CHECK: mif.coshape coarray %[[COARRAY:.*]] : (!fir.box<i32, corank:3>) -> !fir.box<!fir.array<?xi64>>
+ ! CHECK: mif.coshape coarray %[[COARRAY:.*]] : (!fir.box<!fir.heap<i32>, corank:3>) -> !fir.box<!fir.array<?xi64>>
res3 = coshape(a, kind=8)
end program
diff --git a/flang/test/Lower/MIF/image_index.f90 b/flang/test/Lower/MIF/image_index.f90
index 4da1452fcfa1c..923e2b4a291b7 100644
--- a/flang/test/Lower/MIF/image_index.f90
+++ b/flang/test/Lower/MIF/image_index.f90
@@ -8,17 +8,17 @@ program test
type(team_type) :: team
integer :: team_number
- ! CHECK: mif.image_index coarray %[[COARRAY:.*]] sub %[[SUB:.*]] : (!fir.box<i32, corank:3>, !fir.box<!fir.array<3xi64>>) -> i32
+ ! CHECK: mif.image_index coarray %[[COARRAY:.*]] sub %[[SUB:.*]] : (!fir.box<!fir.heap<i32>, corank:3>, !fir.box<!fir.array<3xi64>>) -> 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
+ ! CHECK: mif.image_index coarray %[[COARRAY:.*]] sub %[[SUB2:.*]] : (!fir.box<!fir.heap<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>,
+ ! CHECK: mif.image_index coarray %[[COARRAY:.*]] sub %[[SUB:.*]] team %[[TEAM:.*]]#0 : (!fir.box<!fir.heap<i32>, corank:3>,
! !fir.box<!fir.array<3xi64>>, !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<3xi64>>, i32) -> i32
+ ! CHECK: mif.image_index coarray %[[COARRAY:.*]] sub %[[SUB:.*]] team_number %[[TEAM_NUMBER:.*]]: (!fir.box<!fir.heap<i32>, corank:3>, !fir.box<!fir.array<3xi64>>, 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 b026300876b7b..aae13c11a819b 100644
--- a/flang/test/Lower/MIF/this_image.f90
+++ b/flang/test/Lower/MIF/this_image.f90
@@ -12,9 +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<?xi32>>
+ ! CHECK: mif.this_image coarray %[[A:.*]] : (!fir.box<!fir.heap<i32>, corank:2>) -> !fir.box<!fir.array<?xi32>>
j = this_image(COARRAY=a)
- ! CHECK: mif.this_image coarray %[[A:.*]] dim %[[DIM:.*]] : (!fir.box<i32, corank:2>, i32) -> i64
+ ! CHECK: mif.this_image coarray %[[A:.*]] dim %[[DIM:.*]] : (!fir.box<!fir.heap<i32>, corank:2>, i32) -> i64
j = this_image(COARRAY=a, DIM=1)
end program
>From 8f51819204aedf6a1c6ab74c4eb36054ce7cb2cb Mon Sep 17 00:00:00 2001
From: Jean-Didier Pailleux <jean-didier.pailleux at sipearl.com>
Date: Tue, 28 Jul 2026 10:51:03 +0200
Subject: [PATCH 3/3] [flang][MIF] Starting adding coarray access support
(PUT/GET)
---
flang/include/flang/Lower/ConvertCall.h | 6 +
flang/include/flang/Lower/MultiImageFortran.h | 4 +
.../flang/Optimizer/Dialect/MIF/MIFOps.td | 37 ++
flang/lib/Lower/Bridge.cpp | 133 ++++++
flang/lib/Lower/ConvertCall.cpp | 33 +-
flang/lib/Lower/MultiImageFortran.cpp | 32 ++
flang/lib/Optimizer/Builder/MIFCommon.cpp | 4 +
.../Optimizer/Transforms/MIFOpConversion.cpp | 379 +++++++++++++++++-
flang/test/Fir/MIF/coarray_get.mlir | 55 +++
flang/test/Fir/MIF/coarray_get2.mlir | 53 +++
flang/test/Fir/MIF/coarray_put.mlir | 186 +++++++++
flang/test/Fir/MIF/coarray_put2.mlir | 53 +++
flang/test/Lower/MIF/coarray_get.f90 | 82 ++++
flang/test/Lower/MIF/coarray_put.f90 | 65 +++
14 files changed, 1087 insertions(+), 35 deletions(-)
create mode 100644 flang/test/Fir/MIF/coarray_get.mlir
create mode 100644 flang/test/Fir/MIF/coarray_get2.mlir
create mode 100644 flang/test/Fir/MIF/coarray_put.mlir
create mode 100644 flang/test/Fir/MIF/coarray_put2.mlir
create mode 100644 flang/test/Lower/MIF/coarray_get.f90
create mode 100644 flang/test/Lower/MIF/coarray_put.f90
diff --git a/flang/include/flang/Lower/ConvertCall.h b/flang/include/flang/Lower/ConvertCall.h
index 6de0b3cbd11f5..19d6664fe46bc 100644
--- a/flang/include/flang/Lower/ConvertCall.h
+++ b/flang/include/flang/Lower/ConvertCall.h
@@ -65,5 +65,11 @@ void convertUserDefinedAssignmentToHLFIR(
mlir::Location loc, Fortran::lower::AbstractConverter &converter,
const evaluate::ProcedureRef &procRef, hlfir::Entity lhs, hlfir::Entity rhs,
Fortran::lower::SymMap &symMap);
+
+// Helper to transform a fir::ExtendedValue to an hlfir::EntityWithAttributes.
+hlfir::EntityWithAttributes
+extendedValueToHlfirEntity(mlir::Location loc, fir::FirOpBuilder &builder,
+ const fir::ExtendedValue &exv, llvm::StringRef name,
+ mlir::Operation *insertBefore = nullptr);
} // namespace Fortran::lower
#endif // FORTRAN_LOWER_CONVERTCALL_H
diff --git a/flang/include/flang/Lower/MultiImageFortran.h b/flang/include/flang/Lower/MultiImageFortran.h
index c9b9e9f17cf39..1f247ee46c3a9 100644
--- a/flang/include/flang/Lower/MultiImageFortran.h
+++ b/flang/include/flang/Lower/MultiImageFortran.h
@@ -63,6 +63,10 @@ void genFormTeamStatement(AbstractConverter &, pft::Evaluation &eval,
// COARRAY utils
//===----------------------------------------------------------------------===//
+mlir::SmallVector<mlir::Value>
+getCosubscripts(AbstractConverter &converter, mlir::Location loc,
+ const evaluate::CoarrayRef &expr);
+
mlir::Value genLowerCoBounds(AbstractConverter &converter, mlir::Location loc,
const semantics::Symbol &sym);
diff --git a/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td b/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td
index 337a9eab0b087..49f2ef2a9e388 100644
--- a/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td
+++ b/flang/include/flang/Optimizer/Dialect/MIF/MIFOps.td
@@ -592,4 +592,41 @@ def mif_DeallocCoarrayOp
}];
}
+//===----------------------------------------------------------------------===//
+// Coarray Access
+//===----------------------------------------------------------------------===//
+
+def mif_GetCoarrayOp : mif_Op<"get_coarray", [AttrSizedOperandSegments]> {
+ let summary = "Fetch data in a coarray from an image number";
+
+ let arguments = (ins Arg<AnyRefOrBoxType, "", [MemRead]>:$coarray,
+ Variadic<AnyIntegerType>:$cosubscripts,
+ Arg<AnyRefOrBoxType, "", [MemWrite]>:$dest,
+ Arg<Optional<AnyReferenceLike>, "", [MemWrite]>:$stat,
+ Arg<Optional<AnyRefOrBoxType>, "", [MemWrite]>:$errmsg);
+
+ let assemblyFormat = [{
+ `from` $coarray (`[` $cosubscripts^ `]`)?
+ `to` $dest (`stat` $stat^ )? (`errmsg` $errmsg^ )?
+ attr-dict `:` functional-type(operands, results)
+ }];
+}
+
+def mif_PutCoarrayOp : mif_Op<"put_coarray", [AttrSizedOperandSegments]> {
+ let summary = "Assign data to a coarray to an image number";
+
+ let arguments = (ins Arg<AnyRefOrBoxType, "", [MemWrite]>:$coarray,
+ Variadic<AnyIntegerType>:$cosubscripts,
+ Arg<AnyRefOrBoxType, "", [MemRead]>:$src,
+ Optional<AnyRefOrBoxType>:$notify,
+ Arg<Optional<AnyReferenceLike>, "", [MemWrite]>:$stat,
+ Arg<Optional<AnyRefOrBoxType>, "", [MemWrite]>:$errmsg);
+
+ let assemblyFormat = [{
+ `from` $src `to` $coarray (`[` $cosubscripts^ `]`)?
+ (`notify` $notify^ )?
+ (`stat` $stat^ )? (`errmsg` $errmsg^ )?
+ attr-dict `:` functional-type(operands, results)
+ }];
+}
#endif // FORTRAN_DIALECT_MIF_MIF_OPS
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index ed8b256f47fd4..65be7490cda46 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -49,6 +49,7 @@
#include "flang/Optimizer/Dialect/CUF/CUFOps.h"
#include "flang/Optimizer/Dialect/FIRAttr.h"
#include "flang/Optimizer/Dialect/FIROps.h"
+#include "flang/Optimizer/Dialect/MIF/MIFOps.h"
#include "flang/Optimizer/Dialect/Support/FIRContext.h"
#include "flang/Optimizer/HLFIR/HLFIROps.h"
#include "flang/Optimizer/Support/DataLayout.h"
@@ -815,11 +816,63 @@ class FirConverter : public Fortran::lower::AbstractConverter {
return owningProc.labelEvaluationMap.lookup(label);
}
+ /// Gen coarray expression from a CoarrayRef.
+ fir::ExtendedValue
+ genCoarrayExpr(const Fortran::lower::SomeExpr &expr,
+ const Fortran::evaluate::CoarrayRef &coarrayRef,
+ Fortran::lower::StatementContext &context,
+ mlir::Location loc) {
+ hlfir::Entity coarray = Fortran::lower::convertExprToHLFIR(
+ loc, *this, expr, localSymbols, context);
+ auto [dest, cleanup] = hlfir::createTempFromMold(loc, *builder, coarray);
+ if (cleanup)
+ context.attachCleanup(
+ [&]() { fir::FreeMemOp::create(*builder, loc, dest.getBase()); });
+
+ // Image number computation
+ auto cosubscripts = Fortran::lower::getCosubscripts(*this, loc, coarrayRef);
+
+ // handle STAT from the CoarrayRef
+ mlir::Value stat = mlir::Value{}, errmsg = mlir::Value{};
+ auto statExpr = coarrayRef.stat();
+ if (statExpr.has_value()) {
+ if (auto statRef{Fortran::evaluate::ExtractDataRef(statExpr.value())}) {
+ stat = fir::getBase(
+ getSymbolExtendedValue(statRef->GetLastSymbol(), nullptr));
+ }
+ }
+
+ mif::GetCoarrayOp::create(*builder, loc, coarray, cosubscripts, dest, stat,
+ errmsg);
+ return dest;
+ }
+
+ fir::ExtendedValue
+ genCoarrayExprValue(const Fortran::lower::SomeExpr &expr,
+ const Fortran::evaluate::CoarrayRef &coarrayRef,
+ Fortran::lower::StatementContext &context,
+ mlir::Location loc) {
+ fir::ExtendedValue exv = genCoarrayExpr(expr, coarrayRef, context, loc);
+ return fir::LoadOp::create(*builder, loc, fir::getBase(exv));
+ }
+
+ fir::ExtendedValue
+ genCoarrayExprBox(const Fortran::lower::SomeExpr &expr,
+ const Fortran::evaluate::CoarrayRef &coarrayRef,
+ Fortran::lower::StatementContext &context,
+ mlir::Location loc) {
+ fir::ExtendedValue exv = genCoarrayExpr(expr, coarrayRef, context, loc);
+ return fir::factory::createBoxValue(*builder, loc, exv);
+ }
+
fir::ExtendedValue
genExprAddr(const Fortran::lower::SomeExpr &expr,
Fortran::lower::StatementContext &context,
mlir::Location *locPtr = nullptr) override final {
mlir::Location loc = locPtr ? *locPtr : toLocation();
+ auto coarrayRef = Fortran::evaluate::ExtractCoarrayRef(expr);
+ if (coarrayRef.has_value())
+ return genCoarrayExpr(expr, coarrayRef.value(), context, loc);
return Fortran::lower::convertExprToAddress(loc, *this, expr, localSymbols,
context);
}
@@ -829,6 +882,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
Fortran::lower::StatementContext &context,
mlir::Location *locPtr = nullptr) override final {
mlir::Location loc = locPtr ? *locPtr : toLocation();
+ auto coarrayRef = Fortran::evaluate::ExtractCoarrayRef(expr);
+ if (coarrayRef.has_value())
+ return genCoarrayExprValue(expr, coarrayRef.value(), context, loc);
return Fortran::lower::convertExprToValue(loc, *this, expr, localSymbols,
context);
}
@@ -836,6 +892,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
fir::ExtendedValue
genExprBox(mlir::Location loc, const Fortran::lower::SomeExpr &expr,
Fortran::lower::StatementContext &stmtCtx) override final {
+ auto coarrayRef = Fortran::evaluate::ExtractCoarrayRef(expr);
+ if (coarrayRef.has_value())
+ return genCoarrayExprBox(expr, coarrayRef.value(), stmtCtx, loc);
return Fortran::lower::convertExprToBox(loc, *this, expr, localSymbols,
stmtCtx);
}
@@ -5477,6 +5536,68 @@ class FirConverter : public Fortran::lower::AbstractConverter {
return temps;
}
+ /// Generate an coarray assignment.
+ /// This is an assignment expression with corank > 0.
+ void genCoarrayAssignment(fir::FirOpBuilder &builder, mlir::Location loc,
+ const Fortran::evaluate::Assignment &assign) {
+ Fortran::lower::StatementContext stmtCtx;
+ auto rhsCoarrayRef = Fortran::evaluate::ExtractCoarrayRef(assign.rhs);
+ auto lhsCoarrayRef = Fortran::evaluate::ExtractCoarrayRef(assign.lhs);
+ int lhsCorank = 0;
+ if (auto lhsRef{Fortran::evaluate::ExtractDataRef(assign.lhs)})
+ lhsCorank = lhsRef->GetLastSymbol().Corank();
+
+ // handle STAT from the CoarrayRef
+ mlir::Value stat;
+ if (lhsCoarrayRef.has_value() || rhsCoarrayRef.has_value()) {
+ auto statExpr = lhsCoarrayRef.has_value() ? lhsCoarrayRef.value().stat()
+ : rhsCoarrayRef.value().stat();
+ if (statExpr.has_value()) {
+ if (auto statRef{Fortran::evaluate::ExtractDataRef(statExpr.value())}) {
+ stat = fir::getBase(
+ getSymbolExtendedValue(statRef->GetLastSymbol(), nullptr));
+ }
+ }
+ }
+
+ if (lhsCoarrayRef.has_value() || lhsCorank) {
+ hlfir::Entity lhsEntity = Fortran::lower::convertExprToHLFIR(
+ loc, *this, assign.lhs, localSymbols, stmtCtx);
+ mlir::Value rhs = fir::getBase(Fortran::lower::convertExprToAddress(
+ loc, *this, assign.rhs, localSymbols, stmtCtx));
+ auto cosubscripts =
+ lhsCoarrayRef.has_value()
+ ? Fortran::lower::getCosubscripts(*this, loc, *lhsCoarrayRef)
+ : llvm::SmallVector<mlir::Value>{};
+ // PUT operation if lhs is a coarray.
+ // Retrieving NOTIFY variable from lhsCoarrayRef if he's passed as
+ // argument on the image selector.
+ mlir::Value notifyPtr;
+ if (lhsCoarrayRef.has_value()) {
+ if (auto notifyExpr = lhsCoarrayRef.value().notify()) {
+ notifyPtr = fir::getBase(Fortran::lower::convertExprToAddress(
+ loc, *this, notifyExpr.value(), localSymbols, stmtCtx));
+ }
+ }
+ mif::PutCoarrayOp::create(builder, loc, /*coarray*/ lhsEntity,
+ cosubscripts, /*src*/ rhs, notifyPtr, stat,
+ /*errmsg*/ mlir::Value{});
+ } else {
+ // GET operation because rhs is a coarray.
+ hlfir::Entity rhsEntity = Fortran::lower::convertExprToHLFIR(
+ loc, *this, assign.rhs, localSymbols, stmtCtx);
+ mlir::Value lhs = fir::getBase(Fortran::lower::convertExprToAddress(
+ loc, *this, assign.lhs, localSymbols, stmtCtx));
+ auto cosubscripts =
+ rhsCoarrayRef.has_value()
+ ? Fortran::lower::getCosubscripts(*this, loc, *rhsCoarrayRef)
+ : llvm::SmallVector<mlir::Value>{};
+ mif::GetCoarrayOp::create(builder, loc, /*coarray*/ rhsEntity,
+ cosubscripts, /*dest*/ lhs, stat,
+ /*errmsg*/ mlir::Value{});
+ }
+ }
+
void genDataAssignment(
const Fortran::evaluate::Assignment &assign,
const Fortran::evaluate::ProcedureRef *userDefinedAssignment,
@@ -5501,6 +5622,18 @@ class FirConverter : public Fortran::lower::AbstractConverter {
if (hasCUDAImplicitTransfer && !isInDeviceContext)
implicitTemps = genCUDAImplicitDataTransfer(builder, loc, assign);
+ // Coarray Assignment
+ bool lhsIsCoarray = false, rhsIsCoarray = false;
+ if (auto lhsRef{Fortran::evaluate::ExtractDataRef(assign.lhs)})
+ lhsIsCoarray = lhsRef->GetLastSymbol().Corank() > 0;
+ if (auto rhsRef{Fortran::evaluate::ExtractDataRef(assign.rhs)})
+ rhsIsCoarray = rhsRef->GetLastSymbol().Corank() > 0;
+
+ if (lhsIsCoarray || rhsIsCoarray) {
+ genCoarrayAssignment(builder, loc, assign);
+ return;
+ }
+
// Gather some information about the assignment that will impact how it is
// lowered.
const bool lhsIsWholeAllocatable =
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 19678e429249b..0681facbb1d9f 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -1049,10 +1049,10 @@ using ExvAndCleanup =
} // namespace
// Helper to transform a fir::ExtendedValue to an hlfir::EntityWithAttributes.
-static hlfir::EntityWithAttributes
-extendedValueToHlfirEntity(mlir::Location loc, fir::FirOpBuilder &builder,
- const fir::ExtendedValue &exv, llvm::StringRef name,
- mlir::Operation *insertBefore = nullptr) {
+hlfir::EntityWithAttributes Fortran::lower::extendedValueToHlfirEntity(
+ mlir::Location loc, fir::FirOpBuilder &builder,
+ const fir::ExtendedValue &exv, llvm::StringRef name,
+ mlir::Operation *insertBefore) {
mlir::Value firBase = fir::getBase(exv);
mlir::Type firBaseTy = firBase.getType();
if (fir::isa_trivial(firBaseTy))
@@ -1965,10 +1965,11 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
return std::nullopt; // subroutine call.
if (fir::isPointerType(fir::getBase(result).getType()))
- return extendedValueToHlfirEntity(loc, builder, result, tempResultName);
+ return Fortran::lower::extendedValueToHlfirEntity(loc, builder, result,
+ tempResultName);
if (!resultIsFinalized) {
- hlfir::Entity resultEntity = extendedValueToHlfirEntity(
+ hlfir::Entity resultEntity = Fortran::lower::extendedValueToHlfirEntity(
loc, builder, result, tempResultName, /*insertBefore=*/callOp);
// Allocatable result must be freed, other results are stack allocated.
const auto *allocatable = result.getBoxOf<fir::MutableBoxValue>();
@@ -2031,7 +2032,7 @@ genUserCall(Fortran::lower::PreparedActualArguments &loweredActuals,
/*mayBePolymorphic=*/true,
/*preserveLowerBounds=*/false)
: result;
- return extendedValueToHlfirEntity(
+ return Fortran::lower::extendedValueToHlfirEntity(
loc, builder, loadedResult, tempResultName,
/*insertBefore=*/!allocatable ? callOp : nullptr);
}
@@ -2159,8 +2160,9 @@ static std::optional<hlfir::EntityWithAttributes> genCustomIntrinsicRefCore(
builder, loc, callContext.getProcedureName(), resTy, isPresent,
getArgument, loweredActuals.size(), callContext.stmtCtx);
- return {hlfir::EntityWithAttributes{extendedValueToHlfirEntity(
- loc, builder, result, ".tmp.custom_intrinsic_result")}};
+ return {
+ hlfir::EntityWithAttributes{Fortran::lower::extendedValueToHlfirEntity(
+ loc, builder, result, ".tmp.custom_intrinsic_result")}};
}
static unsigned getCorank(const Fortran::lower::SomeExpr &expr) {
@@ -2312,8 +2314,8 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
mlir::Value boxStorage =
fir::factory::genNullBoxStorage(builder, loc, boxTy);
hlfir::EntityWithAttributes nullBoxEntity =
- extendedValueToHlfirEntity(loc, builder, boxStorage,
- ".tmp.null_box");
+ Fortran::lower::extendedValueToHlfirEntity(
+ loc, builder, boxStorage, ".tmp.null_box");
operands.emplace_back(Fortran::lower::translateToExtendedValue(
loc, builder, nullBoxEntity, stmtCtx));
continue;
@@ -2346,8 +2348,9 @@ genIntrinsicRefCore(Fortran::lower::PreparedActualArguments &loweredActuals,
fn();
if (!fir::getBase(resultExv))
return std::nullopt;
- hlfir::EntityWithAttributes resultEntity = extendedValueToHlfirEntity(
- loc, builder, resultExv, ".tmp.intrinsic_result");
+ hlfir::EntityWithAttributes resultEntity =
+ Fortran::lower::extendedValueToHlfirEntity(loc, builder, resultExv,
+ ".tmp.intrinsic_result");
// Move result into memory into an hlfir.expr since they are immutable from
// that point, and the result storage is some temp. "Null" is special: it
// returns a null pointer variable that should not be transformed into a value
@@ -3021,8 +3024,8 @@ genCustomIntrinsicRef(const Fortran::evaluate::SpecificIntrinsic *intrinsic,
}
if (!exv)
llvm_unreachable("bad switch");
- actual = extendedValueToHlfirEntity(loc, builder, exv.value(),
- "tmp.custom_intrinsic_arg");
+ actual = Fortran::lower::extendedValueToHlfirEntity(
+ loc, builder, exv.value(), "tmp.custom_intrinsic_arg");
loweredActuals.emplace_back(Fortran::lower::PreparedActualArgument{
actual, /*isPresent=*/std::nullopt});
};
diff --git a/flang/lib/Lower/MultiImageFortran.cpp b/flang/lib/Lower/MultiImageFortran.cpp
index 66ffca0b850dd..9640bfcc5a057 100644
--- a/flang/lib/Lower/MultiImageFortran.cpp
+++ b/flang/lib/Lower/MultiImageFortran.cpp
@@ -13,10 +13,13 @@
#include "flang/Lower/MultiImageFortran.h"
#include "flang/Lower/AbstractConverter.h"
+#include "flang/Lower/ConvertCall.h"
#include "flang/Lower/Support/Utils.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Builder/HLFIRTools.h"
#include "flang/Optimizer/Builder/MIFCommon.h"
#include "flang/Optimizer/Builder/Todo.h"
+#include "flang/Optimizer/Support/DataLayout.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Semantics/expression.h"
#include "mlir/IR/IRMapping.h"
@@ -263,6 +266,35 @@ void Fortran::lower::genFormTeamStatement(
// COARRAY utils
//===----------------------------------------------------------------------===//
+/// From cosubscript, generate call to mif.image_index
+/// associated to an addr
+mlir::SmallVector<mlir::Value>
+Fortran::lower::getCosubscripts(Fortran::lower::AbstractConverter &converter,
+ mlir::Location loc,
+ const Fortran::evaluate::CoarrayRef &expr) {
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ Fortran::lower::StatementContext stmtCtx;
+ mlir::SmallVector<mlir::Value> cosubscripts;
+
+ // Creation of the cosubscripts vector
+ mlir::Type i64Ty = builder.getI64Type();
+ unsigned corank = expr.cosubscript().size();
+ for (unsigned dim = 0; dim < corank; ++dim) {
+ auto image = ToInt64(expr.cosubscript()[dim]);
+ mlir::Value idx;
+ if (image.has_value())
+ idx = builder.createIntegerConstant(loc, i64Ty, image.value());
+ else {
+ auto s = ignoreEvConvert(expr.cosubscript()[dim]);
+ idx = builder.createConvert(
+ loc, i64Ty, fir::getBase(converter.genExprValue(loc, s, stmtCtx)));
+ }
+
+ cosubscripts.push_back(idx);
+ }
+ return cosubscripts;
+}
+
mlir::Value
Fortran::lower::genLowerCoBounds(Fortran::lower::AbstractConverter &converter,
mlir::Location loc,
diff --git a/flang/lib/Optimizer/Builder/MIFCommon.cpp b/flang/lib/Optimizer/Builder/MIFCommon.cpp
index 56225cda34fdb..a28bf55000a65 100644
--- a/flang/lib/Optimizer/Builder/MIFCommon.cpp
+++ b/flang/lib/Optimizer/Builder/MIFCommon.cpp
@@ -35,6 +35,10 @@ std::string mif::getFullUniqName(mlir::Value addr) {
return getFullUniqName(eb.getMemref());
else if (auto ebc = mlir::dyn_cast<fir::EmboxCharOp>(op))
return getFullUniqName(ebc.getMemref());
+ else if (auto ac = mlir::dyn_cast<fir::ArrayCoorOp>(op))
+ return getFullUniqName(ac.getMemref());
+ else if (auto c = mlir::dyn_cast<fir::ConvertOp>(op))
+ return getFullUniqName(c.getValue());
else if (auto c = mlir::dyn_cast<fir::CoordinateOp>(op)) {
if (c.getFieldIndicesAttr()) {
mlir::Type eleTy = fir::getFortranElementType(c.getRef().getType());
diff --git a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
index 77dfb5ac957ea..d49b02121f9cf 100644
--- a/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
+++ b/flang/lib/Optimizer/Transforms/MIFOpConversion.cpp
@@ -143,8 +143,10 @@ std::int64_t getCorank(mlir::Value coarray) {
static int computeElementByteSize(mlir::Location loc, mlir::Type type,
fir::KindMapping &kindMap,
+ mlir::DataLayout *dl,
+ const fir::LLVMTypeConverter *typeConverter,
bool emitErrorOnFailure = true) {
- auto eleTy = fir::unwrapSequenceType(type);
+ auto eleTy = fir::getFortranElementType(type);
if (auto t{mlir::dyn_cast<mlir::IntegerType>(eleTy)})
return t.getWidth() / 8;
if (auto t{mlir::dyn_cast<mlir::FloatType>(eleTy)})
@@ -158,6 +160,10 @@ static int computeElementByteSize(mlir::Location loc, mlir::Type type,
}
if (auto t{mlir::dyn_cast<fir::CharacterType>(eleTy)})
return kindMap.getCharacterBitsize(t.getFKind()) / 8;
+ if (fir::isa_derived(eleTy)) {
+ mlir::Type structTy = typeConverter->convertType(eleTy);
+ return dl->getTypeSizeInBits(structTy) / 8;
+ }
if (emitErrorOnFailure)
mlir::emitError(loc, "unsupported type");
return 0;
@@ -173,55 +179,68 @@ static mlir::Value getSizeInBytes(fir::FirOpBuilder &builder,
mlir::Value box) {
fir::KindMapping kindMap{fir::getKindMapping(module)};
mlir::Type baseTy = fir::unwrapPassByRefType(box.getType());
+ mlir::Type i64Ty = builder.getI64Type();
+ mlir::Type idxTy = builder.getIndexType();
- mlir::Value sizeInBytes = builder.createTemporary(loc, builder.getI64Type());
+ mlir::Value sizeInBytes = builder.createTemporary(loc, i64Ty);
mlir::Value bytes;
+
if (!mlir::dyn_cast_or_null<fir::BaseBoxType>(baseTy)) {
if (fir::isa_trivial(baseTy)) {
- int width = computeElementByteSize(loc, baseTy, kindMap);
- bytes = builder.createIntegerConstant(loc, builder.getI64Type(), width);
+ int width =
+ computeElementByteSize(loc, baseTy, kindMap, dl, typeConverter);
+ bytes = builder.createIntegerConstant(loc, i64Ty, width);
} else if (auto seqTy = mlir::dyn_cast_or_null<fir::SequenceType>(baseTy)) {
std::size_t size = 0;
if (fir::isa_derived(seqTy.getEleTy())) {
mlir::Type structTy = typeConverter->convertType(seqTy.getEleTy());
size = dl->getTypeSizeInBits(structTy) / 8;
} else {
- size = computeElementByteSize(loc, seqTy.getEleTy(), kindMap);
+ size = computeElementByteSize(loc, seqTy.getEleTy(), kindMap, dl,
+ typeConverter);
}
- mlir::Value width =
- builder.createIntegerConstant(loc, builder.getI64Type(), size);
+ mlir::Value width = builder.createIntegerConstant(loc, i64Ty, size);
mlir::Value nbElem;
if (fir::sequenceWithNonConstantShape(seqTy)) {
// TODO: Not handle for now, but will be do it later.
mlir::emitError(loc,
"unsupported sequence type with non constant shape");
} else {
- nbElem = builder.createIntegerConstant(loc, builder.getI64Type(),
+ nbElem = builder.createIntegerConstant(loc, i64Ty,
seqTy.getConstantArraySize());
}
bytes = mlir::arith::MulIOp::create(builder, loc, nbElem, width);
} else if (fir::isa_derived(baseTy)) {
mlir::Type structTy = typeConverter->convertType(baseTy);
std::size_t structSize = dl->getTypeSizeInBits(structTy) / 8;
- bytes =
- builder.createIntegerConstant(loc, builder.getI64Type(), structSize);
+ bytes = builder.createIntegerConstant(loc, i64Ty, structSize);
} else if (fir::isa_char(baseTy)) {
mlir::Type charTy = typeConverter->convertType(baseTy);
std::size_t charSize = dl->getTypeSizeInBits(charTy) / 8;
- bytes =
- builder.createIntegerConstant(loc, builder.getI64Type(), charSize);
+ bytes = builder.createIntegerConstant(loc, i64Ty, charSize);
} else {
mlir::emitError(loc, "unsupported type in mif allocation\n");
}
} else {
if (fir::isa_ref_type(box.getType()))
box = fir::LoadOp::create(builder, loc, box);
- bytes = fir::BoxEleSizeOp::create(builder, loc, builder.getI64Type(), box);
- auto boxTy = mlir::dyn_cast_or_null<fir::BaseBoxType>(baseTy);
- if (fir::extractSequenceType(boxTy)) {
- mlir::Value extent = builder.createConvert(
- loc, builder.getI64Type(), fir::runtime::genSize(builder, loc, box));
- bytes = mlir::arith::MulIOp::create(builder, loc, bytes, extent);
+ bytes = fir::BoxEleSizeOp::create(builder, loc, i64Ty, box);
+ if (fir::SequenceType seqTy = fir::unwrapUntilSeqType(baseTy)) {
+ mlir::Value nbElem;
+ if (fir::sequenceWithNonConstantShape(seqTy)) {
+ nbElem = builder.createIntegerConstant(loc, i64Ty, 1);
+ for (unsigned dim = 0; dim < seqTy.getDimension(); ++dim) {
+ mlir::Value dimIdx = builder.createIntegerConstant(loc, idxTy, dim);
+ auto dimsOp = fir::BoxDimsOp::create(builder, loc, idxTy, idxTy,
+ idxTy, box, dimIdx);
+ mlir::Value extent =
+ builder.createConvert(loc, i64Ty, dimsOp.getResult(1));
+ nbElem = mlir::arith::MulIOp::create(builder, loc, nbElem, extent);
+ }
+ } else
+ nbElem = builder.createIntegerConstant(loc, i64Ty,
+ seqTy.getConstantArraySize());
+ bytes = mlir::arith::MulIOp::create(builder, loc, bytes, nbElem);
}
}
fir::StoreOp::create(builder, loc, bytes, sizeInBytes);
@@ -361,6 +380,26 @@ mlir::Value genTerminationOperationWrapper(fir::FirOpBuilder &builder,
return fir::AddrOfOp::create(builder, loc, funcType, symbolRef);
}
+static mlir::Value emboxRef(mlir::PatternRewriter &rewriter, mlir::ModuleOp mod,
+ mlir::Location loc, mlir::Value addr) {
+ mlir::Value shape;
+ if (auto declareOp = addr.getDefiningOp<fir::DeclareOp>())
+ shape = declareOp.getShape();
+ if (auto declareOp = addr.getDefiningOp<hlfir::DeclareOp>())
+ shape = declareOp.getShape();
+
+ fir::FirOpBuilder builder(rewriter, mod);
+ mlir::Type dstTy = fir::unwrapRefType(addr.getType());
+ mlir::Type dstBoxTy = fir::BoxType::get(dstTy);
+ llvm::SmallVector<mlir::Value> lenParams;
+ mlir::Value dstBox = builder.createBox(loc, dstBoxTy, addr, shape,
+ /*slice=*/nullptr, lenParams,
+ /*tdesc=*/nullptr);
+ mlir::Value dst = builder.createTemporary(loc, dstBox.getType());
+ fir::StoreOp::create(builder, loc, dstBox, dst);
+ return dst;
+}
+
/// Convert mif.init operation to runtime call of 'prif_init'
struct MIFInitOpConversion : public mlir::OpRewritePattern<mif::InitOp> {
using OpRewritePattern::OpRewritePattern;
@@ -1360,6 +1399,305 @@ struct MIFImageIndexOpConversion
}
};
+static mlir::Value
+getInitialTeamIndex(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value coarrayHandle,
+ llvm::SmallVector<mlir::Value> cosubscripts) {
+ mlir::Type boxTy = fir::BoxType::get(builder.getNoneType());
+ mlir::Type i32Ty = builder.getI32Type();
+ mlir::Type i64Ty = builder.getI64Type();
+ mlir::Type boxArrTy = genBoxedSequenceType(i64Ty);
+ mlir::Value index = builder.createTemporary(loc, i32Ty);
+
+ if (cosubscripts.size() == 0) {
+ mlir::FunctionType ftype = mlir::FunctionType::get(
+ builder.getContext(),
+ /*inputs*/ {boxTy, builder.getRefType(i32Ty)}, /*results*/ {});
+ mlir::Value 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, index);
+ fir::CallOp::create(builder, loc, funcOp, args);
+ return index;
+ }
+
+ mlir::FunctionType ftype = mlir::FunctionType::get(
+ builder.getContext(),
+ /*inputs*/
+ {boxTy, boxArrTy, builder.getRefType(i32Ty), builder.getRefType(i32Ty)},
+ /*results*/ {});
+ mlir::func::FuncOp funcOp =
+ builder.createFunction(loc, getPRIFProcName("initial_team_index"), ftype);
+
+ // Creation of sub
+ unsigned corank = cosubscripts.size();
+ mlir::Type indexType = builder.getIndexType();
+ mlir::Type arrayType = fir::SequenceType::get(
+ {static_cast<fir::SequenceType::Extent>(corank)}, i64Ty);
+ mlir::Value sub = builder.createTemporary(loc, arrayType);
+ mlir::Type addrType = builder.getRefType(i64Ty);
+ for (unsigned i = 0; i < corank; ++i) {
+ mlir::Value cs = builder.createConvert(loc, i64Ty, cosubscripts[i]);
+ auto index = builder.createIntegerConstant(loc, indexType, i);
+ auto addr = fir::CoordinateOp::create(builder, loc, addrType, sub, index);
+ fir::StoreOp::create(builder, loc, cs, addr);
+ }
+ sub = builder.createBox(loc, sub);
+
+ mlir::Value stat =
+ fir::AbsentOp::create(builder, loc, getPRIFStatType(builder));
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, ftype, coarrayHandle, sub, index, stat);
+ fir::CallOp::create(builder, loc, funcOp, args);
+ return index;
+}
+
+/// Compute an offset in bytes from the beginning of the elements provided in
+/// "val". Basically, if it's not a memory access operation for an array such
+/// as fir::ArrayCoorOp then the element's offset is zero.
+/// TODO: Handling fir::CoordinateOp later ?
+static mlir::Value
+computeOffsetInBytes(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::ModuleOp module, mlir::DataLayout *dl,
+ const fir::LLVMTypeConverter *typeConverter,
+ mlir::Value val) {
+ fir::KindMapping kindMap{fir::getKindMapping(module)};
+ auto i64Ty = builder.getI64Type();
+ auto idxTy = builder.getIndexType();
+ auto zero = [&]() { return builder.createIntegerConstant(loc, i64Ty, 0); };
+ auto one = [&]() { return builder.createIntegerConstant(loc, i64Ty, 1); };
+
+ if (auto convert = val.getDefiningOp<fir::ConvertOp>())
+ return computeOffsetInBytes(builder, loc, module, dl, typeConverter,
+ convert.getValue());
+
+ if (auto coor = val.getDefiningOp<fir::ArrayCoorOp>()) {
+ mlir::Value base = computeOffsetInBytes(builder, loc, module, dl,
+ typeConverter, coor.getMemref());
+ mlir::Type eleTy = fir::unwrapSequenceType(
+ fir::unwrapPassByRefType(coor.getMemref().getType()));
+ mlir::Value offset = zero();
+
+ llvm::SmallVector<mlir::Value> extents;
+ llvm::SmallVector<mlir::Value> origins;
+ if (mlir::Value shape = coor.getShape()) {
+ if (auto shapeOp = shape.getDefiningOp<fir::ShapeOp>()) {
+ extents.append(shapeOp.getExtents().begin(),
+ shapeOp.getExtents().end());
+ } else if (auto shapeShiftOp = shape.getDefiningOp<fir::ShapeShiftOp>()) {
+ auto pairs = shapeShiftOp.getPairs();
+ for (size_t i = 0; i < pairs.size(); i += 2) {
+ origins.push_back(pairs[i]);
+ extents.push_back(pairs[i + 1]);
+ }
+ } else if (auto shiftOp = shape.getDefiningOp<fir::ShiftOp>())
+ origins.assign(shiftOp.getOrigins().begin(),
+ shiftOp.getOrigins().end());
+ }
+
+ mlir::Value currentStride = builder.createIntegerConstant(
+ loc, i64Ty,
+ computeElementByteSize(loc, eleTy, kindMap, dl, typeConverter));
+
+ auto indices = coor.getIndices();
+ for (auto [dim, idx] : llvm::enumerate(indices)) {
+ mlir::Value lb, stride;
+ if (dim < origins.size())
+ lb = builder.createConvert(loc, i64Ty, origins[dim]);
+ else
+ lb = one();
+
+ idx = builder.createConvert(loc, i64Ty, idx);
+ idx = mlir::arith::SubIOp::create(builder, loc, idx, lb);
+ if (mlir::isa<fir::BaseBoxType>(
+ fir::unwrapRefType(coor.getMemref().getType()))) {
+ auto dims = fir::BoxDimsOp::create(
+ builder, loc, idxTy, idxTy, idxTy, coor.getMemref(),
+ builder.createIntegerConstant(loc, idxTy, dim));
+ stride = builder.createConvert(loc, i64Ty, dims.getByteStride());
+ } else {
+ stride = currentStride;
+ if (dim < extents.size()) {
+ mlir::Value ext = builder.createConvert(loc, i64Ty, extents[dim]);
+ currentStride =
+ mlir::arith::MulIOp::create(builder, loc, currentStride, ext);
+ }
+ }
+
+ mlir::Value delta =
+ mlir::arith::MulIOp::create(builder, loc, idx, stride);
+ offset = mlir::arith::AddIOp::create(builder, loc, offset, delta);
+ }
+ return mlir::arith::AddIOp::create(builder, loc, base, offset);
+ }
+ return zero();
+}
+
+// Function that attempts to check whether my variable contains slice
+// information. Currently, GET and PUT operations do not support calls to PRIF
+// procedures with strides.
+bool hasSlice(mlir::Value val) {
+ if (auto convert = val.getDefiningOp<fir::ConvertOp>())
+ return hasSlice(convert.getValue());
+
+ mlir::Operation *op = val.getDefiningOp();
+ if (auto embox = mlir::dyn_cast_or_null<fir::EmboxOp>(op))
+ if (embox.getSlice())
+ return true;
+ if (auto coor = mlir::dyn_cast_or_null<fir::ArrayCoorOp>(op))
+ if (coor.getSlice())
+ return true;
+
+ if (auto designate = mlir::dyn_cast_or_null<hlfir::DesignateOp>(op)) {
+ llvm::ArrayRef<bool> isTriplet = designate.getIsTriplet();
+ return llvm::any_of(isTriplet, [](bool b) { return b; });
+ }
+ return false;
+}
+
+/// Convert mif.get operation to the appropriate runtime call of 'prif_get_*'
+struct MIFGetCoarrayOpConversion
+ : public mlir::OpRewritePattern<mif::GetCoarrayOp> {
+ using OpRewritePattern::OpRewritePattern;
+
+ MIFGetCoarrayOpConversion(mlir::MLIRContext *context, mlir::DataLayout *dl,
+ const fir::LLVMTypeConverter *typeConverter)
+ : OpRewritePattern(context), dl{dl}, typeConverter{typeConverter} {}
+
+ mlir::LogicalResult
+ matchAndRewrite(mif::GetCoarrayOp 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 errmsgTy = getPRIFErrmsgType(builder);
+ mlir::Type ptrTy = fir::PointerType::get(builder.getNoneType());
+ mlir::Type boxTy = fir::BoxType::get(builder.getNoneType());
+ mlir::Type i32Ty = builder.getI32Type();
+ mlir::Type i64Ty = builder.getI64Type();
+
+ mlir::FunctionType ftype;
+ mlir::func::FuncOp funcOp;
+ mlir::Value sizeInBytes;
+ if (hasSlice(op.getCoarray())) {
+ TODO(loc, "coarray: get operation with strides");
+ } else {
+ ftype = mlir::FunctionType::get(
+ builder.getContext(),
+ /*inputs*/
+ {builder.getRefType(i32Ty), boxTy, builder.getRefType(i64Ty), ptrTy,
+ builder.getRefType(i64Ty), getPRIFStatType(builder), errmsgTy,
+ errmsgTy},
+ /*results*/ {});
+ funcOp = builder.createFunction(loc, getPRIFProcName("get"), ftype);
+
+ sizeInBytes =
+ getSizeInBytes(builder, loc, mod, dl, typeConverter, op.getCoarray());
+ }
+
+ mlir::Value coarrayHandle = getCoarrayHandle(builder, loc, op.getCoarray());
+ mlir::Value stat = op.getStat();
+ if (!stat)
+ stat = fir::AbsentOp::create(builder, loc, getPRIFStatType(builder));
+ auto [errmsgArg, errmsgAllocArg] =
+ genErrmsgPRIF(builder, loc, op.getErrmsg());
+
+ mlir::Value offset = builder.createTemporary(loc, i64Ty);
+ mlir::Value o = computeOffsetInBytes(builder, loc, mod, dl, typeConverter,
+ op.getCoarray());
+ fir::StoreOp::create(builder, loc, o, offset);
+
+ mlir::Value imageNum =
+ getInitialTeamIndex(builder, loc, coarrayHandle, op.getCosubscripts());
+
+ mlir::Value dest = emboxRef(rewriter, mod, loc, op.getDest());
+
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, ftype, imageNum, coarrayHandle, offset, dest, sizeInBytes,
+ stat, errmsgArg, errmsgAllocArg);
+ fir::CallOp callOp = fir::CallOp::create(builder, loc, funcOp, args);
+ rewriter.replaceOp(op, callOp);
+ return mlir::success();
+ }
+
+private:
+ mlir::DataLayout *dl;
+ const fir::LLVMTypeConverter *typeConverter;
+};
+
+/// Convert mif.put operation to the appropriate runtime call of 'prif_put_*'
+struct MIFPutCoarrayOpConversion
+ : public mlir::OpRewritePattern<mif::PutCoarrayOp> {
+ using OpRewritePattern::OpRewritePattern;
+
+ MIFPutCoarrayOpConversion(mlir::MLIRContext *context, mlir::DataLayout *dl,
+ const fir::LLVMTypeConverter *typeConverter)
+ : OpRewritePattern(context), dl{dl}, typeConverter{typeConverter} {}
+
+ mlir::LogicalResult
+ matchAndRewrite(mif::PutCoarrayOp 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 errmsgTy = getPRIFErrmsgType(builder);
+ mlir::Type ptrTy = fir::PointerType::get(builder.getNoneType());
+ mlir::Type boxTy = fir::BoxType::get(builder.getNoneType());
+ mlir::Type i32Ty = builder.getI32Type();
+ mlir::Type i64Ty = builder.getI64Type();
+
+ mlir::FunctionType ftype;
+ mlir::func::FuncOp funcOp;
+ mlir::Value sizeInBytes;
+ if (op.getNotify())
+ TODO(loc, "coarray: put operation with notify");
+ if (hasSlice(op.getCoarray()))
+ TODO(loc, "coarray: put operation with strides");
+
+ ftype = mlir::FunctionType::get(
+ builder.getContext(),
+ /*inputs*/
+ {builder.getRefType(i32Ty), boxTy, builder.getRefType(i64Ty), ptrTy,
+ builder.getRefType(i64Ty), getPRIFStatType(builder), errmsgTy,
+ errmsgTy},
+ /*results*/ {});
+ funcOp = builder.createFunction(loc, getPRIFProcName("put"), ftype);
+ sizeInBytes =
+ getSizeInBytes(builder, loc, mod, dl, typeConverter, op.getCoarray());
+
+ mlir::Value coarrayHandle = getCoarrayHandle(builder, loc, op.getCoarray());
+ mlir::Value stat = op.getStat();
+ if (!stat)
+ stat = fir::AbsentOp::create(builder, loc, getPRIFStatType(builder));
+ auto [errmsgArg, errmsgAllocArg] =
+ genErrmsgPRIF(builder, loc, op.getErrmsg());
+
+ mlir::Value offset = builder.createTemporary(loc, i64Ty);
+ mlir::Value o = computeOffsetInBytes(builder, loc, mod, dl, typeConverter,
+ op.getCoarray());
+ fir::StoreOp::create(builder, loc, o, offset);
+
+ mlir::Value imageNum =
+ getInitialTeamIndex(builder, loc, coarrayHandle, op.getCosubscripts());
+
+ mlir::Value src = emboxRef(rewriter, mod, loc, op.getSrc());
+
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, ftype, imageNum, coarrayHandle, offset, src, sizeInBytes,
+ stat, errmsgArg, errmsgAllocArg);
+ fir::CallOp callOp = fir::CallOp::create(builder, loc, funcOp, args);
+ rewriter.replaceOp(op, callOp);
+ return mlir::success();
+ }
+
+private:
+ mlir::DataLayout *dl;
+ const fir::LLVMTypeConverter *typeConverter;
+};
+
class MIFOpConversion : public fir::impl::MIFOpConversionBase<MIFOpConversion> {
public:
void runOnOperation() override {
@@ -1402,8 +1740,9 @@ class MIFOpConversion : public fir::impl::MIFOpConversionBase<MIFOpConversion> {
void mif::populateMIFOpConversionPatterns(
const fir::LLVMTypeConverter &converter, mlir::DataLayout &dl,
mlir::RewritePatternSet &patterns) {
- patterns.insert<MIFAllocCoarrayOpConversion>(patterns.getContext(), &dl,
- &converter);
+ patterns.insert<MIFAllocCoarrayOpConversion, MIFGetCoarrayOpConversion,
+ MIFPutCoarrayOpConversion>(patterns.getContext(), &dl,
+ &converter);
patterns.insert<MIFInitOpConversion, MIFThisImageOpConversion,
MIFNumImagesOpConversion, MIFSyncAllOpConversion,
MIFSyncImagesOpConversion, MIFSyncMemoryOpConversion,
diff --git a/flang/test/Fir/MIF/coarray_get.mlir b/flang/test/Fir/MIF/coarray_get.mlir
new file mode 100644
index 0000000000000..b4d8d08487728
--- /dev/null
+++ b/flang/test/Fir/MIF/coarray_get.mlir
@@ -0,0 +1,55 @@
+
+// RUN: fir-opt --mif-convert %s | FileCheck %s
+
+func.func @_QPtest_coarray_get_scalar() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %1 = fir.address_of(@_QFtest_coarray_get_scalarEa) : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+ %2:2 = hlfir.declare %1 {uniq_name = "_QFtest_coarray_get_scalarEa"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>, !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>)
+ %3 = fir.alloca f32 {bindc_name = "b", uniq_name = "_QFtest_coarray_get_scalarEb"}
+ %4:2 = hlfir.declare %3 {uniq_name = "_QFtest_coarray_get_scalarEb"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+ %cst = arith.constant 2.000000e+00 : f32
+ hlfir.assign %cst to %4#0 : f32, !fir.ref<f32>
+ %5 = fir.load %2#0 : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+ %6 = fir.box_addr %5 : (!fir.box<!fir.heap<f32>, corank:1>) -> !fir.heap<f32>
+ %7 = hlfir.designate %6 : (!fir.heap<f32>) -> !fir.ref<f32>
+ %c2_i64 = arith.constant 2 : i64
+ mif.get_coarray from %7[%c2_i64] to %4#0 : (!fir.ref<f32>, i64, !fir.ref<f32>) -> ()
+ return
+}
+
+// CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<f32>
+// CHECK: %[[VAL_1:.*]] = fir.alloca !fir.array<1xi64>
+// CHECK: %[[VAL_2:.*]] = fir.alloca i32
+// CHECK: %[[VAL_3:.*]] = fir.alloca i64
+// CHECK: %[[VAL_4:.*]] = fir.alloca i64
+// CHECK: %[[VAL_5:.*]] = fir.dummy_scope : !fir.dscope
+// CHECK: %[[VAL_6:.*]] = fir.address_of(@_QFtest_coarray_get_scalarEa) : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+// CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_6]] {uniq_name = "_QFtest_coarray_get_scalarEa"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>, !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>)
+// CHECK: %[[VAL_8:.*]] = fir.alloca f32 {bindc_name = "b", uniq_name = "_QFtest_coarray_get_scalarEb"}
+// CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_8]] {uniq_name = "_QFtest_coarray_get_scalarEb"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+// CHECK: %cst = arith.constant 2.000000e+00 : f32
+// CHECK: hlfir.assign %cst to %[[VAL_9]]#0 : f32, !fir.ref<f32>
+// CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+// CHECK: %[[VAL_11:.*]] = fir.box_addr %[[VAL_10]] : (!fir.box<!fir.heap<f32>, corank:1>) -> !fir.heap<f32>
+// CHECK: %[[VAL_12:.*]] = hlfir.designate %[[VAL_11]] : (!fir.heap<f32>) -> !fir.ref<f32>
+// CHECK: %c2_i64 = arith.constant 2 : i64
+// CHECK: %c4_i64 = arith.constant 4 : i64
+// CHECK: fir.store %c4_i64 to %[[VAL_4]] : !fir.ref<i64>
+// CHECK: %[[VAL_13:.*]] = fir.address_of(@_QFtest_coarray_get_scalarEa_coarray_handle) : !fir.ref<!fir.box<none>>
+// CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_13]] : !fir.ref<!fir.box<none>>
+// CHECK: %[[VAL_15:.*]] = fir.absent !fir.ref<i32>
+// CHECK: %[[VAL_16:.*]] = fir.absent !fir.box<!fir.char<1,?>>
+// CHECK: %c0_i64 = arith.constant 0 : i64
+// CHECK: fir.store %c0_i64 to %[[VAL_3]] : !fir.ref<i64>
+// CHECK: %c0 = arith.constant 0 : index
+// CHECK: %[[VAL_17:.*]] = fir.coordinate_of %[[VAL_1]], %c0 : (!fir.ref<!fir.array<1xi64>>, index) -> !fir.ref<i64>
+// CHECK: fir.store %c2_i64 to %[[VAL_17]] : !fir.ref<i64>
+// CHECK: %[[VAL_18:.*]] = fir.embox %[[VAL_1]] : (!fir.ref<!fir.array<1xi64>>) -> !fir.box<!fir.array<1xi64>>
+// CHECK: %[[VAL_19:.*]] = fir.absent !fir.ref<i32>
+// CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_18]] : (!fir.box<!fir.array<1xi64>>) -> !fir.box<!fir.array<?xi64>>
+// CHECK: fir.call @_QMprifPprif_initial_team_index(%[[VAL_14]], %[[VAL_20]], %[[VAL_2]], %[[VAL_19]]) : (!fir.box<none>, !fir.box<!fir.array<?xi64>>, !fir.ref<i32>, !fir.ref<i32>) -> ()
+// CHECK: %[[VAL_21:.*]] = fir.embox %[[VAL_9]]#0 : (!fir.ref<f32>) -> !fir.box<f32>
+// CHECK: fir.store %[[VAL_21]] to %[[VAL_0]] : !fir.ref<!fir.box<f32>>
+// CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.box<f32>>) -> !fir.ptr<none>
+// CHECK: fir.call @_QMprifPprif_get(%[[VAL_2]], %[[VAL_14]], %[[VAL_3]], %[[VAL_22]], %[[VAL_4]], %[[VAL_15]], %[[VAL_16]], %[[VAL_16]]) : (!fir.ref<i32>, !fir.box<none>, !fir.ref<i64>, !fir.ptr<none>, !fir.ref<i64>, !fir.ref<i32>, !fir.box<!fir.char<1,?>>, !fir.box<!fir.char<1,?>>) -> ()
+
diff --git a/flang/test/Fir/MIF/coarray_get2.mlir b/flang/test/Fir/MIF/coarray_get2.mlir
new file mode 100644
index 0000000000000..2c47626fb2873
--- /dev/null
+++ b/flang/test/Fir/MIF/coarray_get2.mlir
@@ -0,0 +1,53 @@
+// RUN: not fir-opt --mif-convert %s 2>&1 | FileCheck %s
+
+// CHECK: not yet implemented: coarray: get operation with strides
+
+func.func @_QPtest_coarray_get_array() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %1 = fir.address_of(@_QFtest_coarray_get_arrayEa) : !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>
+ %2:2 = hlfir.declare %1 {uniq_name = "_QFtest_coarray_get_arrayEa"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>, !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>)
+ %3 = fir.address_of(@_QFtest_coarray_get_arrayEb) : !fir.ref<!fir.array<3x4xi32>>
+ %c3 = arith.constant 3 : index
+ %c4 = arith.constant 4 : index
+ %4 = fir.shape %c3, %c4 : (index, index) -> !fir.shape<2>
+ %5:2 = hlfir.declare %3(%4) {uniq_name = "_QFtest_coarray_get_arrayEb"} : (!fir.ref<!fir.array<3x4xi32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<3x4xi32>>, !fir.ref<!fir.array<3x4xi32>>)
+ %6 = fir.alloca i32 {bindc_name = "me", uniq_name = "_QFtest_coarray_get_arrayEme"}
+ %7:2 = hlfir.declare %6 {uniq_name = "_QFtest_coarray_get_arrayEme"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %8 = mif.this_image : () -> i32
+ hlfir.assign %8 to %7#0 : i32, !fir.ref<i32>
+ %9 = fir.load %7#0 : !fir.ref<i32>
+ %c1_i32 = arith.constant 1 : i32
+ %10 = arith.cmpi eq, %9, %c1_i32 : i32
+ fir.if %10 {
+ %11 = fir.address_of(@_QQro.3x4xi4.0) : !fir.ref<!fir.array<3x4xi32>>
+ %c3_0 = arith.constant 3 : index
+ %c4_1 = arith.constant 4 : index
+ %12 = fir.shape %c3_0, %c4_1 : (index, index) -> !fir.shape<2>
+ %13:2 = hlfir.declare %11(%12) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x4xi4.0"} : (!fir.ref<!fir.array<3x4xi32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<3x4xi32>>, !fir.ref<!fir.array<3x4xi32>>)
+ mif.put_coarray from %13#0 to %2#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>, !fir.ref<!fir.array<3x4xi32>>) -> ()
+ } else {
+ %11 = fir.load %2#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>
+ %c0 = arith.constant 0 : index
+ %12:3 = fir.box_dims %11, %c0 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index) -> (index, index, index)
+ %c1 = arith.constant 1 : index
+ %13:3 = fir.box_dims %11, %c1 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index) -> (index, index, index)
+ %c1_0 = arith.constant 1 : index
+ %c0_1 = arith.constant 0 : index
+ %14:3 = fir.box_dims %11, %c0_1 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index) -> (index, index, index)
+ %15 = arith.addi %12#0, %14#1 : index
+ %16 = arith.subi %15, %c1_0 : index
+ %c1_2 = arith.constant 1 : index
+ %17:3 = fir.box_dims %11, %c1_2 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index) -> (index, index, index)
+ %18 = arith.addi %13#0, %17#1 : index
+ %19 = arith.subi %18, %c1_0 : index
+ %c1_3 = arith.constant 1 : index
+ %c3_4 = arith.constant 3 : index
+ %c1_5 = arith.constant 1 : index
+ %c4_6 = arith.constant 4 : index
+ %20 = fir.shape %c3_4, %c4_6 : (index, index) -> !fir.shape<2>
+ %21 = hlfir.designate %11 (%12#0:%16:%c1_3, %13#0:%19:%c1_5) shape %20 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index, index, index, index, index, index, !fir.shape<2>) -> !fir.ref<!fir.array<3x4xi32>>
+ %c1_i64 = arith.constant 1 : i64
+ mif.get_coarray from %21[%c1_i64] to %5#0 : (!fir.ref<!fir.array<3x4xi32>>, i64, !fir.ref<!fir.array<3x4xi32>>) -> ()
+ }
+ return
+}
diff --git a/flang/test/Fir/MIF/coarray_put.mlir b/flang/test/Fir/MIF/coarray_put.mlir
new file mode 100644
index 0000000000000..77006622d36ee
--- /dev/null
+++ b/flang/test/Fir/MIF/coarray_put.mlir
@@ -0,0 +1,186 @@
+// RUN: fir-opt --mif-convert %s | FileCheck %s
+
+func.func @_QPtest_coarray_put_scalar() {
+ %0 = fir.alloca f32
+ %1 = fir.alloca f32
+ %2 = fir.dummy_scope : !fir.dscope
+ %3 = fir.address_of(@_QFtest_coarray_put_scalarEa) : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+ %4:2 = hlfir.declare %3 {uniq_name = "_QFtest_coarray_put_scalarEa"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>, !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>)
+ %cst = arith.constant 2.000000e+00 : f32
+ fir.store %cst to %1 : !fir.ref<f32>
+ mif.put_coarray from %1 to %4#0 : (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>, !fir.ref<f32>) -> ()
+ %5 = fir.load %4#0 : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+ %6 = fir.box_addr %5 : (!fir.box<!fir.heap<f32>, corank:1>) -> !fir.heap<f32>
+ %7 = hlfir.designate %6 : (!fir.heap<f32>) -> !fir.ref<f32>
+ %cst_0 = arith.constant 3.000000e+00 : f32
+ fir.store %cst_0 to %0 : !fir.ref<f32>
+ %c2_i64 = arith.constant 2 : i64
+ mif.put_coarray from %0 to %7[%c2_i64] : (!fir.ref<f32>, i64, !fir.ref<f32>) -> ()
+ return
+}
+
+func.func @_QPtest_coarray_put_array() {
+ %0 = fir.alloca i32
+ %1 = fir.dummy_scope : !fir.dscope
+ %2 = fir.address_of(@_QFtest_coarray_put_arrayEa) : !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>
+ %3:2 = hlfir.declare %2 {uniq_name = "_QFtest_coarray_put_arrayEa"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>, !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>)
+ %4 = fir.alloca i32 {bindc_name = "me", uniq_name = "_QFtest_coarray_put_arrayEme"}
+ %5:2 = hlfir.declare %4 {uniq_name = "_QFtest_coarray_put_arrayEme"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %6 = mif.this_image : () -> i32
+ hlfir.assign %6 to %5#0 : i32, !fir.ref<i32>
+ %7 = fir.load %5#0 : !fir.ref<i32>
+ %c1_i32 = arith.constant 1 : i32
+ %8 = arith.cmpi eq, %7, %c1_i32 : i32
+ fir.if %8 {
+ %9 = fir.address_of(@_QQro.3x4xi4.0) : !fir.ref<!fir.array<3x4xi32>>
+ %c3 = arith.constant 3 : index
+ %c4 = arith.constant 4 : index
+ %10 = fir.shape %c3, %c4 : (index, index) -> !fir.shape<2>
+ %11:2 = hlfir.declare %9(%10) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x4xi4.0"} : (!fir.ref<!fir.array<3x4xi32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<3x4xi32>>, !fir.ref<!fir.array<3x4xi32>>)
+ mif.put_coarray from %11#0 to %3#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>, !fir.ref<!fir.array<3x4xi32>>) -> ()
+ } else {
+ %9 = fir.load %3#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>
+ %c2 = arith.constant 2 : index
+ %c3 = arith.constant 3 : index
+ %10 = hlfir.designate %9 (%c2, %c3) : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index, index) -> !fir.ref<i32>
+ %c2_i32 = arith.constant 2 : i32
+ fir.store %c2_i32 to %0 : !fir.ref<i32>
+ %c2_i64 = arith.constant 2 : i64
+ mif.put_coarray from %0 to %10[%c2_i64] : (!fir.ref<i32>, i64, !fir.ref<i32>) -> ()
+ }
+ return
+}
+
+// CHECK-LABEL: func.func @_QPtest_coarray_put_scalar
+// CHECK: %0 = fir.alloca !fir.box<f32>
+// CHECK: %1 = fir.alloca !fir.array<1xi64>
+// CHECK: %2 = fir.alloca i32
+// CHECK: %3 = fir.alloca i64
+// CHECK: %4 = fir.alloca i64
+// CHECK: %5 = fir.alloca !fir.box<f32>
+// CHECK: %6 = fir.alloca i32
+// CHECK: %7 = fir.alloca i64
+// CHECK: %8 = fir.alloca i64
+// CHECK: %9 = fir.alloca f32
+// CHECK: %10 = fir.alloca f32
+// CHECK: %11 = fir.dummy_scope : !fir.dscope
+// CHECK: %12 = fir.address_of(@_QFtest_coarray_put_scalarEa) : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+// CHECK: %13:2 = hlfir.declare %12 {uniq_name = "_QFtest_coarray_put_scalarEa"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>, !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>)
+// CHECK: %cst = arith.constant 2.000000e+00 : f32
+// CHECK: fir.store %cst to %10 : !fir.ref<f32>
+// CHECK: %14 = fir.load %13#0 : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+// CHECK: %15 = fir.box_elesize %14 : (!fir.box<!fir.heap<f32>, corank:1>) -> i64
+// CHECK: fir.store %15 to %8 : !fir.ref<i64>
+// CHECK: %16 = fir.address_of(@_QFtest_coarray_put_scalarEa_coarray_handle) : !fir.ref<!fir.box<none>>
+// CHECK: %17 = fir.load %16 : !fir.ref<!fir.box<none>>
+// CHECK: %18 = fir.absent !fir.ref<i32>
+// CHECK: %19 = fir.absent !fir.box<!fir.char<1,?>>
+// CHECK: %c0_i64 = arith.constant 0 : i64
+// CHECK: fir.store %c0_i64 to %7 : !fir.ref<i64>
+// CHECK: %20 = fir.absent !fir.box<none>
+// CHECK: fir.call @_QMprifPprif_this_image_no_coarray(%20, %6) : (!fir.box<none>, !fir.ref<i32>) -> ()
+// CHECK: %21 = fir.embox %10 : (!fir.ref<f32>) -> !fir.box<f32>
+// CHECK: fir.store %21 to %5 : !fir.ref<!fir.box<f32>>
+// CHECK: %22 = fir.convert %5 : (!fir.ref<!fir.box<f32>>) -> !fir.ptr<none>
+// CHECK: fir.call @_QMprifPprif_put(%6, %17, %7, %22, %8, %18, %19, %19) : (!fir.ref<i32>, !fir.box<none>, !fir.ref<i64>, !fir.ptr<none>, !fir.ref<i64>, !fir.ref<i32>, !fir.box<!fir.char<1,?>>, !fir.box<!fir.char<1,?>>) -> ()
+// CHECK: %23 = fir.load %13#0 : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+// CHECK: %24 = fir.box_addr %23 : (!fir.box<!fir.heap<f32>, corank:1>) -> !fir.heap<f32>
+// CHECK: %25 = hlfir.designate %24 : (!fir.heap<f32>) -> !fir.ref<f32>
+// CHECK: %cst_0 = arith.constant 3.000000e+00 : f32
+// CHECK: fir.store %cst_0 to %9 : !fir.ref<f32>
+// CHECK: %c2_i64 = arith.constant 2 : i64
+// CHECK: %c4_i64 = arith.constant 4 : i64
+// CHECK: fir.store %c4_i64 to %4 : !fir.ref<i64>
+// CHECK: %26 = fir.address_of(@_QFtest_coarray_put_scalarEa_coarray_handle) : !fir.ref<!fir.box<none>>
+// CHECK: %27 = fir.load %26 : !fir.ref<!fir.box<none>>
+// CHECK: %28 = fir.absent !fir.ref<i32>
+// CHECK: %29 = fir.absent !fir.box<!fir.char<1,?>>
+// CHECK: %c0_i64_1 = arith.constant 0 : i64
+// CHECK: fir.store %c0_i64_1 to %3 : !fir.ref<i64>
+// CHECK: %c0 = arith.constant 0 : index
+// CHECK: %30 = fir.coordinate_of %1, %c0 : (!fir.ref<!fir.array<1xi64>>, index) -> !fir.ref<i64>
+// CHECK: fir.store %c2_i64 to %30 : !fir.ref<i64>
+// CHECK: %31 = fir.embox %1 : (!fir.ref<!fir.array<1xi64>>) -> !fir.box<!fir.array<1xi64>>
+// CHECK: %32 = fir.absent !fir.ref<i32>
+// CHECK: %33 = fir.convert %31 : (!fir.box<!fir.array<1xi64>>) -> !fir.box<!fir.array<?xi64>>
+// CHECK: fir.call @_QMprifPprif_initial_team_index(%27, %33, %2, %32) : (!fir.box<none>, !fir.box<!fir.array<?xi64>>, !fir.ref<i32>, !fir.ref<i32>) -> ()
+// CHECK: %34 = fir.embox %9 : (!fir.ref<f32>) -> !fir.box<f32>
+// CHECK: fir.store %34 to %0 : !fir.ref<!fir.box<f32>>
+// CHECK: %35 = fir.convert %0 : (!fir.ref<!fir.box<f32>>) -> !fir.ptr<none>
+// CHECK: fir.call @_QMprifPprif_put(%2, %27, %3, %35, %4, %28, %29, %29) : (!fir.ref<i32>, !fir.box<none>, !fir.ref<i64>, !fir.ptr<none>, !fir.ref<i64>, !fir.ref<i32>, !fir.box<!fir.char<1,?>>, !fir.box<!fir.char<1,?>>) -> ()
+
+// CHECK-LABEL: func.func @_QPtest_coarray_put_array() {
+// CHECK: %0 = fir.alloca !fir.box<i32>
+// CHECK: %1 = fir.alloca !fir.array<1xi64>
+// CHECK: %2 = fir.alloca i32
+// CHECK: %3 = fir.alloca i64
+// CHECK: %4 = fir.alloca i64
+// CHECK: %5 = fir.alloca !fir.box<!fir.array<3x4xi32>>
+// CHECK: %6 = fir.alloca i32
+// CHECK: %7 = fir.alloca i64
+// CHECK: %8 = fir.alloca i64
+// CHECK: %9 = fir.alloca i32
+// CHECK: %10 = fir.alloca i32
+// CHECK: %11 = fir.dummy_scope : !fir.dscope
+// CHECK: %12 = fir.address_of(@_QFtest_coarray_put_arrayEa) : !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>
+// CHECK: %13:2 = hlfir.declare %12 {uniq_name = "_QFtest_coarray_put_arrayEa"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>, !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>)
+// CHECK: %14 = fir.alloca i32 {bindc_name = "me", uniq_name = "_QFtest_coarray_put_arrayEme"}
+// CHECK: %15:2 = hlfir.declare %14 {uniq_name = "_QFtest_coarray_put_arrayEme"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+// CHECK: %16 = fir.absent !fir.box<none>
+// CHECK: fir.call @_QMprifPprif_this_image_no_coarray(%16, %9) : (!fir.box<none>, !fir.ref<i32>) -> ()
+// CHECK: %17 = fir.load %9 : !fir.ref<i32>
+// CHECK: hlfir.assign %17 to %15#0 : i32, !fir.ref<i32>
+// CHECK: %18 = fir.load %15#0 : !fir.ref<i32>
+// CHECK: %c1_i32 = arith.constant 1 : i32
+// CHECK: %19 = arith.cmpi eq, %18, %c1_i32 : i32
+// CHECK: fir.if %19 {
+// CHECK: %20 = fir.address_of(@_QQro.3x4xi4.0) : !fir.ref<!fir.array<3x4xi32>>
+// CHECK: %c3 = arith.constant 3 : index
+// CHECK: %c4 = arith.constant 4 : index
+// CHECK: %21 = fir.shape %c3, %c4 : (index, index) -> !fir.shape<2>
+// CHECK: %22:2 = hlfir.declare %20(%21) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x4xi4.0"} : (!fir.ref<!fir.array<3x4xi32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<3x4xi32>>, !fir.ref<!fir.array<3x4xi32>>)
+// CHECK: %23 = fir.load %13#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>
+// CHECK: %24 = fir.box_elesize %23 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>) -> i64
+// CHECK: %c12_i64 = arith.constant 12 : i64
+// CHECK: %25 = arith.muli %24, %c12_i64 : i64
+// CHECK: fir.store %25 to %8 : !fir.ref<i64>
+// CHECK: %26 = fir.address_of(@_QFtest_coarray_put_arrayEa_coarray_handle) : !fir.ref<!fir.box<none>>
+// CHECK: %27 = fir.load %26 : !fir.ref<!fir.box<none>>
+// CHECK: %28 = fir.absent !fir.ref<i32>
+// CHECK: %29 = fir.absent !fir.box<!fir.char<1,?>>
+// CHECK: %c0_i64 = arith.constant 0 : i64
+// CHECK: fir.store %c0_i64 to %7 : !fir.ref<i64>
+// CHECK: %30 = fir.absent !fir.box<none>
+// CHECK: fir.call @_QMprifPprif_this_image_no_coarray(%30, %6) : (!fir.box<none>, !fir.ref<i32>) -> ()
+// CHECK: %31 = fir.embox %22#0(%21) : (!fir.ref<!fir.array<3x4xi32>>, !fir.shape<2>) -> !fir.box<!fir.array<3x4xi32>>
+// CHECK: fir.store %31 to %5 : !fir.ref<!fir.box<!fir.array<3x4xi32>>>
+// CHECK: %32 = fir.convert %5 : (!fir.ref<!fir.box<!fir.array<3x4xi32>>>) -> !fir.ptr<none>
+// CHECK: fir.call @_QMprifPprif_put(%6, %27, %7, %32, %8, %28, %29, %29) : (!fir.ref<i32>, !fir.box<none>, !fir.ref<i64>, !fir.ptr<none>, !fir.ref<i64>, !fir.ref<i32>, !fir.box<!fir.char<1,?>>, !fir.box<!fir.char<1,?>>) -> ()
+// CHECK: } else {
+// CHECK: %20 = fir.load %13#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>
+// CHECK: %c2 = arith.constant 2 : index
+// CHECK: %c3 = arith.constant 3 : index
+// CHECK: %21 = hlfir.designate %20 (%c2, %c3) : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index, index) -> !fir.ref<i32>
+// CHECK: %c2_i32 = arith.constant 2 : i32
+// CHECK: fir.store %c2_i32 to %10 : !fir.ref<i32>
+// CHECK: %c2_i64 = arith.constant 2 : i64
+// CHECK: %c4_i64 = arith.constant 4 : i64
+// CHECK: fir.store %c4_i64 to %4 : !fir.ref<i64>
+// CHECK: %22 = fir.address_of(@_QFtest_coarray_put_arrayEa_coarray_handle) : !fir.ref<!fir.box<none>>
+// CHECK: %23 = fir.load %22 : !fir.ref<!fir.box<none>>
+// CHECK: %24 = fir.absent !fir.ref<i32>
+// CHECK: %25 = fir.absent !fir.box<!fir.char<1,?>>
+// CHECK: %c0_i64 = arith.constant 0 : i64
+// CHECK: fir.store %c0_i64 to %3 : !fir.ref<i64>
+// CHECK: %c0 = arith.constant 0 : index
+// CHECK: %26 = fir.coordinate_of %1, %c0 : (!fir.ref<!fir.array<1xi64>>, index) -> !fir.ref<i64>
+// CHECK: fir.store %c2_i64 to %26 : !fir.ref<i64>
+// CHECK: %27 = fir.embox %1 : (!fir.ref<!fir.array<1xi64>>) -> !fir.box<!fir.array<1xi64>>
+// CHECK: %28 = fir.absent !fir.ref<i32>
+// CHECK: %29 = fir.convert %27 : (!fir.box<!fir.array<1xi64>>) -> !fir.box<!fir.array<?xi64>>
+// CHECK: fir.call @_QMprifPprif_initial_team_index(%23, %29, %2, %28) : (!fir.box<none>, !fir.box<!fir.array<?xi64>>, !fir.ref<i32>, !fir.ref<i32>) -> ()
+// CHECK: %30 = fir.embox %10 : (!fir.ref<i32>) -> !fir.box<i32>
+// CHECK: fir.store %30 to %0 : !fir.ref<!fir.box<i32>>
+// CHECK: %31 = fir.convert %0 : (!fir.ref<!fir.box<i32>>) -> !fir.ptr<none>
+// CHECK: fir.call @_QMprifPprif_put(%2, %23, %3, %31, %4, %24, %25, %25) : (!fir.ref<i32>, !fir.box<none>, !fir.ref<i64>, !fir.ptr<none>, !fir.ref<i64>, !fir.ref<i32>, !fir.box<!fir.char<1,?>>, !fir.box<!fir.char<1,?>>) -> ()
+// CHECK: }
diff --git a/flang/test/Fir/MIF/coarray_put2.mlir b/flang/test/Fir/MIF/coarray_put2.mlir
new file mode 100644
index 0000000000000..9f17808b04955
--- /dev/null
+++ b/flang/test/Fir/MIF/coarray_put2.mlir
@@ -0,0 +1,53 @@
+// RUN: not fir-opt --mif-convert %s 2>&1 | FileCheck %s
+
+// CHECK: not yet implemented: coarray: put operation with strides
+
+func.func @_QPtest_coarray_get_array() {
+ %0 = fir.dummy_scope : !fir.dscope
+ %1 = fir.address_of(@_QFtest_coarray_get_arrayEa) : !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>
+ %2:2 = hlfir.declare %1 {uniq_name = "_QFtest_coarray_get_arrayEa"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>, !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>)
+ %3 = fir.address_of(@_QFtest_coarray_get_arrayEb) : !fir.ref<!fir.array<3x4xi32>>
+ %c3 = arith.constant 3 : index
+ %c4 = arith.constant 4 : index
+ %4 = fir.shape %c3, %c4 : (index, index) -> !fir.shape<2>
+ %5:2 = hlfir.declare %3(%4) {uniq_name = "_QFtest_coarray_get_arrayEb"} : (!fir.ref<!fir.array<3x4xi32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<3x4xi32>>, !fir.ref<!fir.array<3x4xi32>>)
+ %6 = fir.alloca i32 {bindc_name = "me", uniq_name = "_QFtest_coarray_get_arrayEme"}
+ %7:2 = hlfir.declare %6 {uniq_name = "_QFtest_coarray_get_arrayEme"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ %8 = mif.this_image : () -> i32
+ hlfir.assign %8 to %7#0 : i32, !fir.ref<i32>
+ %9 = fir.load %7#0 : !fir.ref<i32>
+ %c1_i32 = arith.constant 1 : i32
+ %10 = arith.cmpi eq, %9, %c1_i32 : i32
+ fir.if %10 {
+ %11 = fir.address_of(@_QQro.3x4xi4.0) : !fir.ref<!fir.array<3x4xi32>>
+ %c3_0 = arith.constant 3 : index
+ %c4_1 = arith.constant 4 : index
+ %12 = fir.shape %c3_0, %c4_1 : (index, index) -> !fir.shape<2>
+ %13:2 = hlfir.declare %11(%12) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x4xi4.0"} : (!fir.ref<!fir.array<3x4xi32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<3x4xi32>>, !fir.ref<!fir.array<3x4xi32>>)
+ mif.put_coarray from %13#0 to %2#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>, !fir.ref<!fir.array<3x4xi32>>) -> ()
+ } else {
+ %11 = fir.load %2#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>
+ %c0 = arith.constant 0 : index
+ %12:3 = fir.box_dims %11, %c0 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index) -> (index, index, index)
+ %c1 = arith.constant 1 : index
+ %13:3 = fir.box_dims %11, %c1 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index) -> (index, index, index)
+ %c1_0 = arith.constant 1 : index
+ %c0_1 = arith.constant 0 : index
+ %14:3 = fir.box_dims %11, %c0_1 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index) -> (index, index, index)
+ %15 = arith.addi %12#0, %14#1 : index
+ %16 = arith.subi %15, %c1_0 : index
+ %c1_2 = arith.constant 1 : index
+ %17:3 = fir.box_dims %11, %c1_2 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index) -> (index, index, index)
+ %18 = arith.addi %13#0, %17#1 : index
+ %19 = arith.subi %18, %c1_0 : index
+ %c1_3 = arith.constant 1 : index
+ %c3_4 = arith.constant 3 : index
+ %c1_5 = arith.constant 1 : index
+ %c4_6 = arith.constant 4 : index
+ %20 = fir.shape %c3_4, %c4_6 : (index, index) -> !fir.shape<2>
+ %21 = hlfir.designate %11 (%12#0:%16:%c1_3, %13#0:%19:%c1_5) shape %20 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index, index, index, index, index, index, !fir.shape<2>) -> !fir.ref<!fir.array<3x4xi32>>
+ %c1_i64 = arith.constant 1 : i64
+ mif.put_coarray from %5#0 to %21[%c1_i64] : (!fir.ref<!fir.array<3x4xi32>>, i64, !fir.ref<!fir.array<3x4xi32>>) -> ()
+ }
+ return
+}
diff --git a/flang/test/Lower/MIF/coarray_get.f90 b/flang/test/Lower/MIF/coarray_get.f90
new file mode 100644
index 0000000000000..fd85fd5e75ff1
--- /dev/null
+++ b/flang/test/Lower/MIF/coarray_get.f90
@@ -0,0 +1,82 @@
+
+! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPtest_coarray_get_scalar
+subroutine test_coarray_get_scalar
+ real, save :: a[*]
+ real :: b
+ b = 2
+ b = a[2]
+ ! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope
+ ! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QFtest_coarray_get_scalarEa) : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+ ! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QFtest_coarray_get_scalarEa"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>, !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>)
+ ! CHECK: %[[VAL_3:.*]] = fir.alloca f32 {bindc_name = "b", uniq_name = "_QFtest_coarray_get_scalarEb"}
+ ! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %3 {uniq_name = "_QFtest_coarray_get_scalarEb"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+ ! CHECK: %cst = arith.constant 2.000000e+00 : f32
+ ! CHECK: hlfir.assign %cst to %4#0 : f32, !fir.ref<f32>
+ ! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+ ! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_5]] : (!fir.box<!fir.heap<f32>, corank:1>) -> !fir.heap<f32>
+ ! CHECK: %[[VAL_7:.*]] = hlfir.designate %[[VAL_6]] : (!fir.heap<f32>) -> !fir.ref<f32>
+ ! CHECK: %c2_i64 = arith.constant 2 : i64
+ ! CHECK: mif.get_coarray from %[[VAL_7]][%c2_i64] to %[[VAL_4]]#0 : (!fir.ref<f32>, i64, !fir.ref<f32>) -> ()
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_coarray_get_array
+subroutine test_coarray_get_array
+ integer :: me
+ integer, save :: a(3,4)[*], b(3,4)
+
+ me = this_image()
+ if (me == 1) then
+ a = reshape([4, 2, 7, 1, 2, 4, 5, 23, 25, 78, 54, 63], [3,4])
+ else
+ b = a(:,:)[1]
+ endif
+ ! CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope
+ ! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QFtest_coarray_get_arrayEa) : !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>
+ ! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QFtest_coarray_get_arrayEa"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>, !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>)
+ ! CHECK: %[[VAL_3:.*]] = fir.address_of(@_QFtest_coarray_get_arrayEb) : !fir.ref<!fir.array<3x4xi32>>
+ ! CHECK: %c3 = arith.constant 3 : index
+ ! CHECK: %c4 = arith.constant 4 : index
+ ! CHECK: %[[VAL_4:.*]] = fir.shape %c3, %c4 : (index, index) -> !fir.shape<2>
+ ! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_4]]) {uniq_name = "_QFtest_coarray_get_arrayEb"} : (!fir.ref<!fir.array<3x4xi32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<3x4xi32>>, !fir.ref<!fir.array<3x4xi32>>)
+ ! CHECK: %[[VAL_6:.*]] = fir.alloca i32 {bindc_name = "me", uniq_name = "_QFtest_coarray_get_arrayEme"}
+ ! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_6]] {uniq_name = "_QFtest_coarray_get_arrayEme"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ ! CHECK: %[[VAL_8:.*]] = mif.this_image : () -> i32
+ ! CHECK: hlfir.assign %[[VAL_8]] to %[[VAL_7]]#0 : i32, !fir.ref<i32>
+ ! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_7]]#0 : !fir.ref<i32>
+ ! CHECK: %c1_i32 = arith.constant 1 : i32
+ ! CHECK: %[[VAL_10:.*]] = arith.cmpi eq, %[[VAL_9]], %c1_i32 : i32
+ ! CHECK: fir.if %[[VAL_10]] {
+ ! CHECK: %[[VAL_11:.*]] = fir.address_of(@_QQro.3x4xi4.0) : !fir.ref<!fir.array<3x4xi32>>
+ ! CHECK: %c3_0 = arith.constant 3 : index
+ ! CHECK: %c4_1 = arith.constant 4 : index
+ ! CHECK: %[[VAL_12:.*]] = fir.shape %c3_0, %c4_1 : (index, index) -> !fir.shape<2>
+ ! CHECK: %[[VAL_13:.*]]:2 = hlfir.declare %[[VAL_11]](%[[VAL_12]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x4xi4.0"} : (!fir.ref<!fir.array<3x4xi32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<3x4xi32>>, !fir.ref<!fir.array<3x4xi32>>)
+ ! CHECK: mif.put_coarray from %[[VAL_13]]#0 to %[[VAL_2]]#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>, !fir.ref<!fir.array<3x4xi32>>) -> ()
+ ! CHECK: } else {
+ ! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>
+ ! CHECK: %c0 = arith.constant 0 : index
+ ! CHECK: %[[VAL_12:.*]]:3 = fir.box_dims %[[VAL_11]], %c0 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index) -> (index, index, index)
+ ! CHECK: %c1 = arith.constant 1 : index
+ ! CHECK: %[[VAL_13:.*]]:3 = fir.box_dims %[[VAL_11]], %c1 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index) -> (index, index, index)
+ ! CHECK: %c1_0 = arith.constant 1 : index
+ ! CHECK: %c0_1 = arith.constant 0 : index
+ ! CHECK: %[[VAL_14:.*]]:3 = fir.box_dims %[[VAL_11]], %c0_1 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index) -> (index, index, index)
+ ! CHECK: %[[VAL_15:.*]] = arith.addi %[[VAL_12]]#0, %[[VAL_14]]#1 : index
+ ! CHECK: %[[VAL_16:.*]] = arith.subi %[[VAL_15]], %c1_0 : index
+ ! CHECK: %c1_2 = arith.constant 1 : index
+ ! CHECK: %[[VAL_17:.*]]:3 = fir.box_dims %[[VAL_11]], %c1_2 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index) -> (index, index, index)
+ ! CHECK: %[[VAL_18:.*]] = arith.addi %[[VAL_13]]#0, %[[VAL_17]]#1 : index
+ ! CHECK: %[[VAL_19:.*]] = arith.subi %[[VAL_18]], %c1_0 : index
+ ! CHECK: %c1_3 = arith.constant 1 : index
+ ! CHECK: %c3_4 = arith.constant 3 : index
+ ! CHECK: %c1_5 = arith.constant 1 : index
+ ! CHECK: %c4_6 = arith.constant 4 : index
+ ! CHECK: %[[VAL_20:.*]] = fir.shape %c3_4, %c4_6 : (index, index) -> !fir.shape<2>
+ ! CHECK: %[[VAL_21:.*]] = hlfir.designate %[[VAL_11]] (%[[VAL_12]]#0:%[[VAL_16]]:%c1_3, %[[VAL_13]]#0:%[[VAL_19]]:%c1_5) shape %20 : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index, index, index, index, index, index, !fir.shape<2>) -> !fir.ref<!fir.array<3x4xi32>>
+ ! CHECK: %c1_i64 = arith.constant 1 : i64
+ ! CHECK: mif.get_coarray from %[[VAL_21]][%c1_i64] to %[[VAL_5]]#0 : (!fir.ref<!fir.array<3x4xi32>>, i64, !fir.ref<!fir.array<3x4xi32>>) -> ()
+ ! CHECK: }
+end subroutine
+
diff --git a/flang/test/Lower/MIF/coarray_put.f90 b/flang/test/Lower/MIF/coarray_put.f90
new file mode 100644
index 0000000000000..f4c624ff44483
--- /dev/null
+++ b/flang/test/Lower/MIF/coarray_put.f90
@@ -0,0 +1,65 @@
+! RUN: %flang_fc1 -emit-hlfir -fcoarray %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPtest_coarray_put_scalar
+subroutine test_coarray_put_scalar
+ real, save :: a[*]
+ a = 2
+ a[2] = 3
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca f32
+ ! CHECK: %[[VAL_1:.*]] = fir.alloca f32
+ ! CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope
+ ! CHECK: %[[VAL_3:.*]] = fir.address_of(@_QFtest_coarray_put_scalarEa) : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+ ! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] {uniq_name = "_QFtest_coarray_put_scalarEa"} : (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>, !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>)
+ ! CHECK: %cst = arith.constant 2.000000e+00 : f32
+ ! CHECK: fir.store %cst to %[[VAL_1]] : !fir.ref<f32>
+ ! CHECK: mif.put_coarray from %[[VAL_1]] to %[[VAL_4]]#0 : (!fir.ref<!fir.box<!fir.heap<f32>, corank:1>>, !fir.ref<f32>) -> ()
+ ! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_4]]#0 : !fir.ref<!fir.box<!fir.heap<f32>, corank:1>>
+ ! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_5]] : (!fir.box<!fir.heap<f32>, corank:1>) -> !fir.heap<f32>
+ ! CHECK: %[[VAL_7:.*]] = hlfir.designate %[[VAL_6]] : (!fir.heap<f32>) -> !fir.ref<f32>
+ ! CHECK: %cst_0 = arith.constant 3.000000e+00 : f32
+ ! CHECK: fir.store %cst_0 to %[[VAL_0]] : !fir.ref<f32>
+ ! CHECK: %c2_i64 = arith.constant 2 : i64
+ ! CHECK: mif.put_coarray from %[[VAL_0]] to %[[VAL_7]][%c2_i64] : (!fir.ref<f32>, i64, !fir.ref<f32>) -> ()
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_coarray_put_array
+subroutine test_coarray_put_array
+ integer :: me
+ integer, save :: a(3,4)[*]
+
+ me = this_image()
+ if (me == 1) then
+ a = reshape([4, 2, 7, 1, 2, 4, 5, 23, 25, 78, 54, 63], [3,4])
+ else
+ a(2,3)[2] = 2
+ endif
+ ! CHECK: %[[VAL_0:.*]] = fir.alloca i32
+ ! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
+ ! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QFtest_coarray_put_arrayEa) : !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>
+ ! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_2]] {uniq_name = "_QFtest_coarray_put_arrayEa"} : (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>) -> (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>, !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>)
+ ! CHECK: %[[VAL_4:.*]] = fir.alloca i32 {bindc_name = "me", uniq_name = "_QFtest_coarray_put_arrayEme"}
+ ! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] {uniq_name = "_QFtest_coarray_put_arrayEme"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+ ! CHECK: %[[VAL_6:.*]] = mif.this_image : () -> i32
+ ! CHECK: hlfir.assign %[[VAL_6]] to %[[VAL_5]]#0 : i32, !fir.ref<i32>
+ ! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_5]]#0 : !fir.ref<i32>
+ ! CHECK: %c1_i32 = arith.constant 1 : i32
+ ! CHECK: %[[VAL_8:.*]] = arith.cmpi eq, %[[VAL_7]], %c1_i32 : i32
+ ! CHECK: fir.if %[[VAL_8]] {
+ ! CHECK: %[[VAL_9:.*]] = fir.address_of(@_QQro.3x4xi4.0) : !fir.ref<!fir.array<3x4xi32>>
+ ! CHECK: %c3 = arith.constant 3 : index
+ ! CHECK: %c4 = arith.constant 4 : index
+ ! CHECK: %[[VAL_10:.*]] = fir.shape %c3, %c4 : (index, index) -> !fir.shape<2>
+ ! CHECK: %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_9]](%[[VAL_10]]) {fortran_attrs = #fir.var_attrs<parameter>, uniq_name = "_QQro.3x4xi4.0"} : (!fir.ref<!fir.array<3x4xi32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<3x4xi32>>, !fir.ref<!fir.array<3x4xi32>>)
+ ! CHECK: mif.put_coarray from %[[VAL_11]]#0 to %[[VAL_3]]#0 : (!fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>, !fir.ref<!fir.array<3x4xi32>>) -> ()
+ ! CHECK: } else {
+ ! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>>
+ ! CHECK: %c2 = arith.constant 2 : index
+ ! CHECK: %c3 = arith.constant 3 : index
+ ! CHECK: %[[VAL_10:.*]] = hlfir.designate %[[VAL_9]] (%c2, %c3) : (!fir.box<!fir.heap<!fir.array<3x4xi32>>, corank:1>, index, index) -> !fir.ref<i32>
+ ! CHECK: %c2_i32 = arith.constant 2 : i32
+ ! CHECK: fir.store %c2_i32 to %[[VAL_0]] : !fir.ref<i32>
+ ! CHECK: %c2_i64 = arith.constant 2 : i64
+ ! CHECK: mif.put_coarray from %[[VAL_0]] to %[[VAL_10]][%c2_i64] : (!fir.ref<i32>, i64, !fir.ref<i32>) -> ()
+ ! CHECK: }
+
+end subroutine
More information about the flang-commits
mailing list