[flang-commits] [flang] 80a54ed - [flang] Disallow noninteroperable dummy procedures from interoperable procedures

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-07-17T11:33:04-07:00
New Revision: 80a54edc14c61fcffc96f46cd6192b5a18fb1d83

URL: https://github.com/llvm/llvm-project/commit/80a54edc14c61fcffc96f46cd6192b5a18fb1d83
DIFF: https://github.com/llvm/llvm-project/commit/80a54edc14c61fcffc96f46cd6192b5a18fb1d83.diff

LOG: [flang] Disallow noninteroperable dummy procedures from interoperable procedures

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

Differential Revision: https://reviews.llvm.org/D155488

Added: 
    flang/test/Semantics/bind-c12.f90

Modified: 
    flang/lib/Semantics/check-declarations.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 24ee1b240115c6..bb2f43cd7ad479 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -2713,12 +2713,17 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
           "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()) {

diff  --git a/flang/test/Semantics/bind-c12.f90 b/flang/test/Semantics/bind-c12.f90
new file mode 100644
index 00000000000000..1b60967d8b31b0
--- /dev/null
+++ b/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