Skip to content

Commit 5aba0de

Browse files
jeanPerierjeanPerier
authored
[flang] lower assumed-rank variables specification expressions (#93477)
Enable lowering of assumed-ranks in specification parts under a debug flag. I am using a debug flag because many cryptic TODOs/issues may be hit until more support is added. The development should not take too long, so I want to stay away from the noise of adding an actual experimental flag to flang-new.
1 parent 850f30c commit 5aba0de

File tree

2 files changed

+98
-5
lines changed

2 files changed

+98
-5
lines changed

‎flang/lib/Lower/ConvertVariable.cpp

Lines changed: 28 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -41,9 +41,15 @@
4141
#include "flang/Optimizer/Support/Utils.h"
4242
#include "flang/Semantics/runtime-type-info.h"
4343
#include "flang/Semantics/tools.h"
44+
#include "llvm/Support/CommandLine.h"
4445
#include "llvm/Support/Debug.h"
4546
#include <optional>
4647

48+
static llvm::cl::opt<bool> allowAssumedRank(
49+
"allow-assumed-rank",
50+
llvm::cl::desc("Enable assumed rank lowering - experimental"),
51+
llvm::cl::init(false));
52+
4753
#define DEBUG_TYPE "flang-lower-variable"
4854

4955
/// Helper to lower a scalar expression using a specific symbol mapping.
@@ -1885,7 +1891,8 @@ void Fortran::lower::mapSymbolAttributes(
18851891
return;
18861892
}
18871893

1888-
if (Fortran::evaluate::IsAssumedRank(sym))
1894+
const bool isAssumedRank = Fortran::evaluate::IsAssumedRank(sym);
1895+
if (isAssumedRank && !allowAssumedRank)
18891896
TODO(loc, "assumed-rank variable in procedure implemented in Fortran");
18901897

18911898
Fortran::lower::BoxAnalyzer ba;
@@ -1894,6 +1901,8 @@ void Fortran::lower::mapSymbolAttributes(
18941901
// First deal with pointers and allocatables, because their handling here
18951902
// is the same regardless of their rank.
18961903
if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
1904+
if (isAssumedRank)
1905+
TODO(loc, "assumed-rank pointer or allocatable");
18971906
// Get address of fir.box describing the entity.
18981907
// global
18991908
mlir::Value boxAlloc = preAlloc;
@@ -1942,7 +1951,7 @@ void Fortran::lower::mapSymbolAttributes(
19421951
if (mlir::Value len =
19431952
lowerExplicitCharLen(converter, loc, ba, symMap, stmtCtx))
19441953
explicitParams.push_back(len);
1945-
if (sym.Rank() == 0) {
1954+
if (!isAssumedRank && sym.Rank() == 0) {
19461955
// Do not keep scalar characters as fir.box (even when optional).
19471956
// Lowering and FIR is not meant to deal with scalar characters as
19481957
// fir.box outside of calls.
@@ -1987,9 +1996,11 @@ void Fortran::lower::mapSymbolAttributes(
19871996
}
19881997
}
19891998
// TODO: derived type length parameters.
1990-
lowerExplicitLowerBounds(converter, loc, ba, lbounds, symMap, stmtCtx);
1991-
lowerExplicitExtents(converter, loc, ba, lbounds, explicitExtents, symMap,
1992-
stmtCtx);
1999+
if (!isAssumedRank) {
2000+
lowerExplicitLowerBounds(converter, loc, ba, lbounds, symMap, stmtCtx);
2001+
lowerExplicitExtents(converter, loc, ba, lbounds, explicitExtents,
2002+
symMap, stmtCtx);
2003+
}
19932004
genBoxDeclare(converter, symMap, sym, dummyArg, lbounds, explicitParams,
19942005
explicitExtents, replace);
19952006
return;
@@ -2021,6 +2032,11 @@ void Fortran::lower::mapSymbolAttributes(
20212032
if (isUnusedEntryDummy) {
20222033
assert(!Fortran::semantics::IsAllocatableOrPointer(sym) &&
20232034
"handled above");
2035+
// Need to add support for allocatable assumed-rank to use
2036+
// logic below, or to simplify it and add codegen for fir.zero
2037+
// !fir.box<> instead.
2038+
if (isAssumedRank)
2039+
TODO(loc, "assumed rank in ENTRY");
20242040
// The box is read right away because lowering code does not expect
20252041
// a non pointer/allocatable symbol to be mapped to a MutableBox.
20262042
mlir::Type ty = converter.genType(var);
@@ -2042,6 +2058,13 @@ void Fortran::lower::mapSymbolAttributes(
20422058
return false;
20432059
};
20442060

2061+
if (isAssumedRank) {
2062+
assert(isUnusedEntryDummy && "assumed rank must be pointers/allocatables "
2063+
"or descriptor dummy arguments");
2064+
genUnusedEntryPointBox();
2065+
return;
2066+
}
2067+
20452068
// Helper to generate scalars for the symbol properties.
20462069
auto genValue = [&](const Fortran::lower::SomeExpr &expr) {
20472070
return genScalarValue(converter, loc, expr, symMap, stmtCtx);

‎flang/test/Lower/HLFIR/convert-variable-assumed-rank.f90

Lines changed: 70 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,70 @@
1+
! Test lowering of assumed-rank variables
2+
! RUN: bbc -emit-hlfir %s -allow-assumed-rank -o - | FileCheck %s
3+
4+
module assumed_rank_tests
5+
interface
6+
subroutine takes_real(x)
7+
real :: x(..)
8+
end subroutine
9+
subroutine takes_char(x)
10+
character(*) :: x(..)
11+
end subroutine
12+
end interface
13+
contains
14+
15+
subroutine test_intrinsic(x)
16+
real :: x(..)
17+
call takes_real(x)
18+
end subroutine
19+
20+
subroutine test_character_explicit_len(x, n)
21+
integer(8) :: n
22+
character(n) :: x(..)
23+
call takes_char(x)
24+
end subroutine
25+
26+
subroutine test_character_assumed_len(x)
27+
character(*) :: x(..)
28+
call takes_char(x)
29+
end subroutine
30+
31+
subroutine test_with_attrs(x)
32+
real, target, optional :: x(..)
33+
call takes_real(x)
34+
end subroutine
35+
! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_intrinsic(
36+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<*:f32>> {fir.bindc_name = "x"}) {
37+
! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
38+
! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {uniq_name = "_QMassumed_rank_testsFtest_intrinsicEx"} : (!fir.box<!fir.array<*:f32>>, !fir.dscope) -> (!fir.box<!fir.array<*:f32>>, !fir.box<!fir.array<*:f32>>)
39+
! CHECK: fir.call @_QPtakes_real(%[[VAL_2]]#0) fastmath<contract> : (!fir.box<!fir.array<*:f32>>) -> ()
40+
! CHECK: return
41+
! CHECK: }
42+
43+
! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_character_explicit_len(
44+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<*:!fir.char<1,?>>> {fir.bindc_name = "x"},
45+
! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<i64> {fir.bindc_name = "n"}) {
46+
! CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope
47+
! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] dummy_scope %[[VAL_2]] {uniq_name = "_QMassumed_rank_testsFtest_character_explicit_lenEn"} : (!fir.ref<i64>, !fir.dscope) -> (!fir.ref<i64>, !fir.ref<i64>)
48+
! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<i64>
49+
! CHECK: %[[VAL_5:.*]] = arith.constant 0 : i64
50+
! CHECK: %[[VAL_6:.*]] = arith.cmpi sgt, %[[VAL_4]], %[[VAL_5]] : i64
51+
! CHECK: %[[VAL_7:.*]] = arith.select %[[VAL_6]], %[[VAL_4]], %[[VAL_5]] : i64
52+
! CHECK: %[[VAL_8:.*]]:2 = hlfir.declare %[[VAL_0]] typeparams %[[VAL_7]] dummy_scope %[[VAL_2]] {uniq_name = "_QMassumed_rank_testsFtest_character_explicit_lenEx"} : (!fir.box<!fir.array<*:!fir.char<1,?>>>, i64, !fir.dscope) -> (!fir.box<!fir.array<*:!fir.char<1,?>>>, !fir.box<!fir.array<*:!fir.char<1,?>>>)
53+
! CHECK: fir.call @_QPtakes_char(%[[VAL_8]]#0) fastmath<contract> : (!fir.box<!fir.array<*:!fir.char<1,?>>>) -> ()
54+
! CHECK: return
55+
! CHECK: }
56+
57+
! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_character_assumed_len(
58+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<*:!fir.char<1,?>>> {fir.bindc_name = "x"}) {
59+
! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
60+
! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {uniq_name = "_QMassumed_rank_testsFtest_character_assumed_lenEx"} : (!fir.box<!fir.array<*:!fir.char<1,?>>>, !fir.dscope) -> (!fir.box<!fir.array<*:!fir.char<1,?>>>, !fir.box<!fir.array<*:!fir.char<1,?>>>)
61+
! CHECK: fir.call @_QPtakes_char(%[[VAL_2]]#0) fastmath<contract> : (!fir.box<!fir.array<*:!fir.char<1,?>>>) -> ()
62+
! CHECK: return
63+
! CHECK: }
64+
65+
! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_with_attrs(
66+
! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<*:f32>> {fir.bindc_name = "x", fir.optional, fir.target}) {
67+
! CHECK: %[[VAL_1:.*]] = fir.dummy_scope : !fir.dscope
68+
! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] dummy_scope %[[VAL_1]] {fortran_attrs = #fir.var_attrs<optional, target>, uniq_name = "_QMassumed_rank_testsFtest_with_attrsEx"} : (!fir.box<!fir.array<*:f32>>, !fir.dscope) -> (!fir.box<!fir.array<*:f32>>, !fir.box<!fir.array<*:f32>>)
69+
! CHECK: fir.call @_QPtakes_real(%[[VAL_2]]#0) fastmath<contract> : (!fir.box<!fir.array<*:f32>>) -> ()
70+
end module

0 commit comments

Comments
 (0)