[flang-commits] [flang] [flang] Lower BIND(C) assumed length to CFI descriptor (PR #65950)

[via flang-commits]

https://github.com/jeanPerier created https://github.com/llvm/llvm-project/pull/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.

>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] [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