[flang] Check for conflicting BIND(C) names
Check for two or more symbols that define a data object or entry point
with the same interoperable BIND(C) name.
Differential Revision: https://reviews.llvm.org/D100067
GitOrigin-RevId: b6f22fa5feb606abdae2641036682b0734d0d34a
diff --git a/lib/Semantics/check-declarations.cpp b/lib/Semantics/check-declarations.cpp
index 69607c4..0b28a31 100644
--- a/lib/Semantics/check-declarations.cpp
+++ b/lib/Semantics/check-declarations.cpp
@@ -19,6 +19,8 @@
#include "flang/Semantics/tools.h"
#include "flang/Semantics/type.h"
#include <algorithm>
+#include <map>
+#include <string>
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<SymbolRef, std::optional<Procedure>, SymbolAddressCompare>
characterizeCache_;
+ // Collection of symbols with BIND(C) names
+ std::map<std::string, SymbolRef> 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<SubprogramDetails>()};
+ if ((subp && !subp->isInterface()) || symbol.has<ObjectEntityDetails>()) {
+ // 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<SubprogramDetails>()};
diff --git a/test/Semantics/bind-c01.f90 b/test/Semantics/bind-c01.f90
new file mode 100644
index 0000000..9afb049
--- /dev/null
+++ b/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
