Skip to content

[flang] lower assumed-rank variables specification expressions #93477

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
May 29, 2024
Merged

[flang] lower assumed-rank variables specification expressions #93477

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
33 changes: 28 additions & 5 deletions flang/lib/Lower/ConvertVariable.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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;
Expand All @@ -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;
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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);
Expand All @@ -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);
Expand Down
70 changes: 70 additions & 0 deletions flang/test/Lower/HLFIR/convert-variable-assumed-rank.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
Loading