Skip to content

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

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Jun 3, 2024
Merged

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

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
27 changes: 20 additions & 7 deletions flang/lib/Semantics/resolve-names.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down Expand Up @@ -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) {
Expand Down Expand Up @@ -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);
Expand All @@ -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()) {
Expand Down
1 change: 1 addition & 0 deletions flang/test/Semantics/bind-c02.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
86 changes: 86 additions & 0 deletions flang/test/Semantics/bind-c16.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
Loading