diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h index e7305d47ed109..0501023116d97 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -919,6 +919,7 @@ bool IsLenTypeParameter(const Symbol &); // Follow use, host, and construct assocations to a variable, if any. const Symbol *GetAssociationRoot(const Symbol &); +Symbol *GetAssociationRoot(Symbol &); const Symbol *FindCommonBlockContaining(const Symbol &); int CountLenParameters(const DerivedTypeSpec &); int CountNonConstantLenParameters(const DerivedTypeSpec &); diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp index 1ae0fce193b16..452ff0f358410 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -931,6 +931,11 @@ const Symbol *GetAssociationRoot(const Symbol &symbol) { return details ? GetAssociatedVariable(*details) : &ultimate; } +Symbol *GetAssociationRoot(Symbol &symbol) { + return const_cast( + GetAssociationRoot(const_cast(symbol))); +} + bool IsVariableName(const Symbol &symbol) { const Symbol *root{GetAssociationRoot(symbol)}; return root && root->has() && !IsNamedConstant(*root); diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 0d2b8813c7bbc..b0e0b0b80ebf4 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -4927,17 +4927,21 @@ void ConstructVisitor::ResolveIndexName( // type came from explicit type-spec } else if (!prev) { ApplyImplicitRules(symbol); - } else if (!prev->has() && !prev->has()) { - Say2(name, "Index name '%s' conflicts with existing identifier"_err_en_US, - *prev, "Previous declaration of '%s'"_en_US); - return; - } else { - if (const auto *type{prev->GetType()}) { - symbol.SetType(*type); - } - if (prev->IsObjectArray()) { - SayWithDecl(name, *prev, "Index variable '%s' is not scalar"_err_en_US); + } else if (const Symbol * prevRoot{GetAssociationRoot(*prev)}) { + // prev could be host- use- or construct-associated with another symbol + if (!prevRoot->has() && + !prevRoot->has()) { + Say2(name, "Index name '%s' conflicts with existing identifier"_err_en_US, + *prev, "Previous declaration of '%s'"_en_US); return; + } else { + if (const auto *type{prevRoot->GetType()}) { + symbol.SetType(*type); + } + if (prevRoot->IsObjectArray()) { + SayWithDecl(name, *prev, "Index variable '%s' is not scalar"_err_en_US); + return; + } } } EvaluateExpr(parser::Scalar{parser::Integer{common::Clone(name)}}); diff --git a/flang/test/Semantics/resolve99.f90 b/flang/test/Semantics/resolve99.f90 new file mode 100644 index 0000000000000..a1c8c10af4eee --- /dev/null +++ b/flang/test/Semantics/resolve99.f90 @@ -0,0 +1,51 @@ +! RUN: %S/test_errors.sh %s %t %f18 + +! Tests for the index-name of a FORALL statement + +module m1 + integer modVar +end module m1 + +program indexName + common /iCommonName/ x + type :: typeName + end type + iGlobalVar = 216 + +contains + subroutine hostAssoc() + integer, dimension(4) :: table + + ! iGlobalVar is host associated with the global variable + iGlobalVar = 1 + FORALL (iGlobalVar=1:4) table(iGlobalVar) = 343 + end subroutine hostAssoc + + subroutine useAssoc() + use m1 + integer, dimension(4) :: tab + ! modVar is use associated with the module variable + FORALL (modVar=1:4) tab(modVar) = 343 + end subroutine useAssoc + + subroutine constructAssoc() + integer, dimension(4) :: table + integer :: localVar + associate (assocVar => localVar) + ! assocVar is construct associated with localVar + FORALL (assocVar=1:4) table(assocVar) = 343 + end associate + end subroutine constructAssoc + + subroutine commonSub() + integer, dimension(4) :: tab + ! This reference is OK + FORALL (iCommonName=1:4) tab(iCommonName) = 343 + end subroutine commonSub + + subroutine mismatch() + integer, dimension(4) :: table + !ERROR: Index name 'typename' conflicts with existing identifier + FORALL (typeName=1:4) table(typeName) = 343 + end subroutine mismatch +end program indexName