From 1ec4ec88bf8265fe15b93e9a074c70221f87c6a3 Mon Sep 17 00:00:00 2001
From: Tim Keith <tkeith@nvidia.com>
Date: Fri, 22 Feb 2019 15:56:39 -0800
Subject: [PATCH] [flang] Fix bug determining type of statement entity

A statement entity (`data-i-do-variable` or `ac-do-variable`) that
doesn't have a type specified gets the type it would have in the
enclosing scope. That means if there is a visible variable with the
same name, the statement entity gets its type. We were failing to
do that and just applying the implicit rules.

Original-commit: flang-compiler/f18@72bc7c29ba8d4be6a7c93080bb7fac7a3bc73577
Reviewed-on: https://github.com/flang-compiler/f18/pull/305
Tree-same-pre-rewrite: false
---
 flang/lib/semantics/resolve-names.cc | 33 +++++++++++++++++----------------
 flang/test/semantics/resolve30.f90   | 20 ++++++++++++++++++++
 flang/test/semantics/symbol05.f90    |  5 +++++
 3 files changed, 42 insertions(+), 16 deletions(-)

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index 549f1e5..8bebe31 100644
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -3631,31 +3631,32 @@ Symbol *DeclarationVisitor::DeclareLocalEntity(const parser::Name &name) {
 
 Symbol *DeclarationVisitor::DeclareStatementEntity(const parser::Name &name,
     const std::optional<parser::IntegerTypeSpec> &type) {
+  const DeclTypeSpec *declTypeSpec{nullptr};
   if (auto *prev{FindSymbol(name)}) {
     if (prev->owner() == currScope()) {
       SayAlreadyDeclared(name, *prev);
       return nullptr;
     }
     name.symbol = nullptr;
+    declTypeSpec = prev->GetType();
   }
   Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, {})};
-  if (symbol.has<ObjectEntityDetails>()) {
-    const DeclTypeSpec *declTypeSpec{nullptr};
-    if (type.has_value()) {
-      BeginDeclTypeSpec();
-      DeclarationVisitor::Post(*type);
-      declTypeSpec = GetDeclTypeSpec();
-      EndDeclTypeSpec();
-    }
-    if (declTypeSpec != nullptr) {
-      SetType(name, *declTypeSpec);
-    } else {
-      ApplyImplicitRules(symbol);
-    }
-    CheckScalarIntegerType(name);
-    return Resolve(name, &symbol);
+  if (!symbol.has<ObjectEntityDetails>()) {
+    return nullptr;  // error was reported in DeclareEntity
   }
-  return nullptr;
+  if (type.has_value()) {
+    BeginDeclTypeSpec();
+    DeclarationVisitor::Post(*type);
+    declTypeSpec = GetDeclTypeSpec();
+    EndDeclTypeSpec();
+  }
+  if (declTypeSpec != nullptr) {
+    SetType(name, *declTypeSpec);
+  } else {
+    ApplyImplicitRules(symbol);
+  }
+  CheckScalarIntegerType(name);
+  return Resolve(name, &symbol);
 }
 
 // Set the type of an entity or report an error.
diff --git a/flang/test/semantics/resolve30.f90 b/flang/test/semantics/resolve30.f90
index 91d8778..e5b1eef 100644
--- a/flang/test/semantics/resolve30.f90
+++ b/flang/test/semantics/resolve30.f90
@@ -28,3 +28,23 @@ subroutine s2
     y = 1
   end block
 end
+
+subroutine s3
+  implicit none
+  integer :: i, j
+  block
+    import, none
+    !ERROR: No explicit type declared for 'i'
+    real :: a(16) = [(i, i=1, 16)]
+    !ERROR: No explicit type declared for 'j'
+    data(a(j), j=1, 16) / 16 * 0.0 /
+  end block
+end
+
+subroutine s4
+  real :: i, j
+  !ERROR: Variable 'i' is not integer
+  real :: a(16) = [(i, i=1, 16)]
+  !ERROR: Variable 'j' is not integer
+  data(a(j), j=1, 16) / 16 * 0.0 /
+end
diff --git a/flang/test/semantics/symbol05.f90 b/flang/test/semantics/symbol05.f90
index a0d24e9..14c346b 100644
--- a/flang/test/semantics/symbol05.f90
+++ b/flang/test/semantics/symbol05.f90
@@ -55,12 +55,17 @@ end subroutine
 
 !DEF: /s3 Subprogram
 subroutine s3
+ !DEF: /s3/j ObjectEntity INTEGER(8)
+ integer(kind=8) j
  block
   !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)
    real :: x(10) = [(i, i=1,10)]
+   !DEF: /s3/Block1/t/y ObjectEntity REAL(4)
+   !DEF: /s3/Block1/t/ImpliedDos2/j ObjectEntity INTEGER(8)
+   real :: y(10) = [(j, j=1,10)]
   end type
  end block
 end subroutine
-- 
2.7.4