[flang-commits] [PATCH] D155488: [flang] Disallow noninteroperable dummy procedures from interoperable procedures

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: PeteSteinfeld.
klausler added a project: Flang.
Herald added subscribers: sunshaoce, jdoerfert.
Herald added a reviewer: sscalpone.
Herald added a project: All.
klausler requested review of this revision.

A BIND(C) interoperable procedure must have only interoperable dummy procedures.


https://reviews.llvm.org/D155488

Files:
  flang/lib/Semantics/check-declarations.cpp
  flang/test/Semantics/bind-c12.f90


Index: flang/test/Semantics/bind-c12.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/bind-c12.f90
@@ -0,0 +1,5 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+!ERROR: A dummy procedure to an interoperable procedure must also be interoperable
+subroutine subr(e) bind(c)
+  external e
+end
Index: flang/lib/Semantics/check-declarations.cpp
===================================================================
--- flang/lib/Semantics/check-declarations.cpp
+++ flang/lib/Semantics/check-declarations.cpp
@@ -2713,12 +2713,17 @@
           "An interoperable procedure with an OPTIONAL dummy argument might not be portable"_port_en_US);
     }
   } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
-    if (!proc->isDummy() &&
-        (!proc->procInterface() ||
-            !proc->procInterface()->attrs().test(Attr::BIND_C))) {
-      messages_.Say(symbol.name(),
-          "An interface name with BIND attribute must be specified if the BIND attribute is specified in a procedure declaration statement"_err_en_US);
-      context_.SetError(symbol);
+    if (!proc->procInterface() ||
+        !proc->procInterface()->attrs().test(Attr::BIND_C)) {
+      if (proc->isDummy()) {
+        messages_.Say(symbol.name(),
+            "A dummy procedure to an interoperable procedure must also be interoperable"_err_en_US);
+        context_.SetError(symbol);
+      } else {
+        messages_.Say(symbol.name(),
+            "An interface name with BIND attribute must be specified if the BIND attribute is specified in a procedure declaration statement"_err_en_US);
+        context_.SetError(symbol);
+      }
     }
   } else if (const auto *subp{symbol.detailsIf<SubprogramDetails>()}) {
     for (const Symbol *dummy : subp->dummyArgs()) {


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D155488.541113.patch
Type: text/x-patch
Size: 1826 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230717/2864eeb0/attachment-0001.bin>