[flang-commits] [flang] 3077d61 - [flang] Check for global name conflicts (19.2)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Wed Feb 1 13:24:29 PST 2023
Author: Peter Klausler
Date: 2023-02-01T13:24:16-08:00
New Revision: 3077d61462e09d8d33a5d18c96c88ac6362ecc6b
URL: https://github.com/llvm/llvm-project/commit/3077d61462e09d8d33a5d18c96c88ac6362ecc6b
DIFF: https://github.com/llvm/llvm-project/commit/3077d61462e09d8d33a5d18c96c88ac6362ecc6b.diff
LOG: [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
Added:
flang/test/Semantics/declarations04.f90
Modified:
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Semantics/tools.cpp
flang/test/Lower/pointer-initial-target-2.f90
flang/test/Semantics/bind-c01.f90
flang/test/Semantics/bind-c02.f90
flang/test/Semantics/call01.f90
flang/test/Semantics/call31.f90
flang/test/Semantics/declarations03.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index c320c2399c16d..490608ba4353a 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -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
@@ -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_;
};
@@ -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
}
@@ -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>()}) {
@@ -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);
@@ -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)) {
@@ -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_)) {
@@ -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()}) {
@@ -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);
+ }
}
}
}
@@ -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);
+ }
+ }
}
}
@@ -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)) {
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 4c10135b2f8ea..f4d3d88abff14 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -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);
@@ -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);
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 562692ee69818..4bed8a0addb6e 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -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()) {
diff --git a/flang/test/Lower/pointer-initial-target-2.f90 b/flang/test/Lower/pointer-initial-target-2.f90
index 9a7393dcb122c..102f8e8c84794 100644
--- a/flang/test/Lower/pointer-initial-target-2.f90
+++ b/flang/test/Lower/pointer-initial-target-2.f90
@@ -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
diff --git a/flang/test/Semantics/bind-c01.f90 b/flang/test/Semantics/bind-c01.f90
index 6e3824d6698a1..f0546b3eb068c 100644
--- a/flang/test/Semantics/bind-c01.f90
+++ b/flang/test/Semantics/bind-c01.f90
@@ -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
diff --git a/flang/test/Semantics/bind-c02.f90 b/flang/test/Semantics/bind-c02.f90
index 18b909425090f..c1b44ccd887f5 100644
--- a/flang/test/Semantics/bind-c02.f90
+++ b/flang/test/Semantics/bind-c02.f90
@@ -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
diff --git a/flang/test/Semantics/call01.f90 b/flang/test/Semantics/call01.f90
index 714769263c0b2..40f7befa223da 100644
--- a/flang/test/Semantics/call01.f90
+++ b/flang/test/Semantics/call01.f90
@@ -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()
diff --git a/flang/test/Semantics/call31.f90 b/flang/test/Semantics/call31.f90
index 16c7344d48cb7..eb4411195073d 100644
--- a/flang/test/Semantics/call31.f90
+++ b/flang/test/Semantics/call31.f90
@@ -4,9 +4,9 @@
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
@@ -14,7 +14,7 @@ subroutine subr(parg)
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
diff --git a/flang/test/Semantics/declarations03.f90 b/flang/test/Semantics/declarations03.f90
index 11de6dc870009..6eda65c95fc5f 100644
--- a/flang/test/Semantics/declarations03.f90
+++ b/flang/test/Semantics/declarations03.f90
@@ -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/
@@ -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/
@@ -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
@@ -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
diff --git a/flang/test/Semantics/declarations04.f90 b/flang/test/Semantics/declarations04.f90
new file mode 100644
index 0000000000000..f061cb9e5300f
--- /dev/null
+++ b/flang/test/Semantics/declarations04.f90
@@ -0,0 +1,25 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! test global name conflicts
+
+subroutine ext1
+end
+
+subroutine ext2
+ !ERROR: Two entities have the same global name 'ext1'
+ common /ext1/ x
+end
+
+module ext4
+ contains
+ !ERROR: Two entities have the same global name 'ext2'
+ subroutine foo() bind(c,name="ext2")
+ end
+ !ERROR: Two entities have the same global name 'ext3'
+ subroutine bar() bind(c,name="ext3")
+ end
+end
+
+block data ext3
+ !PORTABILITY: Global name 'ext4' conflicts with a module
+ common /ext4/ x
+end
More information about the flang-commits
mailing list