[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
This commit is contained in:
peter klausler 2021-04-07 13:23:45 -07:00
parent 077bff39d4
commit b6f22fa5fe
2 changed files with 60 additions and 0 deletions

View File

@ -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 @@ private:
}
}
bool IsResultOkToDiffer(const FunctionResult &);
void CheckBindCName(const Symbol &);
SemanticsContext &context_;
evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
@ -112,6 +115,8 @@ private:
// 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 @@ void CheckHelper::Check(const Symbol &symbol) {
if (symbol.attrs().test(Attr::VOLATILE)) {
CheckVolatile(symbol, derived);
}
CheckBindCName(symbol);
if (isDone) {
return; // following checks do not apply
}
@ -1654,6 +1660,35 @@ void CheckHelper::CheckGenericOps(const Scope &scope) {
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>()};

View File

@ -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