[flang] Weird restrictions on index variables (llvm#77019)

klausler · web-flow · commit 90828d67ea35 · 2024-01-15T10:50:40.000-08:00
There are some very odd (even for Fortran) rules in F'2023 subclause 19.4 (paras 6 & 8) pertaining to the index variables of FORALL and DO CONCURRENT constructs/statements, and they are not currently implemented correctly. Although these index variables are construct entities, they have restrictions in the standard that would essentially allow them to also be variables in their enclosing scopes. If their names are present in the enclosing scope, and the construct does not have an explicit type specification for its indices, then the names in the enclosing scope must either be scalar variables or COMMON blocks, and their type must be integer. Reimplement these restrictions largely with portability warnings rather than hard errors. Retain the semantic interpretation that the type of an untyped index variable be taken from the type of a variable of the same name in the enclosing scope, if it exists, although that bit of the standard could be interpreted otherwise. Fixes llvm#76978.
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
@@ -96,6 +96,12 @@ end
 * `NULL()` without `MOLD=` is not allowed to be associated as an
   actual argument corresponding to an assumed-rank dummy argument;
   its rank in the called procedure would not be well-defined.
+* When an index variable of a `FORALL` or `DO CONCURRENT` is present
+  in the enclosing scope, and the construct does not have an explicit
+  type specification for its index variables, some weird restrictions
+  in F'2023 subclause 19.4 paragraphs 6 & 8 should apply.  Since this
+  compiler properly scopes these names, violations of these restrictions
+  elicit only portability warnings by default.
 
 ## Extensions, deletions, and legacy features supported by default
 
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
@@ -45,7 +45,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     MiscSourceExtensions, AllocateToOtherLength, LongNames, IntrinsicAsSpecific,
     BenignNameClash, BenignRedundancy, NullMoldAllocatableComponentValue,
     NopassScalarBase, MiscUseExtensions, ImpliedDoIndexScope,
-    DistinctCommonSizes)
+    DistinctCommonSizes, OddIndexVariableRestrictions)
 
 // Portability and suspicious usage warnings for conforming code
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
@@ -6638,10 +6638,14 @@ void ConstructVisitor::ResolveIndexName(
   const parser::Name &name{std::get<parser::Name>(control.t)};
   auto *prev{FindSymbol(name)};
   if (prev) {
-    if (prev->owner().kind() == Scope::Kind::Forall ||
-        prev->owner() == currScope()) {
+    if (prev->owner() == currScope()) {
       SayAlreadyDeclared(name, *prev);
       return;
+    } else if (prev->owner().kind() == Scope::Kind::Forall &&
+        context().ShouldWarn(
+            common::LanguageFeature::OddIndexVariableRestrictions)) {
+      SayWithDecl(name, *prev,
+          "Index variable '%s' should not also be an index in an enclosing FORALL or DO CONCURRENT"_port_en_US);
     }
     name.symbol = nullptr;
   }
@@ -6651,22 +6655,26 @@ void ConstructVisitor::ResolveIndexName(
   } else if (!prev) {
     ApplyImplicitRules(symbol);
   } else {
-    const Symbol &prevRoot{prev->GetUltimate()};
-    // prev could be host- use- or construct-associated with another symbol
-    if (!prevRoot.has<ObjectEntityDetails>() &&
-        !prevRoot.has<AssocEntityDetails>()) {
-      Say2(name, "Index name '%s' conflicts with existing identifier"_err_en_US,
-          *prev, "Previous declaration of '%s'"_en_US);
-      context().SetError(symbol);
-      return;
+    // Odd rules in F'2023 19.4 paras 6 & 8.
+    Symbol &prevRoot{prev->GetUltimate()};
+    if (const auto *type{prevRoot.GetType()}) {
+      symbol.SetType(*type);
     } 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;
+      ApplyImplicitRules(symbol);
+    }
+    if (prevRoot.has<ObjectEntityDetails>() ||
+        ConvertToObjectEntity(prevRoot)) {
+      if (prevRoot.IsObjectArray() &&
+          context().ShouldWarn(
+              common::LanguageFeature::OddIndexVariableRestrictions)) {
+        SayWithDecl(name, *prev,
+            "Index variable '%s' should be scalar in the enclosing scope"_port_en_US);
       }
+    } else if (!prevRoot.has<CommonBlockDetails>() &&
+        context().ShouldWarn(
+            common::LanguageFeature::OddIndexVariableRestrictions)) {
+      SayWithDecl(name, *prev,
+          "Index variable '%s' should be a scalar object or common block if it is present in the enclosing scope"_port_en_US);
     }
   }
   EvaluateExpr(parser::Scalar{parser::Integer{common::Clone(name)}});
@@ -6839,7 +6847,10 @@ bool ConstructVisitor::Pre(const parser::DataStmtValue &x) {
 
 bool ConstructVisitor::Pre(const parser::DoConstruct &x) {
   if (x.IsDoConcurrent()) {
-    PushScope(Scope::Kind::OtherConstruct, nullptr);
+    // The new scope has Kind::Forall for index variable name conflict
+    // detection with nested FORALL/DO CONCURRENT constructs in
+    // ResolveIndexName().
+    PushScope(Scope::Kind::Forall, nullptr);
   }
   return true;
 }
diff --git a/flang/test/Semantics/dosemantics12.f90 b/flang/test/Semantics/dosemantics12.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
 !
 ! Licensed under the Apache License, Version 2.0 (the "License");
@@ -313,10 +313,10 @@ subroutine s9()
     end do
   end do
 
-  ! OK since the DO CONCURRENT index-name exists only in the scope of the
-  ! DO CONCURRENT construct
+  ! Technically non-conformant (F'2023 19.4 p8)
   do concurrent (ivar = 1:10)
     print *, "hello"
+    !PORTABILITY: Index variable 'ivar' should not also be an index in an enclosing FORALL or DO CONCURRENT
     do concurrent (ivar = 1:10)
       print *, "hello"
     end do
diff --git a/flang/test/Semantics/forall01.f90 b/flang/test/Semantics/forall01.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 subroutine forall1
   real :: a(9)
   !ERROR: 'i' is already declared in this scoping unit
@@ -10,8 +10,7 @@ subroutine forall1
     a(i) = i
   end forall
   forall (j=1:8)
-    !ERROR: 'j' is already declared in this scoping unit
-    !ERROR: Cannot redefine FORALL variable 'j'
+    !PORTABILITY: Index variable 'j' should not also be an index in an enclosing FORALL or DO CONCURRENT
     forall (j=1:9)
     end forall
   end forall
@@ -75,7 +74,6 @@ subroutine forall4
   forall(i=1:10:zero) a(i) = i
 end
 
-! Note: this gets warnings but not errors
 subroutine forall5
   real, target :: x(10), y(10)
   forall(i=1:10)
@@ -93,6 +91,8 @@ subroutine forall5
   endforall
   do concurrent(i=1:10)
     x = y
+    !Odd rule from F'2023 19.4 p8
+    !PORTABILITY: Index variable 'i' should not also be an index in an enclosing FORALL or DO CONCURRENT
     !WARNING: FORALL index variable 'i' not used on left-hand side of assignment
     forall(i=1:10) x = y
   end do
@@ -116,17 +116,20 @@ subroutine forall7(x)
   real :: a(10)
   class(*) :: x
   associate (j => iarr(1))
+    !PORTABILITY: Index variable 'j' should be a scalar object or common block if it is present in the enclosing scope
     forall (j=1:size(a))
       a(j) = a(j) + 1
     end forall
   end associate
   associate (j => iarr(1) + 1)
+    !PORTABILITY: Index variable 'j' should be a scalar object or common block if it is present in the enclosing scope
     forall (j=1:size(a))
       a(j) = a(j) + 1
     end forall
   end associate
   select type (j => x)
   type is (integer)
+    !PORTABILITY: Index variable 'j' should be a scalar object or common block if it is present in the enclosing scope
     forall (j=1:size(a))
       a(j) = a(j) + 1
     end forall
diff --git a/flang/test/Semantics/resolve35.f90 b/flang/test/Semantics/resolve35.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Construct names
 
 subroutine s1
@@ -21,11 +21,17 @@ subroutine s3
   real :: a(10,10), b(10,10)
   type y; end type
   integer(8) :: x
-  !ERROR: Index name 'y' conflicts with existing identifier
+  !PORTABILITY: Index variable 'y' should be a scalar object or common block if it is present in the enclosing scope
+  !ERROR: Must have INTEGER type, but is REAL(4)
   forall(x=1:10, y=1:10)
+    !ERROR: Must have INTEGER type, but is REAL(4)
+    !ERROR: Must have INTEGER type, but is REAL(4)
     a(x, y) = b(x, y)
   end forall
-  !ERROR: Index name 'y' conflicts with existing identifier
+  !PORTABILITY: Index variable 'y' should be a scalar object or common block if it is present in the enclosing scope
+  !ERROR: Must have INTEGER type, but is REAL(4)
+  !ERROR: Must have INTEGER type, but is REAL(4)
+  !ERROR: Must have INTEGER type, but is REAL(4)
   forall(x=1:10, y=1:10) a(x, y) = b(x, y)
 end
 
@@ -45,7 +51,7 @@ subroutine s4
     !ERROR: Must have INTEGER type, but is REAL(4)
     a(y) = b(y)
   end forall
-  !ERROR: Index variable 'i' is not scalar
+  !PORTABILITY: Index variable 'i' should be scalar in the enclosing scope
   forall(i=1:10)
     a(i) = b(i)
   end forall
@@ -55,7 +61,9 @@ subroutine s6
   integer, parameter :: n = 4
   real, dimension(n) :: x
   data(x(i), i=1, n) / n * 0.0 /
-  !ERROR: Index name 't' conflicts with existing identifier
+  !PORTABILITY: Index variable 't' should be a scalar object or common block if it is present in the enclosing scope
+  !ERROR: Must have INTEGER type, but is REAL(4)
+  !ERROR: Must have INTEGER type, but is REAL(4)
   forall(t=1:n) x(t) = 0.0
 contains
   subroutine t
diff --git a/flang/test/Semantics/resolve99.f90 b/flang/test/Semantics/resolve99.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Tests for the index-name of a FORALL statement
 
 module m1
@@ -31,7 +31,7 @@ subroutine constructAssoc()
     integer, dimension(4) :: table
     integer :: localVar
     associate (assocVar => localVar)
-      ! assocVar is construct associated with localVar
+      !PORTABILITY: Index variable 'assocvar' should be a scalar object or common block if it is present in the enclosing scope
       FORALL (assocVar=1:4) table(assocVar) = 343
     end associate
   end subroutine constructAssoc
@@ -44,7 +44,9 @@ end subroutine commonSub
 
   subroutine mismatch()
     integer, dimension(4) :: table
-    !ERROR: Index name 'typename' conflicts with existing identifier
+    !PORTABILITY: Index variable 'typename' should be a scalar object or common block if it is present in the enclosing scope
+    !ERROR: Must have INTEGER type, but is REAL(4)
+    !ERROR: Must have INTEGER type, but is REAL(4)
     FORALL (typeName=1:4) table(typeName) = 343
   end subroutine mismatch
 end program indexName
diff --git a/flang/test/Semantics/symbol09.f90 b/flang/test/Semantics/symbol09.f90
@@ -25,10 +25,10 @@ subroutine s2
  real a(10)
  !DEF: /s2/i ObjectEntity INTEGER(4)
  integer i
- !DEF: /s2/OtherConstruct1/i ObjectEntity INTEGER(4)
+ !DEF: /s2/Forall1/i ObjectEntity INTEGER(4)
  do concurrent(i=1:10)
   !REF: /s2/a
-  !REF: /s2/OtherConstruct1/i
+  !REF: /s2/Forall1/i
   a(i) = i
  end do
  !REF: /s2/i
@@ -104,14 +104,14 @@ subroutine s6
  integer(kind=8) j
  !DEF: /s6/a ObjectEntity INTEGER(4)
  integer :: a(5) = 1
- !DEF: /s6/OtherConstruct1/i ObjectEntity INTEGER(4)
- !DEF: /s6/OtherConstruct1/j (LocalityLocal) HostAssoc INTEGER(8)
- !DEF: /s6/OtherConstruct1/k (Implicit, LocalityLocalInit) HostAssoc INTEGER(4)
-  !DEF: /s6/OtherConstruct1/a (LocalityShared) HostAssoc INTEGER(4)
+ !DEF: /s6/Forall1/i ObjectEntity INTEGER(4)
+ !DEF: /s6/Forall1/j (LocalityLocal) HostAssoc INTEGER(8)
+ !DEF: /s6/Forall1/k (Implicit, LocalityLocalInit) HostAssoc INTEGER(4)
+ !DEF: /s6/Forall1/a (LocalityShared) HostAssoc INTEGER(4)
  do concurrent(integer::i=1:5)local(j)local_init(k)shared(a)
-  !REF: /s6/OtherConstruct1/a
-  !REF: /s6/OtherConstruct1/i
-  !REF: /s6/OtherConstruct1/j
+  !REF: /s6/Forall1/a
+  !REF: /s6/Forall1/i
+  !REF: /s6/Forall1/j
   a(i) = j+1
  end do
 end subroutine
