summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPeter Klausler <35819229+klausler@users.noreply.github.com>2024-03-01 14:57:28 -0800
committerGitHub <noreply@github.com>2024-03-01 14:57:28 -0800
commit8f141490b996ba87323f75bf54b3d868efdaaf4a (patch)
tree3027cc8e14b2cfc35ccfdab895976ac9e6ca7f93
parent17ede03a926a8d8d35d887f1fe805b35e2078d5a (diff)
[flang] Fix separate MODULE PROCEDURE when binding label exists (#82686)
When a separate module procedure is defined with a MODULE PROCEDURE and its corresponding interface has a binding label, the compiler was emitting an error about mismatching binding labels because the binding label wasn't being copied into the subprogram's definition.
-rw-r--r--flang/lib/Semantics/resolve-names.cpp7
-rw-r--r--flang/test/Semantics/separate-mp02.f904
2 files changed, 10 insertions, 1 deletions
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 7de513d8769a..7f9909ee937d 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -4218,7 +4218,12 @@ bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
EraseSymbol(name);
Symbol &newSymbol{MakeSymbol(name, SubprogramDetails{})};
PushScope(Scope::Kind::Subprogram, &newSymbol);
- newSymbol.get<SubprogramDetails>().set_moduleInterface(*symbol);
+ auto &newSubprogram{newSymbol.get<SubprogramDetails>()};
+ newSubprogram.set_moduleInterface(*symbol);
+ auto &subprogram{symbol->get<SubprogramDetails>()};
+ if (const auto *name{subprogram.bindName()}) {
+ newSubprogram.set_bindName(std::string{*name});
+ }
newSymbol.attrs() |= symbol->attrs();
newSymbol.set(symbol->test(Symbol::Flag::Subroutine)
? Symbol::Flag::Subroutine
diff --git a/flang/test/Semantics/separate-mp02.f90 b/flang/test/Semantics/separate-mp02.f90
index 5d13b6b693c8..c63ab6f41a13 100644
--- a/flang/test/Semantics/separate-mp02.f90
+++ b/flang/test/Semantics/separate-mp02.f90
@@ -148,6 +148,8 @@ module m2b
end
module subroutine s6() bind(c)
end
+ module subroutine s7() bind(c, name="s7")
+ end
end interface
end
@@ -172,6 +174,8 @@ contains
!ERROR: Module subprogram 's6' has binding label 'not_s6' but the corresponding interface body has 's6'
module subroutine s6() bind(c, name="not_s6")
end
+ module procedure s7
+ end
end