// 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 &);
return details ? GetAssociatedVariable(*details) : &ultimate;
}
+Symbol *GetAssociationRoot(Symbol &symbol) {
+ return const_cast<Symbol *>(
+ GetAssociationRoot(const_cast<const Symbol &>(symbol)));
+}
+
bool IsVariableName(const Symbol &symbol) {
const Symbol *root{GetAssociationRoot(symbol)};
return root && root->has<ObjectEntityDetails>() && !IsNamedConstant(*root);
// type came from explicit type-spec
} else if (!prev) {
ApplyImplicitRules(symbol);
- } else if (!prev->has<ObjectEntityDetails>() && !prev->has<EntityDetails>()) {
- 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<ObjectEntityDetails>() &&
+ !prevRoot->has<EntityDetails>()) {
+ 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)}});
--- /dev/null
+! 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