[flang-commits] [flang] [flang] lower assumed-rank variables specification expressions (PR #93477)
via flang-commits
flang-commits at lists.llvm.org
Mon May 27 06:53:42 PDT 2024
https://github.com/jeanPerier created https://github.com/llvm/llvm-project/pull/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.
>From c78ac66dc45f2cded9091792023ada72ea5a8230 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Fri, 24 May 2024 07:05:41 -0700
Subject: [PATCH] [flang] lower assumed-rank variables specification
expressions
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.
---
flang/lib/Lower/ConvertVariable.cpp | 33 +++++++--
.../HLFIR/convert-variable-assumed-rank.f90 | 70 +++++++++++++++++++
2 files changed, 98 insertions(+), 5 deletions(-)
create mode 100644 flang/test/Lower/HLFIR/convert-variable-assumed-rank.f90
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 075d0634fd1ee..8e9c1d640c330 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -41,9 +41,15 @@
#include "flang/Optimizer/Support/Utils.h"
#include "flang/Semantics/runtime-type-info.h"
#include "flang/Semantics/tools.h"
+#include "llvm/Support/CommandLine.h"
#include "llvm/Support/Debug.h"
#include <optional>
+static llvm::cl::opt<bool> allowAssumedRank(
+ "allow-assumed-rank",
+ llvm::cl::desc("Enable assumed rank lowering - experimental"),
+ llvm::cl::init(false));
+
#define DEBUG_TYPE "flang-lower-variable"
/// Helper to lower a scalar expression using a specific symbol mapping.
@@ -1885,7 +1891,8 @@ void Fortran::lower::mapSymbolAttributes(
return;
}
- if (Fortran::evaluate::IsAssumedRank(sym))
+ const bool isAssumedRank = Fortran::evaluate::IsAssumedRank(sym);
+ if (isAssumedRank && !allowAssumedRank)
TODO(loc, "assumed-rank variable in procedure implemented in Fortran");
Fortran::lower::BoxAnalyzer ba;
@@ -1894,6 +1901,8 @@ void Fortran::lower::mapSymbolAttributes(
// First deal with pointers and allocatables, because their handling here
// is the same regardless of their rank.
if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
+ if (isAssumedRank)
+ TODO(loc, "assumed-rank pointer or allocatable");
// Get address of fir.box describing the entity.
// global
mlir::Value boxAlloc = preAlloc;
@@ -1942,7 +1951,7 @@ void Fortran::lower::mapSymbolAttributes(
if (mlir::Value len =
lowerExplicitCharLen(converter, loc, ba, symMap, stmtCtx))
explicitParams.push_back(len);
- if (sym.Rank() == 0) {
+ if (!isAssumedRank && sym.Rank() == 0) {
// Do not keep scalar characters as fir.box (even when optional).
// Lowering and FIR is not meant to deal with scalar characters as
// fir.box outside of calls.
@@ -1987,9 +1996,11 @@ void Fortran::lower::mapSymbolAttributes(
}
}
// TODO: derived type length parameters.
- lowerExplicitLowerBounds(converter, loc, ba, lbounds, symMap, stmtCtx);
- lowerExplicitExtents(converter, loc, ba, lbounds, explicitExtents, symMap,
- stmtCtx);
+ if (!isAssumedRank) {
+ lowerExplicitLowerBounds(converter, loc, ba, lbounds, symMap, stmtCtx);
+ lowerExplicitExtents(converter, loc, ba, lbounds, explicitExtents,
+ symMap, stmtCtx);
+ }
genBoxDeclare(converter, symMap, sym, dummyArg, lbounds, explicitParams,
explicitExtents, replace);
return;
@@ -2021,6 +2032,11 @@ 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);
@@ -2042,6 +2058,13 @@ void Fortran::lower::mapSymbolAttributes(
return false;
};
+ if (isAssumedRank) {
+ assert(isUnusedEntryDummy && "assumed rank must be pointers/allocatables "
+ "or descriptor dummy arguments");
+ genUnusedEntryPointBox();
+ return;
+ }
+
// Helper to generate scalars for the symbol properties.
auto genValue = [&](const Fortran::lower::SomeExpr &expr) {
return genScalarValue(converter, loc, expr, symMap, stmtCtx);
diff --git a/flang/test/Lower/HLFIR/convert-variable-assumed-rank.f90 b/flang/test/Lower/HLFIR/convert-variable-assumed-rank.f90
new file mode 100644
index 0000000000000..748c15be84496
--- /dev/null
+++ b/flang/test/Lower/HLFIR/convert-variable-assumed-rank.f90
@@ -0,0 +1,70 @@
+! Test lowering of assumed-rank variables
+! RUN: bbc -emit-hlfir %s -allow-assumed-rank -o - | FileCheck %s
+
+module assumed_rank_tests
+interface
+subroutine takes_real(x)
+ real :: x(..)
+end subroutine
+subroutine takes_char(x)
+ character(*) :: x(..)
+end subroutine
+end interface
+contains
+
+subroutine test_intrinsic(x)
+ real :: x(..)
+ call takes_real(x)
+end subroutine
+
+subroutine test_character_explicit_len(x, n)
+ integer(8) :: n
+ character(n) :: x(..)
+ call takes_char(x)
+end subroutine
+
+subroutine test_character_assumed_len(x)
+ character(*) :: x(..)
+ call takes_char(x)
+end subroutine
+
+subroutine test_with_attrs(x)
+ real, target, optional :: x(..)
+ call takes_real(x)
+end subroutine
+! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_intrinsic(
+! 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 = "_QMassumed_rank_testsFtest_intrinsicEx"} : (!fir.box<!fir.array<*:f32>>, !fir.dscope) -> (!fir.box<!fir.array<*:f32>>, !fir.box<!fir.array<*:f32>>)
+! CHECK: fir.call @_QPtakes_real(%[[VAL_2]]#0) fastmath<contract> : (!fir.box<!fir.array<*:f32>>) -> ()
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_character_explicit_len(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<*:!fir.char<1,?>>> {fir.bindc_name = "x"},
+! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<i64> {fir.bindc_name = "n"}) {
+! CHECK: %[[VAL_2:.*]] = fir.dummy_scope : !fir.dscope
+! 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>)
+! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<i64>
+! CHECK: %[[VAL_5:.*]] = arith.constant 0 : i64
+! CHECK: %[[VAL_6:.*]] = arith.cmpi sgt, %[[VAL_4]], %[[VAL_5]] : i64
+! CHECK: %[[VAL_7:.*]] = arith.select %[[VAL_6]], %[[VAL_4]], %[[VAL_5]] : i64
+! 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,?>>>)
+! CHECK: fir.call @_QPtakes_char(%[[VAL_8]]#0) fastmath<contract> : (!fir.box<!fir.array<*:!fir.char<1,?>>>) -> ()
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_character_assumed_len(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<*:!fir.char<1,?>>> {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 = "_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,?>>>)
+! CHECK: fir.call @_QPtakes_char(%[[VAL_2]]#0) fastmath<contract> : (!fir.box<!fir.array<*:!fir.char<1,?>>>) -> ()
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func @_QMassumed_rank_testsPtest_with_attrs(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.box<!fir.array<*:f32>> {fir.bindc_name = "x", fir.optional, fir.target}) {
+! 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, 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>>)
+! CHECK: fir.call @_QPtakes_real(%[[VAL_2]]#0) fastmath<contract> : (!fir.box<!fir.array<*:f32>>) -> ()
+end module
More information about the flang-commits
mailing list