Skip to content

Commit 3077d61

Browse files
klauslerklausler
committed
[flang] Check for global name conflicts (19.2)
Global names should be checked for conflicts even when not BIND(C). Differential Revision: https://reviews.llvm.org/D142761
1 parent 25e2d0f commit 3077d61

File tree

10 files changed

+145
-62
lines changed

10 files changed

+145
-62
lines changed

‎flang/lib/Semantics/check-declarations.cpp

Lines changed: 98 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -113,6 +113,7 @@ class CheckHelper {
113113
return msg;
114114
}
115115
bool IsResultOkToDiffer(const FunctionResult &);
116+
void CheckGlobalName(const Symbol &);
116117
void CheckBindC(const Symbol &);
117118
void CheckBindCFunctionResult(const Symbol &);
118119
// Check functions for defined I/O procedures
@@ -154,11 +155,11 @@ class CheckHelper {
154155
// Cache of calls to Procedure::Characterize(Symbol)
155156
std::map<SymbolRef, std::optional<Procedure>, SymbolAddressCompare>
156157
characterizeCache_;
157-
// Collection of symbols with BIND(C) names
158-
std::map<std::string, SymbolRef> bindC_;
159158
// Collection of module procedure symbols with non-BIND(C)
160159
// global names, qualified by their module.
161160
std::map<std::pair<SourceName, const Symbol *>, SymbolRef> moduleProcs_;
161+
// Collection of symbols with global names, BIND(C) or otherwise
162+
std::map<std::string, SymbolRef> globalNames_;
162163
// Derived types that have defined input/output procedures
163164
std::vector<TypeWithDefinedIo> seenDefinedIoTypes_;
164165
};
@@ -253,6 +254,7 @@ void CheckHelper::Check(const Symbol &symbol) {
253254
CheckVolatile(symbol, derived);
254255
}
255256
CheckBindC(symbol);
257+
CheckGlobalName(symbol);
256258
if (isDone) {
257259
return; // following checks do not apply
258260
}
@@ -316,7 +318,9 @@ void CheckHelper::Check(const Symbol &symbol) {
316318
if (type) { // Section 7.2, paragraph 7
317319
bool canHaveAssumedParameter{IsNamedConstant(symbol) ||
318320
(IsAssumedLengthCharacter(symbol) && // C722
319-
IsExternal(symbol)) ||
321+
(IsExternal(symbol) ||
322+
ClassifyProcedure(symbol) ==
323+
ProcedureDefinitionClass::Dummy)) ||
320324
symbol.test(Symbol::Flag::ParentComp)};
321325
if (!IsStmtFunctionDummy(symbol)) { // C726
322326
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
@@ -351,7 +355,7 @@ void CheckHelper::Check(const Symbol &symbol) {
351355
}
352356
}
353357
}
354-
if (IsAssumedLengthCharacter(symbol) && IsExternal(symbol)) { // C723
358+
if (IsAssumedLengthCharacter(symbol) && IsFunction(symbol)) { // C723
355359
if (symbol.attrs().test(Attr::RECURSIVE)) {
356360
messages_.Say(
357361
"An assumed-length CHARACTER(*) function cannot be RECURSIVE"_err_en_US);
@@ -360,21 +364,24 @@ void CheckHelper::Check(const Symbol &symbol) {
360364
messages_.Say(
361365
"An assumed-length CHARACTER(*) function cannot return an array"_err_en_US);
362366
}
363-
if (IsElementalProcedure(symbol)) {
364-
messages_.Say(
365-
"An assumed-length CHARACTER(*) function cannot be ELEMENTAL"_err_en_US);
366-
} else if (IsPureProcedure(symbol)) {
367-
messages_.Say(
368-
"An assumed-length CHARACTER(*) function cannot be PURE"_err_en_US);
367+
if (!IsStmtFunction(symbol)) {
368+
if (IsElementalProcedure(symbol)) {
369+
messages_.Say(
370+
"An assumed-length CHARACTER(*) function cannot be ELEMENTAL"_err_en_US);
371+
} else if (IsPureProcedure(symbol)) {
372+
messages_.Say(
373+
"An assumed-length CHARACTER(*) function cannot be PURE"_err_en_US);
374+
}
369375
}
370376
if (const Symbol *result{FindFunctionResult(symbol)}) {
371377
if (IsPointer(*result)) {
372378
messages_.Say(
373379
"An assumed-length CHARACTER(*) function cannot return a POINTER"_err_en_US);
374380
}
375-
} else if (IsPointer(symbol)) {
381+
} else if (IsProcedurePointer(symbol) && IsDummy(symbol)) {
376382
messages_.Say(
377-
"A procedure pointer should not have assumed-length CHARACTER(*) result type"_port_en_US);
383+
"A dummy procedure pointer should not have assumed-length CHARACTER(*) result type"_port_en_US);
384+
// The non-dummy case is a hard error that's caught elsewhere.
378385
}
379386
}
380387
if (symbol.attrs().test(Attr::VALUE)) {
@@ -420,7 +427,10 @@ void CheckHelper::Check(const Symbol &symbol) {
420427
}
421428
}
422429

423-
void CheckHelper::CheckCommonBlock(const Symbol &symbol) { CheckBindC(symbol); }
430+
void CheckHelper::CheckCommonBlock(const Symbol &symbol) {
431+
CheckGlobalName(symbol);
432+
CheckBindC(symbol);
433+
}
424434

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

10621072
void CheckHelper::CheckLocalVsGlobal(const Symbol &symbol) {
1063-
if (IsProcedure(symbol) && IsExternal(symbol)) {
1073+
if (IsExternal(symbol)) {
10641074
if (const Symbol *global{FindGlobal(symbol)}; global && global != &symbol) {
10651075
std::string interfaceName{symbol.name().ToString()};
10661076
if (const auto *bind{symbol.GetBindName()}) {
@@ -1095,8 +1105,13 @@ void CheckHelper::CheckLocalVsGlobal(const Symbol &symbol) {
10951105
}
10961106
}
10971107
}
1098-
evaluate::AttachDeclaration(msg, *global);
1099-
evaluate::AttachDeclaration(msg, symbol);
1108+
if (msg) {
1109+
if (msg->IsFatal()) {
1110+
context_.SetError(symbol);
1111+
}
1112+
evaluate::AttachDeclaration(msg, *global);
1113+
evaluate::AttachDeclaration(msg, symbol);
1114+
}
11001115
}
11011116
}
11021117
}
@@ -2080,14 +2095,75 @@ void CheckHelper::CheckGenericOps(const Scope &scope) {
20802095
helper.Check(scope);
20812096
}
20822097

2083-
static const std::string *DefinesBindCName(const Symbol &symbol) {
2098+
static bool IsSubprogramDefinition(const Symbol &symbol) {
20842099
const auto *subp{symbol.detailsIf<SubprogramDetails>()};
2085-
if ((subp && !subp->isInterface()) || symbol.has<ObjectEntityDetails>() ||
2086-
symbol.has<CommonBlockDetails>()) {
2087-
// Symbol defines data or entry point
2088-
return symbol.GetBindName();
2100+
return subp && !subp->isInterface() && symbol.scope() &&
2101+
symbol.scope()->kind() == Scope::Kind::Subprogram;
2102+
}
2103+
2104+
static bool IsBlockData(const Symbol &symbol) {
2105+
return symbol.scope() && symbol.scope()->kind() == Scope::Kind::BlockData;
2106+
}
2107+
2108+
static bool IsExternalProcedureDefinition(const Symbol &symbol) {
2109+
return IsBlockData(symbol) ||
2110+
(IsSubprogramDefinition(symbol) &&
2111+
(IsExternal(symbol) || symbol.GetBindName()));
2112+
}
2113+
2114+
static std::optional<std::string> DefinesGlobalName(const Symbol &symbol) {
2115+
if (const auto *module{symbol.detailsIf<ModuleDetails>()}) {
2116+
if (!module->isSubmodule() && !symbol.owner().IsIntrinsicModules()) {
2117+
return symbol.name().ToString();
2118+
}
2119+
} else if (IsBlockData(symbol)) {
2120+
return symbol.name().ToString();
20892121
} else {
2090-
return nullptr;
2122+
const std::string *bindC{symbol.GetBindName()};
2123+
if (symbol.has<CommonBlockDetails>() ||
2124+
IsExternalProcedureDefinition(symbol)) {
2125+
return bindC ? *bindC : symbol.name().ToString();
2126+
} else if (bindC &&
2127+
(symbol.has<ObjectEntityDetails>() || IsModuleProcedure(symbol))) {
2128+
return *bindC;
2129+
}
2130+
}
2131+
return std::nullopt;
2132+
}
2133+
2134+
// 19.2 p2
2135+
void CheckHelper::CheckGlobalName(const Symbol &symbol) {
2136+
if (auto global{DefinesGlobalName(symbol)}) {
2137+
auto pair{globalNames_.emplace(std::move(*global), symbol)};
2138+
if (!pair.second) {
2139+
const Symbol &other{*pair.first->second};
2140+
if (context_.HasError(symbol) || context_.HasError(other)) {
2141+
// don't pile on
2142+
} else if (symbol.has<CommonBlockDetails>() &&
2143+
other.has<CommonBlockDetails>() && symbol.name() == other.name()) {
2144+
// Two common blocks can have the same global name so long as
2145+
// they're not in the same scope.
2146+
} else if ((IsProcedure(symbol) || IsBlockData(symbol)) &&
2147+
(IsProcedure(other) || IsBlockData(other)) &&
2148+
(!IsExternalProcedureDefinition(symbol) ||
2149+
!IsExternalProcedureDefinition(other))) {
2150+
// both are procedures/BLOCK DATA, not both definitions
2151+
} else if (symbol.has<ModuleDetails>()) {
2152+
messages_.Say(symbol.name(),
2153+
"Module '%s' conflicts with a global name"_port_en_US,
2154+
pair.first->first);
2155+
} else if (other.has<ModuleDetails>()) {
2156+
messages_.Say(symbol.name(),
2157+
"Global name '%s' conflicts with a module"_port_en_US,
2158+
pair.first->first);
2159+
} else if (auto *msg{messages_.Say(symbol.name(),
2160+
"Two entities have the same global name '%s'"_err_en_US,
2161+
pair.first->first)}) {
2162+
msg->Attach(other.name(), "Conflicting declaration"_en_US);
2163+
context_.SetError(symbol);
2164+
context_.SetError(other);
2165+
}
2166+
}
20912167
}
20922168
}
20932169

@@ -2102,25 +2178,6 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
21022178
"A variable with BIND(C) attribute may only appear in the specification part of a module"_err_en_US);
21032179
context_.SetError(symbol);
21042180
}
2105-
if (const std::string *name{DefinesBindCName(symbol)}) {
2106-
auto pair{bindC_.emplace(*name, symbol)};
2107-
if (!pair.second) {
2108-
const Symbol &other{*pair.first->second};
2109-
if (symbol.has<CommonBlockDetails>() && other.has<CommonBlockDetails>() &&
2110-
symbol.name() == other.name()) {
2111-
// Two common blocks can have the same BIND(C) name so long as
2112-
// they're not in the same scope.
2113-
} else if (!context_.HasError(other)) {
2114-
if (auto *msg{messages_.Say(symbol.name(),
2115-
"Two entities have the same BIND(C) name '%s'"_err_en_US,
2116-
*name)}) {
2117-
msg->Attach(other.name(), "Conflicting declaration"_en_US);
2118-
}
2119-
context_.SetError(symbol);
2120-
context_.SetError(other);
2121-
}
2122-
}
2123-
}
21242181
if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
21252182
if (!proc->procInterface() ||
21262183
!proc->procInterface()->attrs().test(Attr::BIND_C)) {

‎flang/lib/Semantics/resolve-names.cpp

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2541,7 +2541,7 @@ bool ScopeHandler::ConvertToProcEntity(Symbol &symbol) {
25412541
if (IsFunctionResult(symbol) &&
25422542
!(IsPointer(symbol) && symbol.attrs().test(Attr::EXTERNAL))) {
25432543
// Don't turn function result into a procedure pointer unless both
2544-
// POUNTER and EXTERNAL
2544+
// POINTER and EXTERNAL
25452545
return false;
25462546
}
25472547
funcResultStack_.CompleteTypeIfFunctionResult(symbol);
@@ -3242,6 +3242,8 @@ void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
32423242
case ProcedureDefinitionClass::Intrinsic:
32433243
case ProcedureDefinitionClass::External:
32443244
case ProcedureDefinitionClass::Internal:
3245+
case ProcedureDefinitionClass::Dummy:
3246+
case ProcedureDefinitionClass::Pointer:
32453247
break;
32463248
case ProcedureDefinitionClass::None:
32473249
Say(*name, "'%s' is not a procedure"_err_en_US);

‎flang/lib/Semantics/tools.cpp

Lines changed: 4 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1042,14 +1042,12 @@ ProcedureDefinitionClass ClassifyProcedure(const Symbol &symbol) { // 15.2.2
10421042
return ProcedureDefinitionClass::None;
10431043
} else if (ultimate.attrs().test(Attr::INTRINSIC)) {
10441044
return ProcedureDefinitionClass::Intrinsic;
1045+
} else if (IsDummy(ultimate)) {
1046+
return ProcedureDefinitionClass::Dummy;
1047+
} else if (IsProcedurePointer(symbol)) {
1048+
return ProcedureDefinitionClass::Pointer;
10451049
} else if (ultimate.attrs().test(Attr::EXTERNAL)) {
10461050
return ProcedureDefinitionClass::External;
1047-
} else if (const auto *procDetails{ultimate.detailsIf<ProcEntityDetails>()}) {
1048-
if (procDetails->isDummy()) {
1049-
return ProcedureDefinitionClass::Dummy;
1050-
} else if (IsPointer(ultimate)) {
1051-
return ProcedureDefinitionClass::Pointer;
1052-
}
10531051
} else if (const auto *nameDetails{
10541052
ultimate.detailsIf<SubprogramNameDetails>()}) {
10551053
switch (nameDetails->kind()) {

‎flang/test/Lower/pointer-initial-target-2.f90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ block data tied
3636
end block data
3737

3838
! Test pointer in a common with initial target in the same common.
39-
block data snake
39+
block data bdsnake
4040
integer, target :: b = 42
4141
integer, pointer :: p => b
4242
common /snake/ p, b

‎flang/test/Semantics/bind-c01.f90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,14 +3,14 @@
33

44
module m1
55
integer, bind(c, name="x1") :: x1
6-
!ERROR: Two entities have the same BIND(C) name 'x1'
6+
!ERROR: Two entities have the same global name 'x1'
77
integer, bind(c, name=" x1 ") :: x2
88
contains
99
subroutine x3() bind(c, name="x3")
1010
end subroutine
1111
end module
1212

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

‎flang/test/Semantics/bind-c02.f90

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ subroutine proc() bind(c)
1818
!ERROR: Only variable and named common block can be in BIND statement
1919
bind(c) :: sub
2020

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

‎flang/test/Semantics/call01.f90

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -119,11 +119,11 @@ end function nested
119119
end function
120120

121121
subroutine s01(f1, f2, fp1, fp2)
122-
!PORTABILITY: A procedure pointer should not have assumed-length CHARACTER(*) result type
122+
!PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
123123
character*(*) :: f1, f3, fp1
124124
external :: f1, f3
125125
pointer :: fp1
126-
!PORTABILITY: A procedure pointer should not have assumed-length CHARACTER(*) result type
126+
!PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
127127
procedure(character*(*)), pointer :: fp2
128128
interface
129129
character*(*) function f2()

‎flang/test/Semantics/call31.f90

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4,17 +4,17 @@
44
module m
55
contains
66
subroutine subr(parg)
7-
!PORTABILITY: A procedure pointer should not have assumed-length CHARACTER(*) result type
7+
!PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
88
procedure(character(*)), pointer :: parg
9-
!PORTABILITY: A procedure pointer should not have assumed-length CHARACTER(*) result type
9+
!ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
1010
procedure(character(*)), pointer :: plocal
1111
print *, parg()
1212
plocal => parg
1313
call subr_1(plocal)
1414
end subroutine
1515

1616
subroutine subr_1(parg_1)
17-
!PORTABILITY: A procedure pointer should not have assumed-length CHARACTER(*) result type
17+
!PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
1818
procedure(character(*)), pointer :: parg_1
1919
print *, parg_1()
2020
end subroutine

‎flang/test/Semantics/declarations03.f90

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -5,17 +5,17 @@ module m
55

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

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

1212
integer :: t
13-
!ERROR: Two entities have the same BIND(C) name 'bb'
13+
!ERROR: Two entities have the same global name 'bb'
1414
common /blk3/ z
1515
bind(c, name="bb") :: /blk3/, t
1616

1717
integer :: t2
18-
!ERROR: Two entities have the same BIND(C) name 'cc'
18+
!ERROR: Two entities have the same global name 'cc'
1919
common /blk4/ w
2020
bind(c, name="cc") :: t2, /blk4/
2121

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

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

37-
!ERROR: Two entities have the same BIND(C) name 'ii'
37+
!ERROR: Two entities have the same global name 'ii'
3838
integer :: s2, s3
3939
bind(c, name="ii") :: s2
4040
bind(c, name="ii") :: s3
@@ -66,6 +66,6 @@ module a
6666
end module
6767

6868
module b
69-
!ERROR: Two entities have the same BIND(C) name 'int'
69+
!ERROR: Two entities have the same global name 'int'
7070
integer, bind(c, name="int") :: i
7171
end module

0 commit comments

Comments
 (0)