[flang-commits] [flang] 681978d - [flang] Duplicate names for ac-implied-do variables erroneously cause errors

[Peter Steinfeld via flang-commits]

Author: Peter Steinfeld
Date: 2020-11-16T18:57:13-08:00
New Revision: 681978d3b4e8fab98dd5c5c1f1687d3eff790a95

URL: https://github.com/llvm/llvm-project/commit/681978d3b4e8fab98dd5c5c1f1687d3eff790a95
DIFF: https://github.com/llvm/llvm-project/commit/681978d3b4e8fab98dd5c5c1f1687d3eff790a95.diff

LOG: [flang] Duplicate names for ac-implied-do variables erroneously cause errors

According to section 19.4, paragraph 5, the scope of an ac-implied-do variable
is the enclosing ac-implied-do.  But we were not creating new scopes upon
entry to an ac-implied-do.  This was causing error messages to be erroneously
emitted.

I fixed, the code, added a test to array-constr-values.f90, added the test
folding15.f90 and corrected the test symbol05.f90.

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

Added: 
    flang/test/Evaluate/folding15.f90

Modified: 
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/array-constr-values.f90
    flang/test/Semantics/symbol05.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f2b88ba8117f..e8791931715b 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -4995,14 +4995,18 @@ bool ConstructVisitor::Pre(const parser::AcSpec &x) {
   return false;
 }
 
+// Section 19.4, paragraph 5 says that each ac-do-variable has the scope of the
+// enclosing ac-implied-do
 bool ConstructVisitor::Pre(const parser::AcImpliedDo &x) {
   auto &values{std::get<std::list<parser::AcValue>>(x.t)};
   auto &control{std::get<parser::AcImpliedDoControl>(x.t)};
   auto &type{std::get<std::optional<parser::IntegerTypeSpec>>(control.t)};
   auto &bounds{std::get<parser::AcImpliedDoControl::Bounds>(control.t)};
+  PushScope(Scope::Kind::ImpliedDos, nullptr);
   DeclareStatementEntity(bounds.name.thing.thing, type);
   Walk(bounds);
   Walk(values);
+  PopScope();
   return false;
 }
 

diff  --git a/flang/test/Evaluate/folding15.f90 b/flang/test/Evaluate/folding15.f90
new file mode 100644
index 000000000000..7c0df868ddba
--- /dev/null
+++ b/flang/test/Evaluate/folding15.f90
@@ -0,0 +1,11 @@
+! RUN: %S/test_folding.sh %s %t %f18
+! Test folding of array constructors with duplicate names for the implied
+! DO variables
+module m1
+  integer, parameter :: expected(12) = [1, 2, 4, 6, 1, 2, 4, 6, 1, 2, 3, 6]
+  integer, parameter :: dups(12) = &
+    [ ((iDuplicate, iDuplicate = 1,j), &
+       (2 * iDuplicate, iDuplicate = j,3 ), &
+        j = 1,3 ) ]
+  logical, parameter :: test_dups = all(dups == expected)
+end module

diff  --git a/flang/test/Semantics/array-constr-values.f90 b/flang/test/Semantics/array-constr-values.f90
index 2d815a3559c9..38d1024cf957 100644
--- a/flang/test/Semantics/array-constr-values.f90
+++ b/flang/test/Semantics/array-constr-values.f90
@@ -55,9 +55,14 @@ subroutine checkC7115()
   real, dimension(10), parameter :: good1 = [(99.9, i = 1, 10)]
   real, dimension(100), parameter :: good2 = [((88.8, i = 1, 10), j = 1, 10)]
   !ERROR: Implied DO index is active in surrounding implied DO loop and may not have the same name
-  !ERROR: 'i' is already declared in this scoping unit
   real, dimension(100), parameter :: bad = [((88.8, i = 1, 10), i = 1, 10)]
 
   !ERROR: The stride of an implied DO loop must not be zero
   integer, parameter :: bad2(*) = [(j, j=1,1,0)]
 end subroutine checkC7115
+subroutine checkOkDuplicates
+  real :: realArray(21) = &
+    [ ((1.0, iDuplicate = 1,j), &
+       (0.0, iDuplicate = j,3 ), &
+        j = 1,5 ) ]
+end subroutine

diff  --git a/flang/test/Semantics/symbol05.f90 b/flang/test/Semantics/symbol05.f90
index 2def77ed3a57..9fb6b43583cc 100644
--- a/flang/test/Semantics/symbol05.f90
+++ b/flang/test/Semantics/symbol05.f90
@@ -48,10 +48,10 @@ subroutine s3
   !DEF: /s3/Block1/t DerivedType
   type :: t
    !DEF: /s3/Block1/t/x ObjectEntity REAL(4)
-   !DEF: /s3/Block1/t/ImpliedDos1/i (Implicit) ObjectEntity INTEGER(4)
+   !DEF: /s3/Block1/t/ImpliedDos1/ImpliedDos1/i (Implicit) ObjectEntity INTEGER(4)
    real :: x(10) = [(i, i=1,10)]
    !DEF: /s3/Block1/t/y ObjectEntity REAL(4)
-   !DEF: /s3/Block1/t/ImpliedDos2/j ObjectEntity INTEGER(8)
+   !DEF: /s3/Block1/t/ImpliedDos2/ImpliedDos1/j ObjectEntity INTEGER(8)
    real :: y(10) = [(j, j=1,10)]
   end type
  end block