[flang-commits] [flang] [flang] Fix variable-length character function as actual argument (PR #215719)

[via flang-commits]

llvmorg-github-actions[bot] wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: ejose02

<details>
<summary>Changes</summary>

Flang wrongly rejects a fixed-length character function passed to a dummy procedure whose result length depends on dummy arguments, even when the lengths match at the call site.

In FunctionResult::IsCompatibleWith, use IsTkLenCompatibleWith for character result length checks instead of treating all constant vs non-constant length pairs as incompatible. Only reject when both lengths are known constants and differ.

Fixes #<!-- -->192899

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


2 Files Affected:

- (modified) flang/lib/Evaluate/characteristics.cpp (+4-7) 
- (added) flang/test/Semantics/call49.f90 (+20) 


``````````diff
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 4b05a25fd8f58..06e8de73b890a 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -1230,15 +1230,12 @@ bool FunctionResult::IsCompatibleWith(
             if (IsAssumedLengthCharacter() ||
                 actual.IsAssumedLengthCharacter()) {
               return true;
-            } else {
+            }
+            if (ifaceTypeShape->type().IsTkLenCompatibleWith(
+                    actualTypeShape->type())) {
               auto len{ToInt64(ifaceTypeShape->LEN())};
               auto actualLen{ToInt64(actualTypeShape->LEN())};
-              if (len.has_value() != actualLen.has_value()) {
-                if (whyNot) {
-                  *whyNot = "constant-length vs non-constant-length character "
-                            "results";
-                }
-              } else if (len && *len != *actualLen) {
+              if (len && actualLen && *len != *actualLen) {
                 if (whyNot) {
                   *whyNot = "character results with distinct lengths";
                 }
diff --git a/flang/test/Semantics/call49.f90 b/flang/test/Semantics/call49.f90
new file mode 100644
index 0000000000000..452e620962833
--- /dev/null
+++ b/flang/test/Semantics/call49.f90
@@ -0,0 +1,20 @@
+! RUN: %flang_fc1 -fsyntax-only %s
+! dummy procedure length may depend on dummy arguments
+! actual with fixed length is compatible when lengths match at call
+program test
+  character(4), external :: ext
+  call s(ext, ext, 2)
+contains
+  subroutine s(fun, fun_alt, n)
+    integer :: n
+    character(2 * n), external :: fun
+    character(n * (n + 1) - n**2 + n), external :: fun_alt
+    print *, fun()
+    print *, fun_alt()
+  end subroutine
+end program
+
+function ext()
+  character(4) :: ext
+  ext = 'okko'
+end function

``````````

</details>


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