[flang] Propagate the BIND(C) attribute into procedures from their in… (#93994)

…terfaces

In "PROCEDURE(iface) :: proc", if "iface" has the BIND(C) attribute,
then so should proc, as if the declaration had been "PROCEDURE(iface),
BIND(C) :: proc". This had been working in name resolution only in cases
where "iface" had been declared before "proc".

Note that if "iface" is declared with an empty binding name
("BIND(C,NAME='')"), "proc" does not inherit that property. Use an
explicit "BIND(C,NAME='')" on the "PROCEDURE" statement for that.

This behavior is not clearly defined in the standard, but seems to match
what some other Fortran compilers do.

3 files changed, 107 insertions, 7 deletions

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index b49528b..7397c3a 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -5072,13 +5072,6 @@ Symbol &DeclarationVisitor::DeclareProcEntity(
       } else if (interface->test(Symbol::Flag::Subroutine)) {
         symbol.set(Symbol::Flag::Subroutine);
       }
-      if (IsBindCProcedure(*interface) && !IsPointer(symbol) &&
-          !IsDummy(symbol)) {
-        // Inherit BIND_C attribute from the interface, but not the NAME="..."
-        // if any. This is not clearly described in the standard, but matches
-        // the behavior of other compilers.
-        SetImplicitAttr(symbol, Attr::BIND_C);
-      }
     } else if (auto *type{GetDeclTypeSpec()}) {
       SetType(name, *type);
       symbol.set(Symbol::Flag::Function);
@@ -8653,6 +8646,20 @@ void ResolveNamesVisitor::FinishSpecificationPart(
     if (!symbol.has<HostAssocDetails>()) {
       CheckPossibleBadForwardRef(symbol);
     }
+    // Propagate BIND(C) attribute to procedure entities from their interfaces,
+    // but not the NAME=, even if it is empty (which would be a reasonable
+    // and useful behavior, actually).  This interpretation is not at all
+    // clearly described in the standard, but matches the behavior of several
+    // other compilers.
+    if (auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc &&
+        !proc->isDummy() && !IsPointer(symbol) &&
+        !symbol.attrs().test(Attr::BIND_C)) {
+      if (const Symbol * iface{proc->procInterface()};
+          iface && IsBindCProcedure(*iface)) {
+        SetImplicitAttr(symbol, Attr::BIND_C);
+        SetBindNameOn(symbol);
+      }
+    }
   }
   currScope().InstantiateDerivedTypes();
   for (const auto &decl : decls) {
@@ -9198,6 +9205,9 @@ void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) {
     if (child.HasModulePrefix()) {
       SetExplicitAttr(symbol, Attr::MODULE);
     }
+    if (child.bindingSpec()) {
+      SetExplicitAttr(symbol, Attr::BIND_C);
+    }
     auto childKind{child.GetKind()};
     if (childKind == ProgramTree::Kind::Function) {
       symbol.set(Symbol::Flag::Function);
@@ -9214,6 +9224,9 @@ void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) {
       if (child.HasModulePrefix()) {
         SetExplicitAttr(symbol, Attr::MODULE);
       }
+      if (child.bindingSpec()) {
+        SetExplicitAttr(symbol, Attr::BIND_C);
+      }
     }
   }
   for (const auto &generic : node.genericSpecs()) {
diff --git a/flang/test/Semantics/bind-c02.f90 b/flang/test/Semantics/bind-c02.f90
index d0c7940..416d071 100644
--- a/flang/test/Semantics/bind-c02.f90
+++ b/flang/test/Semantics/bind-c02.f90
@@ -15,6 +15,7 @@ module m
   !ERROR: Only variable and named common block can be in BIND statement
   bind(c) :: pc1
 
+  !ERROR: BIND_C attribute was already specified on 'sub'
   !ERROR: Only variable and named common block can be in BIND statement
   bind(c) :: sub
 
diff --git a/flang/test/Semantics/bind-c16.f90 b/flang/test/Semantics/bind-c16.f90
new file mode 100644
index 0000000..b9dfb03e
--- /dev/null
+++ b/flang/test/Semantics/bind-c16.f90
@@ -0,0 +1,86 @@
+!RUN: %flang_fc1 -fdebug-dump-symbols %s 2>&1 | FileCheck %s
+!CHECK: p1a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:p1a
+!CHECK: p1b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:p1b
+!CHECK: p1c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:P1c
+!CHECK: p2a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:p2a
+!CHECK: p2b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:p2b
+!CHECK: p2c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:P2c
+!CHECK: p3a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:p3a
+!CHECK: p3b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:p3b
+!CHECK: p3c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:P3c
+module m1
+  procedure(s1) :: p1a
+  procedure(s1), bind(c) :: p1b
+  procedure(s1), bind(c,name='P1c') :: p1c
+  procedure(s2) :: p2a
+  procedure(s2), bind(c) :: p2b
+  procedure(s2), bind(c,name='P2c') :: p2c
+  procedure(s3) :: p3a
+  procedure(s3), bind(c) :: p3b
+  procedure(s3), bind(c,name='P3c') :: p3c
+ contains
+  subroutine s1() bind(c)
+  end
+  subroutine s2() bind(c,name='')
+  end
+  subroutine s3() bind(c,name='foo')
+  end
+end
+
+!CHECK: p1a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:p1a
+!CHECK: p1b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:p1b
+!CHECK: p1c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:P1c
+!CHECK: p2a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:p2a
+!CHECK: p2b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:p2b
+!CHECK: p2c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:P2c
+!CHECK: p3a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:p3a
+!CHECK: p3b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:p3b
+!CHECK: p3c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:P3c
+module m2
+  interface
+    subroutine s1() bind(c)
+    end
+    subroutine s2() bind(c,name='')
+    end
+    subroutine s3() bind(c,name='foo')
+    end
+  end interface
+  procedure(s1) :: p1a
+  procedure(s1), bind(c) :: p1b
+  procedure(s1), bind(c,name='P1c') :: p1c
+  procedure(s2) :: p2a
+  procedure(s2), bind(c) :: p2b
+  procedure(s2), bind(c,name='P2c') :: p2c
+  procedure(s3) :: p3a
+  procedure(s3), bind(c) :: p3b
+  procedure(s3), bind(c,name='P3c') :: p3c
+end
+
+!CHECK: p1a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:p1a
+!CHECK: p1b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:p1b
+!CHECK: p1c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:P1c
+!CHECK: p2a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:p2a
+!CHECK: p2b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:p2b
+!CHECK: p2c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:P2c
+!CHECK: p3a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:p3a
+!CHECK: p3b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:p3b
+!CHECK: p3c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:P3c
+module m3
+  procedure(s1) :: p1a
+  procedure(s1), bind(c) :: p1b
+  procedure(s1), bind(c,name='P1c') :: p1c
+  procedure(s2) :: p2a
+  procedure(s2), bind(c) :: p2b
+  procedure(s2), bind(c,name='P2c') :: p2c
+  procedure(s3) :: p3a
+  procedure(s3), bind(c) :: p3b
+  procedure(s3), bind(c,name='P3c') :: p3c
+  interface
+    subroutine s1() bind(c)
+    end
+    subroutine s2() bind(c,name='')
+    end
+    subroutine s3() bind(c,name='foo')
+    end
+  end interface
+end