diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -46,6 +46,7 @@ void Check(const ArraySpec &); void Check(const DeclTypeSpec &, bool canHaveAssumedTypeParameters); void Check(const Symbol &); + void CheckCommonBlock(const Symbol &); void Check(const Scope &); const Procedure *Characterize(const Symbol &); @@ -375,6 +376,8 @@ } } +void CheckHelper::CheckCommonBlock(const Symbol &symbol) { CheckBindC(symbol); } + void CheckHelper::CheckValue( const Symbol &symbol, const DerivedTypeSpec *derived) { // C863 - C865 if (!IsDummy(symbol)) { @@ -1729,6 +1732,9 @@ for (const auto &pair : scope) { Check(*pair.second); } + for (const auto &pair : scope.commonBlocks()) { + CheckCommonBlock(*pair.second); + } int mainProgCnt{0}; for (const Scope &child : scope.children()) { Check(child); @@ -1865,7 +1871,7 @@ const auto *subp{symbol.detailsIf()}; if ((subp && !subp->isInterface() && ClassifyProcedure(symbol) != ProcedureDefinitionClass::Internal) || - symbol.has()) { + symbol.has() || symbol.has()) { // Symbol defines data or entry point return symbol.GetBindName(); } else { @@ -1887,7 +1893,7 @@ if (!pair.second) { const Symbol &other{*pair.first->second}; if (DefinesBindCName(other) && !context_.HasError(other)) { - if (auto *msg{messages_.Say( + if (auto *msg{messages_.Say(symbol.name(), "Two symbols have the same BIND(C) name '%s'"_err_en_US, *name)}) { msg->Attach(other.name(), "Conflicting symbol"_en_US); diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -1674,7 +1674,19 @@ } else { label = parser::ToLowerCaseLetters(symbol.name().ToString()); } + // Check if a symbol has two Bind names. + std::string oldBindName; + if (symbol.GetBindName()) { + oldBindName = *symbol.GetBindName(); + } symbol.SetBindName(std::move(*label)); + if (!oldBindName.empty()) { + if (const std::string * newBindName{symbol.GetBindName()}) { + if (oldBindName.compare(*newBindName) != 0) { + Say(symbol.name(), "The entity '%s' has multiple BIND names"_err_en_US); + } + } + } } void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) { diff --git a/flang/test/Semantics/declarations03.f90 b/flang/test/Semantics/declarations03.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/declarations03.f90 @@ -0,0 +1,50 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +! test bind(c) name conflict + +module m + + integer :: x, y, z, w, i, j, k + + !ERROR: Two symbols have the same BIND(C) name 'aa' + common /blk1/ x, /blk2/ y + bind(c, name="aa") :: /blk1/, /blk2/ + + integer :: t + !ERROR: Two symbols have the same BIND(C) name 'bb' + common /blk3/ z + bind(c, name="bb") :: /blk3/, t + + integer :: t2 + !ERROR: Two symbols have the same BIND(C) name 'cc' + common /blk4/ w + bind(c, name="cc") :: t2, /blk4/ + + !ERROR: The entity 'blk5' has multiple BIND names + common /blk5/ i + bind(c, name="dd") :: /blk5/ + bind(c, name="ee") :: /blk5/ + + !ERROR: Two symbols have the same BIND(C) name 'ff' + common /blk6/ j, /blk7/ k + bind(c, name="ff") :: /blk6/ + bind(c, name="ff") :: /blk7/ + + !ERROR: The entity 's1' has multiple BIND names + integer :: s1 + bind(c, name="gg") :: s1 + bind(c, name="hh") :: s1 + + !ERROR: Two symbols have the same BIND(C) name 'ii' + integer :: s2, s3 + bind(c, name="ii") :: s2 + bind(c, name="ii") :: s3 + + !ERROR: The entity 's4' has multiple BIND names + integer, bind(c, name="ss1") :: s4 + bind(c, name="jj") :: s4 + + !ERROR: The entity 's5' has multiple BIND names + bind(c, name="kk") :: s5 + integer, bind(c, name="ss2") :: s5 + +end