Skip to content

Commit d03cd05

Browse files
klauslerklausler
authored
[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.
1 parent bd815a5 commit d03cd05

File tree

3 files changed

+107
-7
lines changed

3 files changed

+107
-7
lines changed

‎flang/lib/Semantics/resolve-names.cpp

Lines changed: 20 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -5072,13 +5072,6 @@ Symbol &DeclarationVisitor::DeclareProcEntity(
50725072
} else if (interface->test(Symbol::Flag::Subroutine)) {
50735073
symbol.set(Symbol::Flag::Subroutine);
50745074
}
5075-
if (IsBindCProcedure(*interface) && !IsPointer(symbol) &&
5076-
!IsDummy(symbol)) {
5077-
// Inherit BIND_C attribute from the interface, but not the NAME="..."
5078-
// if any. This is not clearly described in the standard, but matches
5079-
// the behavior of other compilers.
5080-
SetImplicitAttr(symbol, Attr::BIND_C);
5081-
}
50825075
} else if (auto *type{GetDeclTypeSpec()}) {
50835076
SetType(name, *type);
50845077
symbol.set(Symbol::Flag::Function);
@@ -8653,6 +8646,20 @@ void ResolveNamesVisitor::FinishSpecificationPart(
86538646
if (!symbol.has<HostAssocDetails>()) {
86548647
CheckPossibleBadForwardRef(symbol);
86558648
}
8649+
// Propagate BIND(C) attribute to procedure entities from their interfaces,
8650+
// but not the NAME=, even if it is empty (which would be a reasonable
8651+
// and useful behavior, actually). This interpretation is not at all
8652+
// clearly described in the standard, but matches the behavior of several
8653+
// other compilers.
8654+
if (auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc &&
8655+
!proc->isDummy() && !IsPointer(symbol) &&
8656+
!symbol.attrs().test(Attr::BIND_C)) {
8657+
if (const Symbol * iface{proc->procInterface()};
8658+
iface && IsBindCProcedure(*iface)) {
8659+
SetImplicitAttr(symbol, Attr::BIND_C);
8660+
SetBindNameOn(symbol);
8661+
}
8662+
}
86568663
}
86578664
currScope().InstantiateDerivedTypes();
86588665
for (const auto &decl : decls) {
@@ -9198,6 +9205,9 @@ void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) {
91989205
if (child.HasModulePrefix()) {
91999206
SetExplicitAttr(symbol, Attr::MODULE);
92009207
}
9208+
if (child.bindingSpec()) {
9209+
SetExplicitAttr(symbol, Attr::BIND_C);
9210+
}
92019211
auto childKind{child.GetKind()};
92029212
if (childKind == ProgramTree::Kind::Function) {
92039213
symbol.set(Symbol::Flag::Function);
@@ -9214,6 +9224,9 @@ void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) {
92149224
if (child.HasModulePrefix()) {
92159225
SetExplicitAttr(symbol, Attr::MODULE);
92169226
}
9227+
if (child.bindingSpec()) {
9228+
SetExplicitAttr(symbol, Attr::BIND_C);
9229+
}
92179230
}
92189231
}
92199232
for (const auto &generic : node.genericSpecs()) {

‎flang/test/Semantics/bind-c02.f90

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ subroutine proc()
1515
!ERROR: Only variable and named common block can be in BIND statement
1616
bind(c) :: pc1
1717

18+
!ERROR: BIND_C attribute was already specified on 'sub'
1819
!ERROR: Only variable and named common block can be in BIND statement
1920
bind(c) :: sub
2021

‎flang/test/Semantics/bind-c16.f90

Lines changed: 86 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,86 @@
1+
!RUN: %flang_fc1 -fdebug-dump-symbols %s 2>&1 | FileCheck %s
2+
!CHECK: p1a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:p1a
3+
!CHECK: p1b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:p1b
4+
!CHECK: p1c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:P1c
5+
!CHECK: p2a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:p2a
6+
!CHECK: p2b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:p2b
7+
!CHECK: p2c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:P2c
8+
!CHECK: p3a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:p3a
9+
!CHECK: p3b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:p3b
10+
!CHECK: p3c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:P3c
11+
module m1
12+
procedure(s1) :: p1a
13+
procedure(s1), bind(c) :: p1b
14+
procedure(s1), bind(c,name='P1c') :: p1c
15+
procedure(s2) :: p2a
16+
procedure(s2), bind(c) :: p2b
17+
procedure(s2), bind(c,name='P2c') :: p2c
18+
procedure(s3) :: p3a
19+
procedure(s3), bind(c) :: p3b
20+
procedure(s3), bind(c,name='P3c') :: p3c
21+
contains
22+
subroutine s1() bind(c)
23+
end
24+
subroutine s2() bind(c,name='')
25+
end
26+
subroutine s3() bind(c,name='foo')
27+
end
28+
end
29+
30+
!CHECK: p1a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:p1a
31+
!CHECK: p1b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:p1b
32+
!CHECK: p1c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:P1c
33+
!CHECK: p2a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:p2a
34+
!CHECK: p2b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:p2b
35+
!CHECK: p2c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:P2c
36+
!CHECK: p3a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:p3a
37+
!CHECK: p3b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:p3b
38+
!CHECK: p3c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:P3c
39+
module m2
40+
interface
41+
subroutine s1() bind(c)
42+
end
43+
subroutine s2() bind(c,name='')
44+
end
45+
subroutine s3() bind(c,name='foo')
46+
end
47+
end interface
48+
procedure(s1) :: p1a
49+
procedure(s1), bind(c) :: p1b
50+
procedure(s1), bind(c,name='P1c') :: p1c
51+
procedure(s2) :: p2a
52+
procedure(s2), bind(c) :: p2b
53+
procedure(s2), bind(c,name='P2c') :: p2c
54+
procedure(s3) :: p3a
55+
procedure(s3), bind(c) :: p3b
56+
procedure(s3), bind(c,name='P3c') :: p3c
57+
end
58+
59+
!CHECK: p1a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:p1a
60+
!CHECK: p1b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:p1b
61+
!CHECK: p1c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s1 bindName:P1c
62+
!CHECK: p2a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:p2a
63+
!CHECK: p2b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:p2b
64+
!CHECK: p2c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s2 bindName:P2c
65+
!CHECK: p3a, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:p3a
66+
!CHECK: p3b, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:p3b
67+
!CHECK: p3c, BIND(C), EXTERNAL, PUBLIC (Subroutine): ProcEntity s3 bindName:P3c
68+
module m3
69+
procedure(s1) :: p1a
70+
procedure(s1), bind(c) :: p1b
71+
procedure(s1), bind(c,name='P1c') :: p1c
72+
procedure(s2) :: p2a
73+
procedure(s2), bind(c) :: p2b
74+
procedure(s2), bind(c,name='P2c') :: p2c
75+
procedure(s3) :: p3a
76+
procedure(s3), bind(c) :: p3b
77+
procedure(s3), bind(c,name='P3c') :: p3c
78+
interface
79+
subroutine s1() bind(c)
80+
end
81+
subroutine s2() bind(c,name='')
82+
end
83+
subroutine s3() bind(c,name='foo')
84+
end
85+
end interface
86+
end

0 commit comments

Comments
 (0)