[flang-commits] [flang] [flang] Catch assumed-length interoperability error (PR #124179)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/124179

An assumed-length character dummy argument is interoperable only if it is neither a pointer nor allocatable.

>From 4cbd083b0473e61fad22f2340c93fe51fd21e95f Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Thu, 23 Jan 2025 11:59:21 -0800
Subject: [PATCH] [flang] Catch assumed-length interoperability error

An assumed-length character dummy argument is interoperable only
if it is neither a pointer nor allocatable.
---
 flang/lib/Semantics/check-declarations.cpp | 9 +++++----
 flang/test/Semantics/bind-c06.f90          | 9 +++++++++
 2 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index a7e6cf32e85eea..71dc78cc74e85c 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -3076,16 +3076,17 @@ parser::Messages CheckHelper::WhyNotInteroperableObject(
       }
     }
     if (type->IsAssumedType()) { // ok
-    } else if (IsAssumedLengthCharacter(symbol)) {
+    } else if (IsAssumedLengthCharacter(symbol) &&
+        !IsAllocatableOrPointer(symbol)) {
     } else if (IsAllocatableOrPointer(symbol) &&
         type->category() == DeclTypeSpec::Character &&
         type->characterTypeSpec().length().isDeferred()) {
       // ok; F'2023 18.3.7 p2(6)
     } else if (derived) { // type has been checked
     } else if (auto dyType{evaluate::DynamicType::From(*type)}; dyType &&
-               evaluate::IsInteroperableIntrinsicType(*dyType,
-                   InModuleFile() ? nullptr : &context_.languageFeatures())
-                   .value_or(false)) {
+        evaluate::IsInteroperableIntrinsicType(
+            *dyType, InModuleFile() ? nullptr : &context_.languageFeatures())
+            .value_or(false)) {
       // F'2023 18.3.7 p2(4,5)
       // N.B. Language features are not passed to IsInteroperableIntrinsicType
       // when processing a module file, since the module file might have been
diff --git a/flang/test/Semantics/bind-c06.f90 b/flang/test/Semantics/bind-c06.f90
index 3ad3078c4b4a03..ff78a4743deee9 100644
--- a/flang/test/Semantics/bind-c06.f90
+++ b/flang/test/Semantics/bind-c06.f90
@@ -95,4 +95,13 @@ program main
     real :: x(0)
   end type
 
+  interface
+    subroutine badAssumedLen(x,y,z) bind(c)
+      !ERROR: A BIND(C) object must have an interoperable type
+      character(*), pointer :: x
+      !ERROR: A BIND(C) object must have an interoperable type
+      character(*), allocatable :: y
+      character(*) z ! ok
+    end
+  end interface
 end