[flang] Fix bogus message on index-names in the presence of associated entities

The semantic analysis of index-names of FORALL statements looks up symbols with
the same name as the index-name.  This is needed to exclude symbols that are
not objects.  But if the symbol found is host-, use-, or construct-associated
with another entity, the check fails.

I fixed this by getting the root symbol of the symbol found and doing the check
on the root symbol.  This required creating a non-const version of
"GetAssociationRoot()".

Differential Revision: https://reviews.llvm.org/D92970

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 &);

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<Symbol *>(
+      GetAssociationRoot(const_cast<const Symbol &>(symbol)));
+}
+
 bool IsVariableName(const Symbol &symbol) {
   const Symbol *root{GetAssociationRoot(symbol)};
   return root && root->has<ObjectEntityDetails>() && !IsNamedConstant(*root);

flang/lib/Semantics/resolve-names.cpp

@@ -4927,19 +4927,23 @@ void ConstructVisitor::ResolveIndexName(
     // type came from explicit type-spec
   } else if (!prev) {
     ApplyImplicitRules(symbol);
-  } else if (!prev->has<ObjectEntityDetails>() && !prev->has<EntityDetails>()) {
+  } 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{prev->GetType()}) {
+      if (const auto *type{prevRoot->GetType()}) {
         symbol.SetType(*type);
       }
-    if (prev->IsObjectArray()) {
+      if (prevRoot->IsObjectArray()) {
         SayWithDecl(name, *prev, "Index variable '%s' is not scalar"_err_en_US);
         return;
       }
     }
+  }
   EvaluateExpr(parser::Scalar{parser::Integer{common::Clone(name)}});
 }
 

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