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

[PeteSteinfeld]

Summary

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()".

[klausler]

flang/lib/Evaluate/tools.cpp

944

The body of this overridden function should be next to the original, no?

Consider using const_cast on a reference type rather than a created pointer.

[PeteSteinfeld]

flang/lib/Evaluate/tools.cpp

944

Thanks, Peter. I'll make these changes.

flang/include/flang/Evaluate/tools.h

 bool IsSaved(const Symbol &); // saved implicitly or explicitly
 bool IsDummy(const Symbol &);
 bool IsFunctionResult(const Symbol &);
 bool IsKindTypeParameter(const Symbol &);
 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 &);
 const Symbol &GetUsedModule(const UseDetails &);
 
 } // namespace Fortran::semantics
 
 #endif // FORTRAN_EVALUATE_TOOLS_H_

flang/lib/Evaluate/tools.cpp

 }
 
 const Symbol *GetAssociationRoot(const Symbol &symbol) {
   const Symbol &ultimate{symbol.GetUltimate()};
   const auto *details{ultimate.detailsIf<semantics::AssocEntityDetails>()};
   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);
 }
 
 bool IsPureProcedure(const Symbol &symbol) {
   if (const auto *procDetails{symbol.detailsIf<ProcEntityDetails>()}) {
     if (const Symbol * procInterface{procDetails->interface().symbol()}) {
       // procedure component with a pure interface
       return IsPureProcedure(*procInterface);
     }
   } else if (const auto *details{symbol.detailsIf<ProcBindingDetails>()}) {
     return IsPureProcedure(details->symbol());
   } else if (!IsProcedure(symbol)) {

flang/lib/Semantics/resolve-names.cpp

if (prev) {
     }
     name.symbol = nullptr;
   }
   auto &symbol{DeclareObjectEntity(name)};
   if (symbol.GetType()) {
     // 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)}});
 }
 
 // We need to make sure that all of the index-names get declared before the
 // expressions in the loop control are evaluated so that references to the
 // index-names in the expressions are correctly detected.
 bool ConstructVisitor::Pre(const parser::ConcurrentHeader &header) {
   BeginDeclTypeSpec();

flang/test/Semantics/resolve99.f90

+! 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