diff --git a/flang/include/flang/Common/Fortran.h b/flang/include/flang/Common/Fortran.h index 15db21bf3473c..4007bfc7994f9 100644 --- a/flang/include/flang/Common/Fortran.h +++ b/flang/include/flang/Common/Fortran.h @@ -114,5 +114,12 @@ bool AreCompatibleCUDADataAttrs( static constexpr char blankCommonObjectName[] = "__BLNK__"; +// Get the assembly name for a non BIND(C) external symbol other than the blank +// common block. +inline std::string GetExternalAssemblyName( + std::string symbolName, bool underscoring) { + return underscoring ? std::move(symbolName) + "_" : std::move(symbolName); +} + } // namespace Fortran::common #endif // FORTRAN_COMMON_FORTRAN_H_ diff --git a/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp b/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp index 64791d673dacd..e967a8f19d53a 100644 --- a/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp +++ b/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp @@ -38,11 +38,8 @@ mangleExternalName(const std::pair globalNames_; // Collection of external procedures without global definitions std::map externalNames_; + // Collection of target dependent assembly names of external and BIND(C) + // procedures. + std::map procedureAssemblyNames_; }; class DistinguishabilityHelper { @@ -277,6 +281,7 @@ void CheckHelper::Check(const Symbol &symbol) { CheckContiguous(symbol); } CheckGlobalName(symbol); + CheckProcedureAssemblyName(symbol); if (symbol.attrs().test(Attr::ASYNCHRONOUS) && !evaluate::IsVariable(symbol)) { messages_.Say( @@ -2623,6 +2628,43 @@ void CheckHelper::CheckGlobalName(const Symbol &symbol) { } } +void CheckHelper::CheckProcedureAssemblyName(const Symbol &symbol) { + if (!IsProcedure(symbol) || symbol != symbol.GetUltimate()) + return; + const std::string *bindName{symbol.GetBindName()}; + const bool hasExplicitBindingLabel{ + symbol.GetIsExplicitBindName() && bindName}; + if (hasExplicitBindingLabel || IsExternal(symbol)) { + const std::string assemblyName{hasExplicitBindingLabel + ? *bindName + : common::GetExternalAssemblyName( + symbol.name().ToString(), context_.underscoring())}; + auto pair{procedureAssemblyNames_.emplace(std::move(assemblyName), symbol)}; + if (!pair.second) { + const Symbol &other{*pair.first->second}; + const bool otherHasExplicitBindingLabel{ + other.GetIsExplicitBindName() && other.GetBindName()}; + if (otherHasExplicitBindingLabel != hasExplicitBindingLabel) { + // The BIND(C,NAME="...") binding label is the same as the name that + // will be used in LLVM IR for an external procedure declared without + // BIND(C) in the same file. While this is not forbidden by the + // standard, this name collision would lead to a crash when producing + // the IR. + if (auto *msg{messages_.Say(symbol.name(), + "%s procedure assembly name conflicts with %s procedure assembly name"_err_en_US, + hasExplicitBindingLabel ? "BIND(C)" : "Non BIND(C)", + hasExplicitBindingLabel ? "non BIND(C)" : "BIND(C)")}) { + msg->Attach(other.name(), "Conflicting declaration"_en_US); + } + context_.SetError(symbol); + context_.SetError(other); + } + // Otherwise, the global names also match and the conflict is analyzed + // by CheckGlobalName. + } + } +} + void CheckHelper::CheckBindC(const Symbol &symbol) { bool isExplicitBindC{symbol.attrs().test(Attr::BIND_C)}; if (isExplicitBindC) { diff --git a/flang/test/Semantics/bind-c14.f90 b/flang/test/Semantics/bind-c14.f90 new file mode 100644 index 0000000000000..40beac9a6dabd --- /dev/null +++ b/flang/test/Semantics/bind-c14.f90 @@ -0,0 +1,35 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -funderscoring + +subroutine conflict1() +end subroutine + +!ERROR: BIND(C) procedure assembly name conflicts with non BIND(C) procedure assembly name +subroutine foo(x) bind(c, name="conflict1_") + real :: x +end subroutine + +subroutine no_conflict1() bind(c, name="") +end subroutine +subroutine foo2() bind(c, name="conflict2_") +end subroutine + +subroutine bar() + interface + subroutine no_conflict1() bind(c, name="") + end subroutine + ! ERROR: Non BIND(C) procedure assembly name conflicts with BIND(C) procedure assembly name + subroutine conflict2() + end subroutine + end interface + call no_conflict1() + call conflict2 +end subroutine + +subroutine no_conflict2() bind(c, name="no_conflict2_") +end subroutine + +subroutine _() +end subroutine + +subroutine dash_no_conflict() bind(c, name="") +end subroutine