[flang-commits] [flang] [flang] Don't pass a hidden length for BIND(C) character dummy arguments (PR #224582)

[via flang-commits]

llvmorg-github-actions[bot] wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-fir-hlfir

Author: Martin Schlipf (martin-schlipf)

<details>
<summary>Changes</summary>

A BIND(C) procedure uses the C calling convention, which has no hidden character length argument. Lowering nevertheless passed a character dummy as a fir.boxchar<1>, that is an address plus a length, for every dummy without the VALUE attribute. A call to a C function declared

  void takes_char(const char *);

was emitted as

  declare void @<!-- -->takes_char(ptr, i64)

which matches neither C nor what other Fortran compilers pass.

Semantics already requires a BIND(C) character dummy to have an interoperable type and rejects any length other than one, so the hidden length carries no information, and the BIND(C) character *result* path already omits it. Pass the address alone for a BIND(C) character dummy whose length is known to be one, leaving assumed-length dummies unchanged.

---
Full diff: https://github.com/llvm/llvm-project/pull/224582.diff


2 Files Affected:

- (modified) flang/lib/Lower/CallInterface.cpp (+9) 
- (added) flang/test/Lower/bindc-char-dummy.f90 (+31) 


``````````diff
diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 9885345bed3a5..c5b1a175564c8 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -1274,6 +1274,15 @@ class Fortran::lower::CallInterfaceImpl {
             fir::CharacterType::getSingleton(&mlirContext, dynamicType.kind());
         addFirOperand(charTy, nextPassedArgPosition(), Property::Value, attrs);
         addPassedArg(PassEntityBy::Value, entity, characteristics);
+      } else if (isBindC && dynamicType.knownLength().value_or(0) == 1) {
+        // Pass as fir.ref: a BIND(C) procedure uses the C calling convention,
+        // which has no hidden length argument. Semantics requires a BIND(C)
+        // character dummy to have a length of 1, so the length is already
+        // known to both sides and carries no information.
+        mlir::Type refTy = fir::ReferenceType::get(type);
+        addFirOperand(refTy, nextPassedArgPosition(), Property::BaseAddress,
+                      attrs);
+        addPassedArg(PassEntityBy::BaseAddress, entity, characteristics);
       } else {
         // Pass as fir.box_char
         mlir::Type boxCharTy =
diff --git a/flang/test/Lower/bindc-char-dummy.f90 b/flang/test/Lower/bindc-char-dummy.f90
new file mode 100644
index 0000000000000..c3311f1937ac8
--- /dev/null
+++ b/flang/test/Lower/bindc-char-dummy.f90
@@ -0,0 +1,31 @@
+! Test that a BIND(C) procedure does not pass a hidden length for a character
+! dummy argument. A BIND(C) procedure uses the C calling convention, which has
+! no such argument, and semantics already requires a BIND(C) character dummy to
+! have a length of one, so the length carries no information.
+
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+
+subroutine call_bindc_char_dummy(c, a)
+  interface
+    subroutine takes_char(s) bind(C, name="takes_char")
+      character(kind=1, len=1), intent(in) :: s
+    end subroutine
+    subroutine takes_char_array(s) bind(C, name="takes_char_array")
+      character(kind=1, len=1), intent(in) :: s(*)
+    end subroutine
+  end interface
+  character(kind=1, len=1) :: c
+  character(kind=1, len=1) :: a(10)
+  call takes_char(c)
+  call takes_char_array(a)
+end subroutine
+! CHECK-LABEL:   func.func @_QPcall_bindc_char_dummy(
+! CHECK:           fir.call @takes_char(%{{[^)]*}}) proc_attrs<bind_c>{{.*}} : (!fir.ref<!fir.char<1>>) -> ()
+! CHECK:           fir.call @takes_char_array(%{{[^)]*}}) proc_attrs<bind_c>{{.*}} : (!fir.ref<!fir.array<?x!fir.char<1>>>) -> ()
+
+subroutine defines_char(s) bind(C, name="defines_char")
+  character(kind=1, len=1), intent(inout) :: s
+  s = 'x'
+end subroutine
+! CHECK-LABEL:   func.func @defines_char(
+! CHECK-SAME:      %{{[^:]*}}: !fir.ref<!fir.char<1>>

``````````

</details>


https://github.com/llvm/llvm-project/pull/224582