Skip to content

Commit

Permalink
[flang] Check for global name conflicts (19.2)
Browse files Browse the repository at this point in the history 
Global names should be checked for conflicts even when not BIND(C).

Differential Revision: https://reviews.llvm.org/D142761
  • Loading branch information
@klausler
klausler committed Feb 1, 2023
1 parent 25e2d0f commit 3077d61
Show file tree
Hide file tree
Showing 10 changed files with 145 additions and 62 deletions.
139 changes: 98 additions & 41 deletions flang/lib/Semantics/check-declarations.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -113,6 +113,7 @@ class CheckHelper {
return msg;
}
bool IsResultOkToDiffer(const FunctionResult &);
void CheckGlobalName(const Symbol &);
void CheckBindC(const Symbol &);
void CheckBindCFunctionResult(const Symbol &);
// Check functions for defined I/O procedures
Expand Down Expand Up @@ -154,11 +155,11 @@ class CheckHelper {
// 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_;
// Collection of module procedure symbols with non-BIND(C)
// global names, qualified by their module.
std::map<std::pair<SourceName, const Symbol *>, SymbolRef> moduleProcs_;
// Collection of symbols with global names, BIND(C) or otherwise
std::map<std::string, SymbolRef> globalNames_;
// Derived types that have defined input/output procedures
std::vector<TypeWithDefinedIo> seenDefinedIoTypes_;
};
Expand Down Expand Up @@ -253,6 +254,7 @@ void CheckHelper::Check(const Symbol &symbol) {
CheckVolatile(symbol, derived);
}
CheckBindC(symbol);
CheckGlobalName(symbol);
if (isDone) {
return; // following checks do not apply
}
Expand Down Expand Up @@ -316,7 +318,9 @@ void CheckHelper::Check(const Symbol &symbol) {
if (type) { // Section 7.2, paragraph 7
bool canHaveAssumedParameter{IsNamedConstant(symbol) ||
(IsAssumedLengthCharacter(symbol) && // C722
IsExternal(symbol)) ||
(IsExternal(symbol) ||
ClassifyProcedure(symbol) ==
ProcedureDefinitionClass::Dummy)) ||
symbol.test(Symbol::Flag::ParentComp)};
if (!IsStmtFunctionDummy(symbol)) { // C726
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
Expand Down Expand Up @@ -351,7 +355,7 @@ void CheckHelper::Check(const Symbol &symbol) {
}
}
}
if (IsAssumedLengthCharacter(symbol) && IsExternal(symbol)) { // C723
if (IsAssumedLengthCharacter(symbol) && IsFunction(symbol)) { // C723
if (symbol.attrs().test(Attr::RECURSIVE)) {
messages_.Say(
"An assumed-length CHARACTER(*) function cannot be RECURSIVE"_err_en_US);
Expand All @@ -360,21 +364,24 @@ void CheckHelper::Check(const Symbol &symbol) {
messages_.Say(
"An assumed-length CHARACTER(*) function cannot return an array"_err_en_US);
}
if (IsElementalProcedure(symbol)) {
messages_.Say(
"An assumed-length CHARACTER(*) function cannot be ELEMENTAL"_err_en_US);
} else if (IsPureProcedure(symbol)) {
messages_.Say(
"An assumed-length CHARACTER(*) function cannot be PURE"_err_en_US);
if (!IsStmtFunction(symbol)) {
if (IsElementalProcedure(symbol)) {
messages_.Say(
"An assumed-length CHARACTER(*) function cannot be ELEMENTAL"_err_en_US);
} else if (IsPureProcedure(symbol)) {
messages_.Say(
"An assumed-length CHARACTER(*) function cannot be PURE"_err_en_US);
}
}
if (const Symbol *result{FindFunctionResult(symbol)}) {
if (IsPointer(*result)) {
messages_.Say(
"An assumed-length CHARACTER(*) function cannot return a POINTER"_err_en_US);
}
} else if (IsPointer(symbol)) {
} else if (IsProcedurePointer(symbol) && IsDummy(symbol)) {
messages_.Say(
"A procedure pointer should not have assumed-length CHARACTER(*) result type"_port_en_US);
"A dummy procedure pointer should not have assumed-length CHARACTER(*) result type"_port_en_US);
// The non-dummy case is a hard error that's caught elsewhere.
}
}
if (symbol.attrs().test(Attr::VALUE)) {
Expand Down Expand Up @@ -420,7 +427,10 @@ void CheckHelper::Check(const Symbol &symbol) {
}
}

void CheckHelper::CheckCommonBlock(const Symbol &symbol) { CheckBindC(symbol); }
void CheckHelper::CheckCommonBlock(const Symbol &symbol) {
CheckGlobalName(symbol);
CheckBindC(symbol);
}

void CheckHelper::CheckBindCFunctionResult(const Symbol &symbol) { // C1553
if (!innermostSymbol_ || !IsBindCProcedure(*innermostSymbol_)) {
Expand Down Expand Up @@ -1060,7 +1070,7 @@ void CheckHelper::CheckSubprogram(
}

void CheckHelper::CheckLocalVsGlobal(const Symbol &symbol) {
if (IsProcedure(symbol) && IsExternal(symbol)) {
if (IsExternal(symbol)) {
if (const Symbol *global{FindGlobal(symbol)}; global && global != &symbol) {
std::string interfaceName{symbol.name().ToString()};
if (const auto *bind{symbol.GetBindName()}) {
Expand Down Expand Up @@ -1095,8 +1105,13 @@ void CheckHelper::CheckLocalVsGlobal(const Symbol &symbol) {
}
}
}
evaluate::AttachDeclaration(msg, *global);
evaluate::AttachDeclaration(msg, symbol);
if (msg) {
if (msg->IsFatal()) {
context_.SetError(symbol);
}
evaluate::AttachDeclaration(msg, *global);
evaluate::AttachDeclaration(msg, symbol);
}
}
}
}
Expand Down Expand Up @@ -2080,14 +2095,75 @@ void CheckHelper::CheckGenericOps(const Scope &scope) {
helper.Check(scope);
}

static const std::string *DefinesBindCName(const Symbol &symbol) {
static bool IsSubprogramDefinition(const Symbol &symbol) {
const auto *subp{symbol.detailsIf<SubprogramDetails>()};
if ((subp && !subp->isInterface()) || symbol.has<ObjectEntityDetails>() ||
symbol.has<CommonBlockDetails>()) {
// Symbol defines data or entry point
return symbol.GetBindName();
return subp && !subp->isInterface() && symbol.scope() &&
symbol.scope()->kind() == Scope::Kind::Subprogram;
}

static bool IsBlockData(const Symbol &symbol) {
return symbol.scope() && symbol.scope()->kind() == Scope::Kind::BlockData;
}

static bool IsExternalProcedureDefinition(const Symbol &symbol) {
return IsBlockData(symbol) ||
(IsSubprogramDefinition(symbol) &&
(IsExternal(symbol) || symbol.GetBindName()));
}

static std::optional<std::string> DefinesGlobalName(const Symbol &symbol) {
if (const auto *module{symbol.detailsIf<ModuleDetails>()}) {
if (!module->isSubmodule() && !symbol.owner().IsIntrinsicModules()) {
return symbol.name().ToString();
}
} else if (IsBlockData(symbol)) {
return symbol.name().ToString();
} else {
return nullptr;
const std::string *bindC{symbol.GetBindName()};
if (symbol.has<CommonBlockDetails>() ||
IsExternalProcedureDefinition(symbol)) {
return bindC ? *bindC : symbol.name().ToString();
} else if (bindC &&
(symbol.has<ObjectEntityDetails>() || IsModuleProcedure(symbol))) {
return *bindC;
}
}
return std::nullopt;
}

// 19.2 p2
void CheckHelper::CheckGlobalName(const Symbol &symbol) {
if (auto global{DefinesGlobalName(symbol)}) {
auto pair{globalNames_.emplace(std::move(*global), symbol)};
if (!pair.second) {
const Symbol &other{*pair.first->second};
if (context_.HasError(symbol) || context_.HasError(other)) {
// don't pile on
} else if (symbol.has<CommonBlockDetails>() &&
other.has<CommonBlockDetails>() && symbol.name() == other.name()) {
// Two common blocks can have the same global name so long as
// they're not in the same scope.
} else if ((IsProcedure(symbol) || IsBlockData(symbol)) &&
(IsProcedure(other) || IsBlockData(other)) &&
(!IsExternalProcedureDefinition(symbol) ||
!IsExternalProcedureDefinition(other))) {
// both are procedures/BLOCK DATA, not both definitions
} else if (symbol.has<ModuleDetails>()) {
messages_.Say(symbol.name(),
"Module '%s' conflicts with a global name"_port_en_US,
pair.first->first);
} else if (other.has<ModuleDetails>()) {
messages_.Say(symbol.name(),
"Global name '%s' conflicts with a module"_port_en_US,
pair.first->first);
} else if (auto *msg{messages_.Say(symbol.name(),
"Two entities have the same global name '%s'"_err_en_US,
pair.first->first)}) {
msg->Attach(other.name(), "Conflicting declaration"_en_US);
context_.SetError(symbol);
context_.SetError(other);
}
}
}
}

Expand All @@ -2102,25 +2178,6 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
"A variable with BIND(C) attribute may only appear in the specification part of a module"_err_en_US);
context_.SetError(symbol);
}
if (const std::string *name{DefinesBindCName(symbol)}) {
auto pair{bindC_.emplace(*name, symbol)};
if (!pair.second) {
const Symbol &other{*pair.first->second};
if (symbol.has<CommonBlockDetails>() && other.has<CommonBlockDetails>() &&
symbol.name() == other.name()) {
// Two common blocks can have the same BIND(C) name so long as
// they're not in the same scope.
} else if (!context_.HasError(other)) {
if (auto *msg{messages_.Say(symbol.name(),
"Two entities have the same BIND(C) name '%s'"_err_en_US,
*name)}) {
msg->Attach(other.name(), "Conflicting declaration"_en_US);
}
context_.SetError(symbol);
context_.SetError(other);
}
}
}
if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
if (!proc->procInterface() ||
!proc->procInterface()->attrs().test(Attr::BIND_C)) {
Expand Down
4 changes: 3 additions & 1 deletion flang/lib/Semantics/resolve-names.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2541,7 +2541,7 @@ bool ScopeHandler::ConvertToProcEntity(Symbol &symbol) {
if (IsFunctionResult(symbol) &&
!(IsPointer(symbol) && symbol.attrs().test(Attr::EXTERNAL))) {
// Don't turn function result into a procedure pointer unless both
// POUNTER and EXTERNAL
// POINTER and EXTERNAL
return false;
}
funcResultStack_.CompleteTypeIfFunctionResult(symbol);
Expand Down Expand Up @@ -3242,6 +3242,8 @@ void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
case ProcedureDefinitionClass::Intrinsic:
case ProcedureDefinitionClass::External:
case ProcedureDefinitionClass::Internal:
case ProcedureDefinitionClass::Dummy:
case ProcedureDefinitionClass::Pointer:
break;
case ProcedureDefinitionClass::None:
Say(*name, "'%s' is not a procedure"_err_en_US);
Expand Down
10 changes: 4 additions & 6 deletions flang/lib/Semantics/tools.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1042,14 +1042,12 @@ ProcedureDefinitionClass ClassifyProcedure(const Symbol &symbol) { // 15.2.2
return ProcedureDefinitionClass::None;
} else if (ultimate.attrs().test(Attr::INTRINSIC)) {
return ProcedureDefinitionClass::Intrinsic;
} else if (IsDummy(ultimate)) {
return ProcedureDefinitionClass::Dummy;
} else if (IsProcedurePointer(symbol)) {
return ProcedureDefinitionClass::Pointer;
} else if (ultimate.attrs().test(Attr::EXTERNAL)) {
return ProcedureDefinitionClass::External;
} else if (const auto *procDetails{ultimate.detailsIf<ProcEntityDetails>()}) {
if (procDetails->isDummy()) {
return ProcedureDefinitionClass::Dummy;
} else if (IsPointer(ultimate)) {
return ProcedureDefinitionClass::Pointer;
}
} else if (const auto *nameDetails{
ultimate.detailsIf<SubprogramNameDetails>()}) {
switch (nameDetails->kind()) {
Expand Down
2 changes: 1 addition & 1 deletion flang/test/Lower/pointer-initial-target-2.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,7 @@ block data tied
end block data

! Test pointer in a common with initial target in the same common.
block data snake
block data bdsnake
integer, target :: b = 42
integer, pointer :: p => b
common /snake/ p, b
Expand Down
4 changes: 2 additions & 2 deletions flang/test/Semantics/bind-c01.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,14 +3,14 @@

module m1
integer, bind(c, name="x1") :: x1
!ERROR: Two entities have the same BIND(C) name 'x1'
!ERROR: Two entities have the same global name 'x1'
integer, bind(c, name=" x1 ") :: x2
contains
subroutine x3() bind(c, name="x3")
end subroutine
end module

!ERROR: Two entities have the same BIND(C) name 'x3'
!ERROR: Two entities have the same global name 'x3'
subroutine x4() bind(c, name=" x3 ")
end subroutine

Expand Down
1 change: 1 addition & 0 deletions flang/test/Semantics/bind-c02.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ subroutine proc() bind(c)
!ERROR: Only variable and named common block can be in BIND statement
bind(c) :: sub

!PORTABILITY: Global name 'm' conflicts with a module
!PORTABILITY: Name 'm' declared in a module should not have the same name as the module
bind(c) :: m ! no error for implicit type variable

Expand Down
4 changes: 2 additions & 2 deletions flang/test/Semantics/call01.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -119,11 +119,11 @@ end function nested
end function

subroutine s01(f1, f2, fp1, fp2)
!PORTABILITY: A procedure pointer should not have assumed-length CHARACTER(*) result type
!PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
character*(*) :: f1, f3, fp1
external :: f1, f3
pointer :: fp1
!PORTABILITY: A procedure pointer should not have assumed-length CHARACTER(*) result type
!PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
procedure(character*(*)), pointer :: fp2
interface
character*(*) function f2()
Expand Down
6 changes: 3 additions & 3 deletions flang/test/Semantics/call31.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,17 +4,17 @@
module m
contains
subroutine subr(parg)
!PORTABILITY: A procedure pointer should not have assumed-length CHARACTER(*) result type
!PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
procedure(character(*)), pointer :: parg
!PORTABILITY: A procedure pointer should not have assumed-length CHARACTER(*) result type
!ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
procedure(character(*)), pointer :: plocal
print *, parg()
plocal => parg
call subr_1(plocal)
end subroutine

subroutine subr_1(parg_1)
!PORTABILITY: A procedure pointer should not have assumed-length CHARACTER(*) result type
!PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
procedure(character(*)), pointer :: parg_1
print *, parg_1()
end subroutine
Expand Down
12 changes: 6 additions & 6 deletions flang/test/Semantics/declarations03.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,17 +5,17 @@ module m

integer :: x, y, z, w, i, j, k

!ERROR: Two entities have the same BIND(C) name 'aa'
!ERROR: Two entities have the same global name 'aa'
common /blk1/ x, /blk2/ y
bind(c, name="aa") :: /blk1/, /blk2/

integer :: t
!ERROR: Two entities have the same BIND(C) name 'bb'
!ERROR: Two entities have the same global name 'bb'
common /blk3/ z
bind(c, name="bb") :: /blk3/, t

integer :: t2
!ERROR: Two entities have the same BIND(C) name 'cc'
!ERROR: Two entities have the same global name 'cc'
common /blk4/ w
bind(c, name="cc") :: t2, /blk4/

Expand All @@ -24,7 +24,7 @@ module m
bind(c, name="dd") :: /blk5/
bind(c, name="ee") :: /blk5/

!ERROR: Two entities have the same BIND(C) name 'ff'
!ERROR: Two entities have the same global name 'ff'
common /blk6/ j, /blk7/ k
bind(c, name="ff") :: /blk6/
bind(c, name="ff") :: /blk7/
Expand All @@ -34,7 +34,7 @@ module m
bind(c, name="gg") :: s1
bind(c, name="hh") :: s1

!ERROR: Two entities have the same BIND(C) name 'ii'
!ERROR: Two entities have the same global name 'ii'
integer :: s2, s3
bind(c, name="ii") :: s2
bind(c, name="ii") :: s3
Expand Down Expand Up @@ -66,6 +66,6 @@ module a
end module

module b
!ERROR: Two entities have the same BIND(C) name 'int'
!ERROR: Two entities have the same global name 'int'
integer, bind(c, name="int") :: i
end module
Loading

0 comments on commit 3077d61

Please sign in to comment.