[flang-commits] [flang] [flang] Catch more initialization errors (PR #77850)

[Peter Klausler via flang-commits]

https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/77850

>From e80d1b1975610244a852ff58202ea9e14bad3027 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Thu, 11 Jan 2024 11:54:55 -0800
Subject: [PATCH] [flang] Catch more initialization errors

Diagnose some error cases related to initialization that are
slipping past semantic checking: don't allow multiple initializations
of the same symbol, and don't allow an object that was initialized
as a scalar to become an array afterward.

Fixes llvm-test-suite/Fortran/gfortran/regression/initialization_17.f90.
---
 flang/lib/Semantics/resolve-names.cpp | 16 +++++++++++++++-
 flang/test/Semantics/init01.f90       | 18 ++++++++++++++++++
 flang/test/Semantics/pointer01.f90    |  1 -
 3 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 64fc7de120873a..6f3241464fb6d5 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -4554,6 +4554,9 @@ bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) {
   }
   const auto &expr{std::get<parser::ConstantExpr>(x.t)};
   auto &details{symbol.get<ObjectEntityDetails>()};
+  if (details.init() || symbol.test(Symbol::Flag::InDataStmt)) {
+    Say(name, "Named constant '%s' already has a value"_err_en_US);
+  }
   if (inOldStyleParameterStmt_) {
     // non-standard extension PARAMETER statement (no parentheses)
     Walk(expr);
@@ -4932,6 +4935,8 @@ Symbol &DeclarationVisitor::DeclareObjectEntity(
       } else if (MustBeScalar(symbol)) {
         Say(name,
             "'%s' appeared earlier as a scalar actual argument to a specification function"_warn_en_US);
+      } else if (details->init() || symbol.test(Symbol::Flag::InDataStmt)) {
+        Say(name, "'%s' was initialized earlier as a scalar"_err_en_US);
       } else {
         details->set_shape(arraySpec());
       }
@@ -7566,9 +7571,11 @@ void DeclarationVisitor::Initialization(const parser::Name &name,
                     "Pointer initializer must be intrinsic NULL()"_err_en_US);
               } else if (IsPointer(ultimate)) {
                 if (auto *object{ultimate.detailsIf<ObjectEntityDetails>()}) {
+                  CHECK(!object->init());
                   object->set_init(std::move(*nullInit));
                 } else if (auto *procPtr{
                                ultimate.detailsIf<ProcEntityDetails>()}) {
+                  CHECK(!procPtr->init());
                   procPtr->set_init(nullptr);
                 }
               } else {
@@ -7668,6 +7675,8 @@ void DeclarationVisitor::NonPointerInitialization(
             "'%s' is a pointer but is not initialized like one"_err_en_US);
       } else if (auto *details{ultimate.detailsIf<ObjectEntityDetails>()}) {
         if (details->init()) {
+          SayWithDecl(name, *name.symbol,
+              "'%s' has already been initialized"_err_en_US);
         } else if (IsAllocatable(ultimate)) {
           Say(name, "Allocatable object '%s' cannot be initialized"_err_en_US);
         } else if (ultimate.owner().IsParameterizedDerivedType()) {
@@ -8905,7 +8914,12 @@ class DeferredCheckVisitor {
         resolver_.PointerInitialization(name, *target);
       } else if (const auto *expr{
                      std::get_if<parser::ConstantExpr>(&init->u)}) {
-        resolver_.NonPointerInitialization(name, *expr);
+        if (name.symbol) {
+          if (const auto *object{name.symbol->detailsIf<ObjectEntityDetails>()};
+              !object || !object->init()) {
+            resolver_.NonPointerInitialization(name, *expr);
+          }
+        }
       }
     }
   }
diff --git a/flang/test/Semantics/init01.f90 b/flang/test/Semantics/init01.f90
index 0f5a2144c79f97..f58c034d5deab2 100644
--- a/flang/test/Semantics/init01.f90
+++ b/flang/test/Semantics/init01.f90
@@ -106,3 +106,21 @@ subroutine notObjects
 !ERROR: 'x4' is not a pointer but is initialized like one
   real, intrinsic :: x4 => cos
 end subroutine
+
+subroutine edgeCases
+  integer :: j = 1, m = 2
+  !ERROR: Data statement object must be a variable
+  data k/3/
+  data n/4/
+  !ERROR: Named constant 'j' already has a value
+  parameter(j = 5)
+  !ERROR: Named constant 'k' already has a value
+  parameter(k = 6)
+  parameter(l = 7)
+  !ERROR: 'm' was initialized earlier as a scalar
+  dimension m(1)
+  !ERROR: 'l' was initialized earlier as a scalar
+  dimension l(1)
+  !ERROR: 'n' was initialized earlier as a scalar
+  dimension n(1)
+end
diff --git a/flang/test/Semantics/pointer01.f90 b/flang/test/Semantics/pointer01.f90
index 9e87d1b689eb2b..cb860f3a3f437c 100644
--- a/flang/test/Semantics/pointer01.f90
+++ b/flang/test/Semantics/pointer01.f90
@@ -16,7 +16,6 @@ program main
   !ERROR: 'inner' cannot have the POINTER attribute
   pointer inner
   real obj
-  !ERROR: 'ip' is a pointer but is not initialized like one
   !ERROR: 'ip' may not have both the POINTER and PARAMETER attributes
   integer, parameter :: ip = 123
   pointer ip