[flang-commits] [flang] 96d9df4 - [flang] Add test for allocatable on the callee side
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Tue Mar 1 13:58:42 PST 2022
Author: Valentin Clement
Date: 2022-03-01T22:58:34+01:00
New Revision: 96d9df4157af284d5dd50cec2f8214a16ac3d197
URL: https://github.com/llvm/llvm-project/commit/96d9df4157af284d5dd50cec2f8214a16ac3d197
DIFF: https://github.com/llvm/llvm-project/commit/96d9df4157af284d5dd50cec2f8214a16ac3d197.diff
LOG: [flang] Add test for allocatable on the callee side
This patch adds couple of tests for allocatable
on the callee side. Lowering for some missing underlying features
is added as well.
This patch is part of the upstreaming effort from fir-dev branch.
Depends on D120744
Reviewed By: PeteSteinfeld, schweitz
Differential Revision: https://reviews.llvm.org/D120746
Co-authored-by: Eric Schweitz <eschweitz at nvidia.com>
Co-authored-by: Jean Perier <jperier at nvidia.com>
Co-authored-by: V Donaldson <vdonaldson at nvidia.com>
Added:
flang/test/Lower/allocatable-callee.f90
Modified:
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertExpr.cpp
flang/lib/Lower/ConvertVariable.cpp
flang/lib/Optimizer/Builder/MutableBox.cpp
Removed:
################################################################################
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 2531db8ddf881..da00d7f2cc584 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -705,8 +705,9 @@ class Fortran::lower::CallInterfaceImpl {
}
// CHARACTER with compile time constant length.
if (cat == Fortran::common::TypeCategory::Character)
- TODO(interface.converter.getCurrentLocation(),
- "[translateDynamicType] Character");
+ if (std::optional<std::int64_t> constantLen =
+ toInt64(dynamicType.GetCharLength()))
+ return getConverter().genType(cat, dynamicType.kind(), {*constantLen});
// INTEGER, REAL, LOGICAL, COMPLEX, and CHARACTER with dynamic length.
return getConverter().genType(cat, dynamicType.kind());
}
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 66fc8fbd51565..d0dd4bbd558d6 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -430,7 +430,11 @@ class ScalarExprLowering {
/// one.
ExtValue gen(Fortran::semantics::SymbolRef sym) {
if (Fortran::lower::SymbolBox val = symMap.lookupSymbol(sym))
- return val.match([&val](auto &) { return val.toExtendedValue(); });
+ return val.match(
+ [&](const Fortran::lower::SymbolBox::PointerOrAllocatable &boxAddr) {
+ return fir::factory::genMutableBoxRead(builder, getLoc(), boxAddr);
+ },
+ [&val](auto &) { return val.toExtendedValue(); });
LLVM_DEBUG(llvm::dbgs()
<< "unknown symbol: " << sym << "\nmap: " << symMap << '\n');
fir::emitFatalError(getLoc(), "symbol is not mapped to any IR value");
@@ -1482,7 +1486,28 @@ class ScalarExprLowering {
if (arg.passBy == PassBy::BaseAddress) {
caller.placeInput(arg, fir::getBase(argAddr));
} else {
- TODO(loc, "procedureref PassBy::BoxChar");
+ assert(arg.passBy == PassBy::BoxChar);
+ auto helper = fir::factory::CharacterExprHelper{builder, loc};
+ auto boxChar = argAddr.match(
+ [&](const fir::CharBoxValue &x) { return helper.createEmbox(x); },
+ [&](const fir::CharArrayBoxValue &x) {
+ return helper.createEmbox(x);
+ },
+ [&](const auto &x) -> mlir::Value {
+ // Fortran allows an actual argument of a completely
diff erent
+ // type to be passed to a procedure expecting a CHARACTER in the
+ // dummy argument position. When this happens, the data pointer
+ // argument is simply assumed to point to CHARACTER data and the
+ // LEN argument used is garbage. Simulate this behavior by
+ // free-casting the base address to be a !fir.char reference and
+ // setting the LEN argument to undefined. What could go wrong?
+ auto dataPtr = fir::getBase(x);
+ assert(!dataPtr.getType().template isa<fir::BoxType>());
+ return builder.convertWithSemantics(
+ loc, argTy, dataPtr,
+ /*allowCharacterConversion=*/true);
+ });
+ caller.placeInput(arg, boxChar);
}
} else if (arg.passBy == PassBy::Box) {
// Before lowering to an address, handle the allocatable/pointer actual
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 7d5f188c490dc..46636bd26577c 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -646,6 +646,24 @@ static void lowerExplicitExtents(Fortran::lower::AbstractConverter &converter,
assert(result.empty() || result.size() == box.dynamicBound().size());
}
+/// Lower explicit character length if any. Return empty mlir::Value if no
+/// explicit length.
+static mlir::Value
+lowerExplicitCharLen(Fortran::lower::AbstractConverter &converter,
+ mlir::Location loc, const Fortran::lower::BoxAnalyzer &box,
+ Fortran::lower::SymMap &symMap,
+ Fortran::lower::StatementContext &stmtCtx) {
+ if (!box.isChar())
+ return mlir::Value{};
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ mlir::Type lenTy = builder.getCharacterLengthType();
+ if (llvm::Optional<int64_t> len = box.getCharLenConst())
+ return builder.createIntegerConstant(loc, lenTy, *len);
+ if (llvm::Optional<Fortran::lower::SomeExpr> lenExpr = box.getCharLenExpr())
+ return genScalarValue(converter, loc, *lenExpr, symMap, stmtCtx);
+ return mlir::Value{};
+}
+
/// Treat negative values as undefined. Assumed size arrays will return -1 from
/// the front end for example. Using negative values can produce hard to find
/// bugs much further along in the compilation.
@@ -694,7 +712,11 @@ void Fortran::lower::mapSymbolAttributes(
// Lower non deferred parameters.
llvm::SmallVector<mlir::Value> nonDeferredLenParams;
if (ba.isChar()) {
- TODO(loc, "mapSymbolAttributes allocatble or pointer char");
+ if (mlir::Value len =
+ lowerExplicitCharLen(converter, loc, ba, symMap, stmtCtx))
+ nonDeferredLenParams.push_back(len);
+ else if (Fortran::semantics::IsAssumedLengthCharacter(sym))
+ TODO(loc, "assumed length character allocatable");
} else if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType()) {
if (const Fortran::semantics::DerivedTypeSpec *derived =
declTy->AsDerived())
diff --git a/flang/lib/Optimizer/Builder/MutableBox.cpp b/flang/lib/Optimizer/Builder/MutableBox.cpp
index 5a761e41e45b3..5cb65461d0db8 100644
--- a/flang/lib/Optimizer/Builder/MutableBox.cpp
+++ b/flang/lib/Optimizer/Builder/MutableBox.cpp
@@ -104,8 +104,10 @@ class MutablePropertyReader {
/// Get base address of allocated/associated entity.
mlir::Value readBaseAddress() {
if (irBox) {
- auto heapOrPtrTy = box.getBoxTy().getEleTy();
- return builder.create<fir::BoxAddrOp>(loc, heapOrPtrTy, irBox);
+ auto memrefTy = box.getBoxTy().getEleTy();
+ if (!fir::isa_ref_type(memrefTy))
+ memrefTy = builder.getRefType(memrefTy);
+ return builder.create<fir::BoxAddrOp>(loc, memrefTy, irBox);
}
auto addrVar = box.getMutableProperties().addr;
return builder.create<fir::LoadOp>(loc, addrVar);
@@ -144,7 +146,7 @@ class MutablePropertyReader {
/// also read into it.
llvm::SmallVector<mlir::Value>
readShape(llvm::SmallVectorImpl<mlir::Value> *lbounds = nullptr) {
- llvm::SmallVector<mlir::Value> extents(box.rank());
+ llvm::SmallVector<mlir::Value> extents;
auto rank = box.rank();
for (decltype(rank) dim = 0; dim < rank; ++dim) {
auto [lb, extent] = readShape(dim);
diff --git a/flang/test/Lower/allocatable-callee.f90 b/flang/test/Lower/allocatable-callee.f90
new file mode 100644
index 0000000000000..5daff59587b05
--- /dev/null
+++ b/flang/test/Lower/allocatable-callee.f90
@@ -0,0 +1,138 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Test allocatable dummy argument on callee side
+
+! CHECK-LABEL: func @_QPtest_scalar(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<f32>>>{{.*}})
+subroutine test_scalar(x)
+ real, allocatable :: x
+
+ print *, x
+ ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<f32>>>
+ ! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<f32>>) -> !fir.heap<f32>
+ ! CHECK: %[[val:.*]] = fir.load %[[addr]] : !fir.heap<f32>
+end subroutine
+
+! CHECK-LABEL: func @_QPtest_array(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>{{.*}})
+subroutine test_array(x)
+ integer, allocatable :: x(:,:)
+
+ print *, x(1,2)
+ ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x?xi32>>>>
+ ! CHECK-DAG: fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.array<?x?xi32>>>) -> !fir.heap<!fir.array<?x?xi32>>
+ ! CHECK-DAG: fir.box_dims %[[box]], %c0{{.*}} : (!fir.box<!fir.heap<!fir.array<?x?xi32>>>, index) -> (index, index, index)
+ ! CHECK-DAG: fir.box_dims %[[box]], %c1{{.*}} : (!fir.box<!fir.heap<!fir.array<?x?xi32>>>, index) -> (index, index, index)
+end subroutine
+
+! CHECK-LABEL: func @_QPtest_char_scalar_deferred(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>{{.*}})
+subroutine test_char_scalar_deferred(c)
+ character(:), allocatable :: c
+ external foo1
+ call foo1(c)
+ ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+ ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
+ ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> index
+ ! CHECK-DAG: %[[addr_cast:.*]] = fir.convert %[[addr]] : (!fir.heap<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,?>>
+ ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr_cast]], %[[len]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: fir.call @_QPfoo1(%[[boxchar]]) : (!fir.boxchar<1>) -> ()
+end subroutine
+
+! CHECK-LABEL: func @_QPtest_char_scalar_explicit_cst(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>{{.*}})
+subroutine test_char_scalar_explicit_cst(c)
+ character(10), allocatable :: c
+ external foo1
+ call foo1(c)
+ ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,10>>>>
+ ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.char<1,10>>>) -> !fir.heap<!fir.char<1,10>>
+ ! CHECK-DAG: %[[addr_cast:.*]] = fir.convert %[[addr]] : (!fir.heap<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,?>>
+ ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr_cast]], %c10{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: fir.call @_QPfoo1(%[[boxchar]]) : (!fir.boxchar<1>) -> ()
+end subroutine
+
+! CHECK-LABEL: func @_QPtest_char_scalar_explicit_dynamic(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>{{.*}}, %[[arg1:.*]]: !fir.ref<i32>{{.*}})
+subroutine test_char_scalar_explicit_dynamic(c, n)
+ integer :: n
+ character(n), allocatable :: c
+ external foo1
+ ! Check that the length expr was evaluated before the execution parts.
+ ! CHECK: %[[len:.*]] = fir.load %arg1 : !fir.ref<i32>
+ n = n + 1
+ ! CHECK: fir.store {{.*}} to %arg1 : !fir.ref<i32>
+ call foo1(c)
+ ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+ ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
+ ! CHECK-DAG: %[[addr_cast:.*]] = fir.convert %[[addr]] : (!fir.heap<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,?>>
+ ! CHECK-DAG: %[[len_cast:.*]] = fir.convert %[[len]] : (i32) -> index
+ ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr_cast]], %[[len_cast]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: fir.call @_QPfoo1(%[[boxchar]]) : (!fir.boxchar<1>) -> ()
+end subroutine
+
+! CHECK-LABEL: func @_QPtest_char_array_deferred(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>{{.*}})
+subroutine test_char_array_deferred(c)
+ character(:), allocatable :: c(:)
+ external foo1
+ call foo1(c(10))
+ ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
+ ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>>
+ ! CHECK-DAG: fir.box_dims %[[box]], %c0{{.*}} : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>, index) -> (index, index, index)
+ ! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> index
+ ! [...] address computation
+ ! CHECK: %[[boxchar:.*]] = fir.emboxchar %{{.*}}, %[[len]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: fir.call @_QPfoo1(%[[boxchar]]) : (!fir.boxchar<1>) -> ()
+end subroutine
+
+! CHECK-LABEL: func @_QPtest_char_array_explicit_cst(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>{{.*}})
+subroutine test_char_array_explicit_cst(c)
+ character(10), allocatable :: c(:)
+ external foo1
+ call foo1(c(3))
+ ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>>
+ ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,10>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,10>>>
+ ! [...] address computation
+ ! CHECK: %[[boxchar:.*]] = fir.emboxchar %{{.*}}, %c10{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: fir.call @_QPfoo1(%[[boxchar]]) : (!fir.boxchar<1>) -> ()
+end subroutine
+
+! CHECK-LABEL: func @_QPtest_char_array_explicit_dynamic(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>{{.*}}, %[[arg1:.*]]: !fir.ref<i32>{{.*}})
+subroutine test_char_array_explicit_dynamic(c, n)
+ integer :: n
+ character(n), allocatable :: c(:)
+ external foo1
+ ! Check that the length expr was evaluated before the execution parts.
+ ! CHECK: %[[len:.*]] = fir.load %arg1 : !fir.ref<i32>
+ n = n + 1
+ ! CHECK: fir.store {{.*}} to %arg1 : !fir.ref<i32>
+ call foo1(c(1))
+ ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
+ ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>) -> !fir.heap<!fir.array<?x!fir.char<1,?>>>
+ ! [...] address computation
+ ! CHECK: fir.coordinate_of
+ ! CHECK-DAG: %[[len_cast:.*]] = fir.convert %[[len]] : (i32) -> index
+ ! CHECK: %[[boxchar:.*]] = fir.emboxchar %{{.*}}, %[[len_cast]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+ ! CHECK: fir.call @_QPfoo1(%[[boxchar]]) : (!fir.boxchar<1>) -> ()
+end subroutine
+
+! Check that when reading allocatable length from descriptor, the width is taking
+! into account when the kind is not 1.
+
+! CHECK-LABEL: func @_QPtest_char_scalar_deferred_k2(
+! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.char<2,?>>>>{{.*}})
+subroutine test_char_scalar_deferred_k2(c)
+ character(kind=2, len=:), allocatable :: c
+ external foo2
+ call foo2(c)
+ ! CHECK: %[[box:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<2,?>>>>
+ ! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.heap<!fir.char<2,?>>>) -> !fir.heap<!fir.char<2,?>>
+ ! CHECK-DAG: %[[size:.*]] = fir.box_elesize %[[box]] : (!fir.box<!fir.heap<!fir.char<2,?>>>) -> index
+ ! CHECK-DAG: %[[len:.*]] = arith.divsi %[[size]], %c2{{.*}} : index
+ ! CHECK-DAG: %[[addr_cast:.*]] = fir.convert %[[addr]] : (!fir.heap<!fir.char<2,?>>) -> !fir.ref<!fir.char<2,?>>
+ ! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr_cast]], %[[len]] : (!fir.ref<!fir.char<2,?>>, index) -> !fir.boxchar<2>
+ ! CHECK: fir.call @_QPfoo2(%[[boxchar]]) : (!fir.boxchar<2>) -> ()
+end subroutine
More information about the flang-commits
mailing list