[flang] lower assumed-ranks captured in internal procedures #96106
Conversation
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
llvmbot
added
flang
|
@llvm/pr-subscribers-flang-fir-hlfir Author: None (jeanPerier) ChangesFull diff: https://github.com/llvm/llvm-project/pull/96106.diff 4 Files Affected:
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/Lower/HostAssociations.cpp b/flang/lib/Lower/HostAssociations.cpp
index 75a5bed566557..0f75a8a7c312e 100644
--- a/flang/lib/Lower/HostAssociations.cpp
+++ b/flang/lib/Lower/HostAssociations.cpp
@@ -366,7 +366,8 @@ class CapturedAllocatableAndPointer
}
};
-/// Class defining how arrays are captured inside internal procedures.
+/// Class defining how arrays, including assumed-ranks, are captured inside
+/// internal procedures.
/// Array are captured via a `fir.box<fir.array<T>>` descriptor that belongs to
/// the host tuple. This allows capturing lower bounds, which can be done by
/// providing a ShapeShiftOp argument to the EmboxOp.
@@ -430,7 +431,7 @@ class CapturedArrays : public CapturedSymbols<CapturedArrays> {
mlir::Value box = args.valueInTuple;
mlir::IndexType idxTy = builder.getIndexType();
llvm::SmallVector<mlir::Value> lbounds;
- if (!ba.lboundIsAllOnes()) {
+ if (!ba.lboundIsAllOnes() && !Fortran::evaluate::IsAssumedRank(sym)) {
if (ba.isStaticArray()) {
for (std::int64_t lb : ba.staticLBound())
lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, lb));
@@ -488,7 +489,8 @@ class CapturedArrays : public CapturedSymbols<CapturedArrays> {
const Fortran::semantics::DeclTypeSpec *type = sym.GetType();
bool isPolymorphic = type && type->IsPolymorphic();
return isScalarOrContiguous && !isPolymorphic &&
- !isDerivedWithLenParameters(sym);
+ !isDerivedWithLenParameters(sym) &&
+ !Fortran::evaluate::IsAssumedRank(sym);
}
};
} // namespace
@@ -514,7 +516,7 @@ walkCaptureCategories(T visitor, Fortran::lower::AbstractConverter &converter,
if (Fortran::semantics::IsAllocatableOrPointer(sym) ||
sym.GetUltimate().test(Fortran::semantics::Symbol::Flag::CrayPointee))
return CapturedAllocatableAndPointer::visit(visitor, converter, sym, ba);
- if (ba.isArray())
+ if (ba.isArray()) // include assumed-ranks.
return CapturedArrays::visit(visitor, converter, sym, ba);
if (Fortran::semantics::IsPolymorphic(sym))
return CapturedPolymorphicScalar::visit(visitor, converter, sym, ba);
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(
diff --git a/flang/test/Lower/HLFIR/assumed-rank-internal-proc.f90 b/flang/test/Lower/HLFIR/assumed-rank-internal-proc.f90
new file mode 100644
index 0000000000000..f8d5e84696c5f
--- /dev/null
+++ b/flang/test/Lower/HLFIR/assumed-rank-internal-proc.f90
@@ -0,0 +1,128 @@
+! Test assumed-rank capture inside internal procedures.
+! RUN: bbc -emit-hlfir -o - %s -allow-assumed-rank | FileCheck %s
+
+subroutine test_assumed_rank(x)
+ real :: x(..)
+interface
+subroutine some_sub(x)
+ real :: x(..)
+end subroutine
+end interface
+ call internal()
+contains
+subroutine internal()
+ call some_sub(x)
+end subroutine
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_assumed_rank(
+! 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_assumed_rankEx"} : (!fir.box<!fir.array<*:f32>>, !fir.dscope) -> (!fir.box<!fir.array<*:f32>>, !fir.box<!fir.array<*:f32>>)
+! CHECK: %[[VAL_3:.*]] = fir.alloca tuple<!fir.box<!fir.array<*:f32>>>
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_4]] : (!fir.ref<tuple<!fir.box<!fir.array<*:f32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<*:f32>>>
+! CHECK: %[[VAL_6:.*]] = fir.rebox_assumed_rank %[[VAL_2]]#0 lbs preserve : (!fir.box<!fir.array<*:f32>>) -> !fir.box<!fir.array<*:f32>>
+! CHECK: fir.store %[[VAL_6]] to %[[VAL_5]] : !fir.ref<!fir.box<!fir.array<*:f32>>>
+! CHECK: fir.call @_QFtest_assumed_rankPinternal(%[[VAL_3]]) fastmath<contract> : (!fir.ref<tuple<!fir.box<!fir.array<*:f32>>>>) -> ()
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func private @_QFtest_assumed_rankPinternal(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<tuple<!fir.box<!fir.array<*:f32>>>> {fir.host_assoc})
+! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK: %[[VAL_2:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref<tuple<!fir.box<!fir.array<*:f32>>>>, i32) -> !fir.ref<!fir.box<!fir.array<*:f32>>>
+! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.box<!fir.array<*:f32>>>
+! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] {fortran_attrs = #fir.var_attrs<host_assoc>, uniq_name = "_QFtest_assumed_rankEx"} : (!fir.box<!fir.array<*:f32>>) -> (!fir.box<!fir.array<*:f32>>, !fir.box<!fir.array<*:f32>>)
+! CHECK: fir.call @_QPsome_sub(%[[VAL_5]]#0) fastmath<contract> : (!fir.box<!fir.array<*:f32>>) -> ()
+! CHECK: return
+! CHECK: }
+
+
+subroutine test_assumed_rank_optional(x)
+ class(*), optional :: x(..)
+interface
+subroutine some_sub2(x)
+ class(*) :: x(..)
+end subroutine
+end interface
+ call internal()
+contains
+subroutine internal()
+ call some_sub2(x)
+end subroutine
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_assumed_rank_optional(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.class<!fir.array<*:none>> {fir.bindc_name = "x", fir.optional}) {
+! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFtest_assumed_rank_optionalEx"} : (!fir.class<!fir.array<*:none>>, !fir.dscope) -> (!fir.class<!fir.array<*:none>>, !fir.class<!fir.array<*:none>>)
+! CHECK: %[[VAL_3:.*]] = fir.alloca tuple<!fir.class<!fir.array<*:none>>>
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_4]] : (!fir.ref<tuple<!fir.class<!fir.array<*:none>>>>, i32) -> !fir.ref<!fir.class<!fir.array<*:none>>>
+! CHECK: %[[VAL_6:.*]] = fir.is_present %[[VAL_2]]#0 : (!fir.class<!fir.array<*:none>>) -> i1
+! CHECK: fir.if %[[VAL_6]] {
+! CHECK: %[[VAL_7:.*]] = fir.rebox_assumed_rank %[[VAL_2]]#0 lbs preserve : (!fir.class<!fir.array<*:none>>) -> !fir.class<!fir.array<*:none>>
+! CHECK: fir.store %[[VAL_7]] to %[[VAL_5]] : !fir.ref<!fir.class<!fir.array<*:none>>>
+! CHECK: } else {
+! CHECK: %[[VAL_8:.*]] = fir.zero_bits !fir.ref<none>
+! CHECK: %[[VAL_9:.*]] = fir.embox %[[VAL_8]] : (!fir.ref<none>) -> !fir.class<none>
+! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (!fir.class<none>) -> !fir.class<!fir.array<*:none>>
+! CHECK: fir.store %[[VAL_10]] to %[[VAL_5]] : !fir.ref<!fir.class<!fir.array<*:none>>>
+! CHECK: }
+! CHECK: fir.call @_QFtest_assumed_rank_optionalPinternal(%[[VAL_3]]) fastmath<contract> : (!fir.ref<tuple<!fir.class<!fir.array<*:none>>>>) -> ()
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func private @_QFtest_assumed_rank_optionalPinternal(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<tuple<!fir.class<!fir.array<*:none>>>> {fir.host_assoc})
+! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK: %[[VAL_2:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref<tuple<!fir.class<!fir.array<*:none>>>>, i32) -> !fir.ref<!fir.class<!fir.array<*:none>>>
+! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.class<!fir.array<*:none>>>
+! CHECK: %[[VAL_5:.*]] = fir.box_addr %[[VAL_4]] : (!fir.class<!fir.array<*:none>>) -> !fir.ref<!fir.array<*:none>>
+! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (!fir.ref<!fir.array<*:none>>) -> i64
+! CHECK: %[[VAL_7:.*]] = arith.constant 0 : i64
+! CHECK: %[[VAL_8:.*]] = arith.cmpi ne, %[[VAL_6]], %[[VAL_7]] : i64
+! CHECK: %[[VAL_9:.*]] = fir.absent !fir.class<!fir.array<*:none>>
+! CHECK: %[[VAL_10:.*]] = arith.select %[[VAL_8]], %[[VAL_4]], %[[VAL_9]] : !fir.class<!fir.array<*:none>>
+! CHECK: %[[VAL_11:.*]]:2 = hlfir.declare %[[VAL_10]] {fortran_attrs = #fir.var_attrs<optional, host_assoc>, uniq_name = "_QFtest_assumed_rank_optionalEx"} : (!fir.class<!fir.array<*:none>>) -> (!fir.class<!fir.array<*:none>>, !fir.class<!fir.array<*:none>>)
+! CHECK: fir.call @_QPsome_sub2(%[[VAL_11]]#0) fastmath<contract> : (!fir.class<!fir.array<*:none>>) -> ()
+! CHECK: return
+! CHECK: }
+
+
+subroutine test_assumed_rank_ptr(x)
+ real, pointer :: x(..)
+interface
+subroutine some_sub3(x)
+ real, pointer :: x(..)
+end subroutine
+end interface
+ call internal()
+contains
+subroutine internal()
+ call some_sub3(x)
+end subroutine
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_assumed_rank_ptr(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!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]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_assumed_rank_ptrEx"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>, !fir.dscope) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>)
+! CHECK: %[[VAL_3:.*]] = fir.alloca tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>>
+! CHECK: %[[VAL_4:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_4]] : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>>
+! CHECK: fir.store %[[VAL_2]]#0 to %[[VAL_5]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>>
+! CHECK: fir.call @_QFtest_assumed_rank_ptrPinternal(%[[VAL_3]]) fastmath<contract> : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>>>) -> ()
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func private @_QFtest_assumed_rank_ptrPinternal(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>>> {fir.host_assoc})
+! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
+! CHECK: %[[VAL_2:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>>
+! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>>
+! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_4]] {fortran_attrs = #fir.var_attrs<pointer, host_assoc>, uniq_name = "_QFtest_assumed_rank_ptrEx"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>)
+! CHECK: fir.call @_QPsome_sub3(%[[VAL_5]]#0) fastmath<contract> : (!fir.ref<!fir.box<!fir.ptr<!fir.array<*:f32>>>>) -> ()
+! CHECK: return
+! CHECK: }
|
jeanPerier
added a commit
to jeanPerier/llvm-project
that referenced
this pull request
Jun 19, 2024
jeanPerier
force-pushed
the
jpr-assumed-rank-capture
branch
from
596f6f9
to
8370785
Compare
jeanPerier
added a commit
that referenced
this pull request
Jun 20, 2024
With `createUnallocatedBox` utility change from #96106 , 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).
AlexisPerry
pushed a commit
to llvm-project-tlp/llvm-project
that referenced
this pull request
Jul 9, 2024
Note: the added test fails because it needs the `associateMutableBox` change from llvm#96082. I will rebase this PR once the other is merged.
AlexisPerry
pushed a commit
to llvm-project-tlp/llvm-project
that referenced
this pull request
Jul 9, 2024
With `createUnallocatedBox` utility change from llvm#96106 , 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).
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
Note: the added test fails because it needs the
associateMutableBoxchange from #96082. I will rebase this PR once the other is merged.