[flang-commits] [flang] 5b6f3fc - [flang] Lower BIND(C) assumed length to CFI descriptor (#65950)
via flang-commits
flang-commits at lists.llvm.org
Tue Sep 12 00:38:08 PDT 2023
Author: jeanPerier
Date: 2023-09-12T09:38:03+02:00
New Revision: 5b6f3fcb48e9476c8780f7c5f4abb8f2e348fc0d
URL: https://github.com/llvm/llvm-project/commit/5b6f3fcb48e9476c8780f7c5f4abb8f2e348fc0d
DIFF: https://github.com/llvm/llvm-project/commit/5b6f3fcb48e9476c8780f7c5f4abb8f2e348fc0d.diff
LOG: [flang] Lower BIND(C) assumed length to CFI descriptor (#65950)
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.
Added:
flang/test/Lower/HLFIR/bindc-assumed-length.f90
Modified:
flang/lib/Lower/CallInterface.cpp
flang/lib/Lower/ConvertVariable.cpp
flang/lib/Optimizer/Builder/BoxValue.cpp
Removed:
################################################################################
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/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 847ea468f447bc5..cad86f78307870b 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
new file mode 100644
index 000000000000000..2f0b1437535ddb7
--- /dev/null
+++ b/flang/test/Lower/HLFIR/bindc-assumed-length.f90
@@ -0,0 +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 -hlfir -emit-fir -o - %s 2>&1 | FileCheck %s
+
+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 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-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