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 @@ -19,6 +19,8 @@ #include "flang/Semantics/tools.h" #include "flang/Semantics/type.h" #include +#include +#include namespace Fortran::semantics { @@ -100,6 +102,7 @@ } } bool IsResultOkToDiffer(const FunctionResult &); + void CheckBindCName(const Symbol &); SemanticsContext &context_; evaluate::FoldingContext &foldingContext_{context_.foldingContext()}; @@ -112,6 +115,8 @@ // Cache of calls to Procedure::Characterize(Symbol) std::map, SymbolAddressCompare> characterizeCache_; + // Collection of symbols with BIND(C) names + std::map bindC_; }; class DistinguishabilityHelper { @@ -195,6 +200,7 @@ if (symbol.attrs().test(Attr::VOLATILE)) { CheckVolatile(symbol, derived); } + CheckBindCName(symbol); if (isDone) { return; // following checks do not apply } @@ -1654,6 +1660,35 @@ helper.Check(scope); } +static const std::string *DefinesBindCName(const Symbol &symbol) { + const auto *subp{symbol.detailsIf()}; + if ((subp && !subp->isInterface()) || symbol.has()) { + // Symbol defines data or entry point + return symbol.GetBindName(); + } else { + return nullptr; + } +} + +// Check that BIND(C) names are distinct +void CheckHelper::CheckBindCName(const Symbol &symbol) { + if (const std::string * name{DefinesBindCName(symbol)}) { + auto pair{bindC_.emplace(*name, symbol)}; + if (!pair.second) { + const Symbol &other{*pair.first->second}; + if (DefinesBindCName(other) && !context_.HasError(other)) { + if (auto *msg{messages_.Say( + "Two symbols have the same BIND(C) name '%s'"_err_en_US, + *name)}) { + msg->Attach(other.name(), "Conflicting symbol"_en_US); + } + context_.SetError(symbol); + context_.SetError(other); + } + } + } +} + void SubprogramMatchHelper::Check( const Symbol &symbol1, const Symbol &symbol2) { const auto details1{symbol1.get()}; diff --git a/flang/test/Semantics/bind-c01.f90 b/flang/test/Semantics/bind-c01.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/bind-c01.f90 @@ -0,0 +1,25 @@ +! RUN: %S/test_errors.sh %s %t %f18 +! Check for multiple symbols being defined with with same BIND(C) name + +module m1 + integer, bind(c, name="x1") :: x1 + !ERROR: Two symbols have the same BIND(C) name 'x1' + integer, bind(c, name=" x1 ") :: x2 + contains + !ERROR: Two symbols have the same BIND(C) name 'x3' + subroutine x3() bind(c, name="x3") + end subroutine +end module + +subroutine x4() bind(c, name=" x3 ") +end subroutine + +! Ensure no error in this situation +module m2 + interface + subroutine x5() bind(c, name=" x5 ") + end subroutine + end interface +end module +subroutine x5() bind(c, name=" x5 ") +end subroutine