[flang-commits] [flang] [flang] implement assumed-rank in ENTRY (PR #96111)
via flang-commits
flang-commits at lists.llvm.org
Wed Jun 19 13:21:26 PDT 2024
https://github.com/jeanPerier created https://github.com/llvm/llvm-project/pull/96111
Note: first commit is a `createUnallocatedBox` utility change part of #96106 that is also needed here.
With this utility change, the TODO for assumed-rank in entry can simply be lifted and test is added.
The key is that a unallocated assumed-rank descriptor is created with rank zero in the entry where an assumed-rank dummy from some other entry do not appear as a dummy (the symbol must still be mapped to some valid value because the symbol could be used in code that would be unreachable at runtime, but that the compiler must still generate).
>From a731abf60625f5a61aecb75a020b6dfd6a4bb2ca Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Wed, 19 Jun 2024 13:08:21 -0700
Subject: [PATCH 1/2] changes part of #96106 review
---
flang/lib/Lower/ConvertType.cpp | 7 ++++---
flang/lib/Optimizer/Builder/MutableBox.cpp | 20 +++++++++++++++++---
2 files changed, 21 insertions(+), 6 deletions(-)
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index f64f6c93541a3..a47fc99ea9f45 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -280,10 +280,11 @@ struct TypeBuilderImpl {
if (ultimate.IsObjectArray()) {
auto shapeExpr =
Fortran::evaluate::GetShape(converter.getFoldingContext(), ultimate);
- if (!shapeExpr)
- TODO(loc, "assumed rank symbol type");
fir::SequenceType::Shape shape;
- translateShape(shape, std::move(*shapeExpr));
+ // If there is no shapExpr, this is an assumed-rank, and the empty shape
+ // will build the desired fir.array<*:T> type.
+ if (shapeExpr)
+ translateShape(shape, std::move(*shapeExpr));
ty = fir::SequenceType::get(shape, ty);
}
if (Fortran::semantics::IsPointer(symbol))
diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp
index 16e543fe86a79..fb76928137020 100644
--- a/flang/lib/Optimizer/Builder/MutableBox.cpp
+++ b/flang/lib/Optimizer/Builder/MutableBox.cpp
@@ -329,7 +329,18 @@ class MutablePropertyWriter {
mlir::Value fir::factory::createUnallocatedBox(
fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type boxType,
mlir::ValueRange nonDeferredParams, mlir::Value typeSourceBox) {
- auto baseAddrType = mlir::dyn_cast<fir::BaseBoxType>(boxType).getEleTy();
+ auto baseBoxType = mlir::cast<fir::BaseBoxType>(boxType);
+ // Giving unallocated/disassociated status to assumed-rank POINTER/
+ // ALLOCATABLE is not directly possible to a Fortran user. But the
+ // compiler may need to create such temporary descriptor to deal with
+ // cases like ENTRY or host association. In such case, all that mater
+ // is that the base address is set to zero and the rank is set to
+ // some defined value. Hence, a scalar descriptor is created and
+ // cast to assumed-rank.
+ const bool isAssumedRank = baseBoxType.isAssumedRank();
+ if (isAssumedRank)
+ baseBoxType = baseBoxType.getBoxTypeWithNewShape(/*rank=*/0);
+ auto baseAddrType = baseBoxType.getEleTy();
if (!fir::isa_ref_type(baseAddrType))
baseAddrType = builder.getRefType(baseAddrType);
auto type = fir::unwrapRefType(baseAddrType);
@@ -361,8 +372,11 @@ mlir::Value fir::factory::createUnallocatedBox(
}
}
mlir::Value emptySlice;
- return builder.create<fir::EmboxOp>(loc, boxType, nullAddr, shape, emptySlice,
- lenParams, typeSourceBox);
+ auto embox = builder.create<fir::EmboxOp>(
+ loc, baseBoxType, nullAddr, shape, emptySlice, lenParams, typeSourceBox);
+ if (isAssumedRank)
+ return builder.createConvert(loc, boxType, embox);
+ return embox;
}
fir::MutableBoxValue fir::factory::createTempMutableBox(
>From 7d9eec8e3af67568ecb153e4a0d62251098a329a Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Wed, 19 Jun 2024 13:14:42 -0700
Subject: [PATCH 2/2] [flang] implement assumed-rank in ENTRY
---
flang/lib/Lower/ConvertVariable.cpp | 5 ----
flang/test/Lower/HLFIR/assumed-rank-entry.f90 | 28 +++++++++++++++++++
2 files changed, 28 insertions(+), 5 deletions(-)
create mode 100644 flang/test/Lower/HLFIR/assumed-rank-entry.f90
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 8c96123b14976..e5a71c5ec5b4a 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -2036,11 +2036,6 @@ void Fortran::lower::mapSymbolAttributes(
if (isUnusedEntryDummy) {
assert(!Fortran::semantics::IsAllocatableOrPointer(sym) &&
"handled above");
- // Need to add support for allocatable assumed-rank to use
- // logic below, or to simplify it and add codegen for fir.zero
- // !fir.box<> instead.
- if (isAssumedRank)
- TODO(loc, "assumed rank in ENTRY");
// The box is read right away because lowering code does not expect
// a non pointer/allocatable symbol to be mapped to a MutableBox.
mlir::Type ty = converter.genType(var);
diff --git a/flang/test/Lower/HLFIR/assumed-rank-entry.f90 b/flang/test/Lower/HLFIR/assumed-rank-entry.f90
new file mode 100644
index 0000000000000..9928f5459f71f
--- /dev/null
+++ b/flang/test/Lower/HLFIR/assumed-rank-entry.f90
@@ -0,0 +1,28 @@
+! Test assumed-rank dummy argument that is not present in
+! all ENTRY statements.
+! RUN: bbc -emit-hlfir -allow-assumed-rank -o - %s | FileCheck %s
+
+subroutine test_main_entry(x)
+ real :: x(..)
+ interface
+ subroutine some_proc(x)
+ real :: x(..)
+ end subroutine
+ end interface
+ call some_proc(x)
+entry test_alternate_entry()
+ call the_end()
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_main_entry(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<*:f32>> {fir.bindc_name = "x"}) {
+! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {uniq_name = "_QFtest_main_entryEx"} : (!fir.box<!fir.array<*:f32>>, !fir.dscope) -> (!fir.box<!fir.array<*:f32>>, !fir.box<!fir.array<*:f32>>)
+
+! CHECK-LABEL: func.func @_QPtest_alternate_entry() {
+! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<*:f32>>>
+! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.heap<f32>
+! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_1]] : (!fir.heap<f32>) -> !fir.box<!fir.heap<f32>>
+! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_2]] : (!fir.box<!fir.heap<f32>>) -> !fir.box<!fir.heap<!fir.array<*:f32>>>
+! CHECK: fir.store %[[VAL_3]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>>
+! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<*:f32>>>>
+! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] {uniq_name = "_QFtest_main_entryEx"} : (!fir.box<!fir.heap<!fir.array<*:f32>>>) -> (!fir.box<!fir.heap<!fir.array<*:f32>>>, !fir.box<!fir.heap<!fir.array<*:f32>>>)
More information about the flang-commits
mailing list