[flang-commits] [flang] [flang] Lower BIND(C) assumed length to CFI descriptor (PR #65950)
via flang-commits
flang-commits at lists.llvm.org
Mon Sep 11 09:29:18 PDT 2023
https://github.com/jeanPerier updated https://github.com/llvm/llvm-project/pull/65950:
>From c915a392722ca0afc5d10e30f8b6dd582817e0de Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Mon, 11 Sep 2023 04:51:57 -0700
Subject: [PATCH 1/2] [flang] Lower BIND(C) assumed length to CFI descriptor
Outside of BIND(C), assumed length character scalar and explicit shape
are passed by address + an extra length argument (fir.boxchar in FIR).
The standard mandates that they be passed via CFI descriptor in
BIND(C) interface (fir.box in FIR). This patch fix the handling for
this case.
---
flang/lib/Lower/CallInterface.cpp | 9 ++++++---
.../test/Lower/HLFIR/bindc-assumed-length.f90 | 18 ++++++++++++++++++
2 files changed, 24 insertions(+), 3 deletions(-)
create mode 100644 flang/test/Lower/HLFIR/bindc-assumed-length.f90
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 034bce4b13885c0..bc666532a545e52 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -702,7 +702,7 @@ class Fortran::lower::CallInterfaceImpl {
[&](const Fortran::evaluate::characteristics::DummyDataObject
&dummy) {
const auto &entity = getDataObjectEntity(std::get<1>(pair));
- if (dummy.CanBePassedViaImplicitInterface())
+ if (!isBindC && dummy.CanBePassedViaImplicitInterface())
handleImplicitDummy(&argCharacteristics, dummy, entity);
else
handleExplicitDummy(&argCharacteristics, dummy, entity,
@@ -871,7 +871,8 @@ class Fortran::lower::CallInterfaceImpl {
// Define when an explicit argument must be passed in a fir.box.
bool dummyRequiresBox(
- const Fortran::evaluate::characteristics::DummyDataObject &obj) {
+ const Fortran::evaluate::characteristics::DummyDataObject &obj,
+ bool isBindC) {
using ShapeAttr = Fortran::evaluate::characteristics::TypeAndShape::Attr;
using ShapeAttrs = Fortran::evaluate::characteristics::TypeAndShape::Attrs;
constexpr ShapeAttrs shapeRequiringBox = {
@@ -888,6 +889,8 @@ class Fortran::lower::CallInterfaceImpl {
if (const Fortran::semantics::Scope *scope = derived->scope())
// Need to pass length type parameters in fir.box if any.
return scope->IsDerivedTypeWithLengthParameter();
+ if (isBindC && obj.type.type().IsAssumedLengthCharacter())
+ return true; // Fortran 2018 18.3.6 point 2 (5)
return false;
}
@@ -973,7 +976,7 @@ class Fortran::lower::CallInterfaceImpl {
addFirOperand(boxRefType, nextPassedArgPosition(), Property::MutableBox,
attrs);
addPassedArg(PassEntityBy::MutableBox, entity, characteristics);
- } else if (dummyRequiresBox(obj)) {
+ } else if (dummyRequiresBox(obj, isBindC)) {
// Pass as fir.box or fir.class
if (isValueAttr)
TODO(loc, "assumed shape dummy argument with VALUE attribute");
diff --git a/flang/test/Lower/HLFIR/bindc-assumed-length.f90 b/flang/test/Lower/HLFIR/bindc-assumed-length.f90
new file mode 100644
index 000000000000000..14b9a2201cf1be8
--- /dev/null
+++ b/flang/test/Lower/HLFIR/bindc-assumed-length.f90
@@ -0,0 +1,18 @@
+! Test that assumed length character scalars and explicit shape arrays are passed via
+! CFI descriptor (fir.box) in BIND(C) procedures. They are passed only by address
+! and length in non BIND(C) procedures. See Fortran 2018 standard 18.3.6 point 2(5).
+! RUN: bbc -emit-hlfir -o - %s 2>&1 | FileCheck %s
+
+! CHECK: func.func @foo(
+! CHECK-SAME: %{{[^:]*}}: !fir.box<!fir.char<1,?>>
+! CHECK-SAME: %{{[^:]*}}: !fir.box<!fir.array<100x!fir.char<1,?>>>
+subroutine foo(c1, c3) bind(c)
+ character(*) :: c1, c3(100)
+end subroutine
+
+! CHECK: func.func @_QPnot_bindc(
+! CHECK-SAME: %{{[^:]*}}: !fir.boxchar<1>
+! CHECK-SAME: %{{[^:]*}}: !fir.boxchar<1>
+subroutine not_bindc(c1, c3)
+ character(*) :: c1, c3(100)
+end subroutine
>From 191d579531434be2619f1587a27716c1b6c7bcdf Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Mon, 11 Sep 2023 09:26:00 -0700
Subject: [PATCH 2/2] Fix bug from patch on the callee side
Lowering hit and assert with the previous patch because it is not meant
to manipulate scalars characters as fir.box.
Add the code to open the fir.box of BIND(C) characters on the callee
side, taking care of dealing with the case where the fir.box is optional
and cannot be addressed unconditionally.
---
flang/lib/Lower/ConvertVariable.cpp | 54 +++++++++++++++++--
flang/lib/Optimizer/Builder/BoxValue.cpp | 5 --
.../test/Lower/HLFIR/bindc-assumed-length.f90 | 33 ++++++++++--
3 files changed, 78 insertions(+), 14 deletions(-)
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 726b8489409ecb4..cfb81351f4f6d7c 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -1275,12 +1275,14 @@ static void instantiateCommon(Fortran::lower::AbstractConverter &converter,
/// Helper to decide if a dummy argument must be tracked in an BoxValue.
static bool lowerToBoxValue(const Fortran::semantics::Symbol &sym,
- mlir::Value dummyArg) {
+ mlir::Value dummyArg,
+ Fortran::lower::AbstractConverter &converter) {
// Only dummy arguments coming as fir.box can be tracked in an BoxValue.
if (!dummyArg || !dummyArg.getType().isa<fir::BaseBoxType>())
return false;
// Non contiguous arrays must be tracked in an BoxValue.
- if (sym.Rank() > 0 && !sym.attrs().test(Fortran::semantics::Attr::CONTIGUOUS))
+ if (sym.Rank() > 0 && !Fortran::evaluate::IsSimplyContiguous(
+ sym, converter.getFoldingContext()))
return true;
// Assumed rank and optional fir.box cannot yet be read while lowering the
// specifications.
@@ -1713,16 +1715,60 @@ void Fortran::lower::mapSymbolAttributes(
if (isDummy) {
mlir::Value dummyArg = symMap.lookupSymbol(sym).getAddr();
- if (lowerToBoxValue(sym, dummyArg)) {
+ if (lowerToBoxValue(sym, dummyArg, converter)) {
llvm::SmallVector<mlir::Value> lbounds;
llvm::SmallVector<mlir::Value> explicitExtents;
llvm::SmallVector<mlir::Value> explicitParams;
// Lower lower bounds, explicit type parameters and explicit
// extents if any.
- if (ba.isChar())
+ if (ba.isChar()) {
if (mlir::Value len =
lowerExplicitCharLen(converter, loc, ba, symMap, stmtCtx))
explicitParams.push_back(len);
+ if (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.
+ auto boxTy = dummyArg.getType().dyn_cast<fir::BaseBoxType>();
+ mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
+ mlir::Type lenType = builder.getCharacterLengthType();
+ mlir::Value addr, len;
+ if (Fortran::semantics::IsOptional(sym)) {
+ auto isPresent = builder.create<fir::IsPresentOp>(
+ loc, builder.getI1Type(), dummyArg);
+ auto addrAndLen =
+ builder
+ .genIfOp(loc, {refTy, lenType}, isPresent,
+ /*withElseRegion=*/true)
+ .genThen([&]() {
+ mlir::Value readAddr =
+ builder.create<fir::BoxAddrOp>(loc, refTy, dummyArg);
+ mlir::Value readLength =
+ charHelp.readLengthFromBox(dummyArg);
+ builder.create<fir::ResultOp>(
+ loc, mlir::ValueRange{readAddr, readLength});
+ })
+ .genElse([&] {
+ mlir::Value readAddr = builder.genAbsentOp(loc, refTy);
+ mlir::Value readLength =
+ fir::factory::createZeroValue(builder, loc, lenType);
+ builder.create<fir::ResultOp>(
+ loc, mlir::ValueRange{readAddr, readLength});
+ })
+ .getResults();
+ addr = addrAndLen[0];
+ len = addrAndLen[1];
+ } else {
+ addr = builder.create<fir::BoxAddrOp>(loc, refTy, dummyArg);
+ len = charHelp.readLengthFromBox(dummyArg);
+ }
+ if (!explicitParams.empty())
+ len = explicitParams[0];
+ ::genDeclareSymbol(converter, symMap, sym, addr, len, /*extents=*/{},
+ /*lbounds=*/{}, replace);
+ return;
+ }
+ }
// TODO: derived type length parameters.
lowerExplicitLowerBounds(converter, loc, ba, lbounds, symMap, stmtCtx);
lowerExplicitExtents(converter, loc, ba, lbounds, explicitExtents, symMap,
diff --git a/flang/lib/Optimizer/Builder/BoxValue.cpp b/flang/lib/Optimizer/Builder/BoxValue.cpp
index bffe91eaf6b7c30..ada315493ba456e 100644
--- a/flang/lib/Optimizer/Builder/BoxValue.cpp
+++ b/flang/lib/Optimizer/Builder/BoxValue.cpp
@@ -214,11 +214,6 @@ bool fir::BoxValue::verify() const {
return false;
if (!lbounds.empty() && lbounds.size() != rank())
return false;
- // Explicit extents are here to cover cases where an explicit-shape dummy
- // argument comes as a fir.box. This can only happen with derived types and
- // unlimited polymorphic.
- if (!extents.empty() && !(isDerived() || isUnlimitedPolymorphic()))
- return false;
if (!extents.empty() && extents.size() != rank())
return false;
if (isCharacter() && explicitParams.size() > 1)
diff --git a/flang/test/Lower/HLFIR/bindc-assumed-length.f90 b/flang/test/Lower/HLFIR/bindc-assumed-length.f90
index 14b9a2201cf1be8..2f0b1437535ddb7 100644
--- a/flang/test/Lower/HLFIR/bindc-assumed-length.f90
+++ b/flang/test/Lower/HLFIR/bindc-assumed-length.f90
@@ -1,18 +1,41 @@
! Test that assumed length character scalars and explicit shape arrays are passed via
! CFI descriptor (fir.box) in BIND(C) procedures. They are passed only by address
! and length in non BIND(C) procedures. See Fortran 2018 standard 18.3.6 point 2(5).
-! RUN: bbc -emit-hlfir -o - %s 2>&1 | FileCheck %s
+! RUN: bbc -hlfir -emit-fir -o - %s 2>&1 | FileCheck %s
-! CHECK: func.func @foo(
+module bindcchar
+contains
+! CHECK-LABEL: func.func @bindc(
! CHECK-SAME: %{{[^:]*}}: !fir.box<!fir.char<1,?>>
! CHECK-SAME: %{{[^:]*}}: !fir.box<!fir.array<100x!fir.char<1,?>>>
-subroutine foo(c1, c3) bind(c)
- character(*) :: c1, c3(100)
+subroutine bindc(c1, c3) bind(c)
+ character(*) :: c1, c3(100)
+ print *, c1(1:3), c3(5)(1:3)
+end subroutine
+
+! CHECK-LABEL: func.func @bindc_optional(
+! CHECK-SAME: %{{[^:]*}}: !fir.box<!fir.char<1,?>>
+! CHECK-SAME: %{{[^:]*}}: !fir.box<!fir.array<100x!fir.char<1,?>>>
+subroutine bindc_optional(c1, c3) bind(c)
+ character(*), optional :: c1, c3(100)
+ print *, c1(1:3), c3(5)(1:3)
end subroutine
-! CHECK: func.func @_QPnot_bindc(
+! CHECK-LABEL: func.func @_QMbindccharPnot_bindc(
! CHECK-SAME: %{{[^:]*}}: !fir.boxchar<1>
! CHECK-SAME: %{{[^:]*}}: !fir.boxchar<1>
subroutine not_bindc(c1, c3)
character(*) :: c1, c3(100)
+ call bindc(c1, c3)
+ call bindc_optional(c1, c3)
+end subroutine
+
+! CHECK-LABEL: func.func @_QMbindccharPnot_bindc_optional(
+! CHECK-SAME: %{{[^:]*}}: !fir.boxchar<1>
+! CHECK-SAME: %{{[^:]*}}: !fir.boxchar<1>
+subroutine not_bindc_optional(c1, c3)
+ character(*), optional :: c1, c3(100)
+ call bindc(c1, c3)
+ call bindc_optional(c1, c3)
end subroutine
+end module
More information about the flang-commits
mailing list