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

[Peter Steinfeld via flang-commits]

Author: Peter Steinfeld
Date: 2020-12-10T07:36:41-08:00
New Revision: 9168a0f515c908dc3c3df822f17d489ec8a0caf2

URL: https://github.com/llvm/llvm-project/commit/9168a0f515c908dc3c3df822f17d489ec8a0caf2
DIFF: https://github.com/llvm/llvm-project/commit/9168a0f515c908dc3c3df822f17d489ec8a0caf2.diff

LOG: [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

Added: 
    flang/test/Semantics/resolve99.f90

Modified: 
    flang/include/flang/Evaluate/tools.h
    flang/lib/Evaluate/tools.cpp
    flang/lib/Semantics/resolve-names.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index e7305d47ed10..0501023116d9 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 1ae0fce193b1..452ff0f35841 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<Symbol *>(
+      GetAssociationRoot(const_cast<const Symbol &>(symbol)));
+}
+
 bool IsVariableName(const Symbol &symbol) {
   const Symbol *root{GetAssociationRoot(symbol)};
   return root && root->has<ObjectEntityDetails>() && !IsNamedConstant(*root);

diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 0d2b8813c7bb..b0e0b0b80ebf 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<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)}});

diff  --git a/flang/test/Semantics/resolve99.f90 b/flang/test/Semantics/resolve99.f90
new file mode 100644
index 000000000000..a1c8c10af4ee
--- /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