[flang] Propagate the BIND(C) attribute into procedures from their in… #93994
Conversation
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
llvmbot
added
flang
|
@llvm/pr-subscribers-flang-semantics Author: Peter Klausler (klausler) Changes…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. Full diff: https://github.com/llvm/llvm-project/pull/93994.diff 3 Files Affected:
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 68cfc8641b9b2..2004363abea2e 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -5068,13 +5068,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);
@@ -8631,6 +8624,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) {
@@ -9176,6 +9183,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);
@@ -9192,6 +9202,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 d0c7940744131..416d071542fe6 100644
--- a/flang/test/Semantics/bind-c02.f90
+++ b/flang/test/Semantics/bind-c02.f90
@@ -15,6 +15,7 @@ subroutine proc()
!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 0000000000000..b9dfb03e35eec
--- /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
|
klausler
changed the title
…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.
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
…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.