[flang-commits] [flang] Initialization17 (PR #77850)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Thu Jan 11 15:23:03 PST 2024
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/77850
None
>From d6638045dd812e0f38303a4edaf786a6512a4975 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 1/2] wip
---
flang/lib/Semantics/resolve-names.cpp | 15 ++++++++++++++-
1 file changed, 14 insertions(+), 1 deletion(-)
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 64fc7de120873a..9c1274226ee537 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -4554,6 +4554,10 @@ bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) {
}
const auto &expr{std::get<parser::ConstantExpr>(x.t)};
auto &details{symbol.get<ObjectEntityDetails>()};
+ if (details.init()) {
+ SayWithDecl(
+ name, symbol, "Named constant '%s' already has a value"_err_en_US);
+ }
if (inOldStyleParameterStmt_) {
// non-standard extension PARAMETER statement (no parentheses)
Walk(expr);
@@ -7566,9 +7570,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 +7674,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 +8913,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);
+ }
+ }
}
}
}
>From a0e908f61b1a24ab178a7e45ab9660623c9e72e6 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Thu, 11 Jan 2024 15:20:03 -0800
Subject: [PATCH 2/2] [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 | 9 +++++----
flang/test/Semantics/init01.f90 | 18 ++++++++++++++++++
flang/test/Semantics/pointer01.f90 | 1 -
3 files changed, 23 insertions(+), 5 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 9c1274226ee537..6f3241464fb6d5 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -4554,9 +4554,8 @@ bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) {
}
const auto &expr{std::get<parser::ConstantExpr>(x.t)};
auto &details{symbol.get<ObjectEntityDetails>()};
- if (details.init()) {
- SayWithDecl(
- name, symbol, "Named constant '%s' already has a value"_err_en_US);
+ 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)
@@ -4936,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());
}
@@ -8915,7 +8916,7 @@ class DeferredCheckVisitor {
std::get_if<parser::ConstantExpr>(&init->u)}) {
if (name.symbol) {
if (const auto *object{name.symbol->detailsIf<ObjectEntityDetails>()};
- object && !object->init()) {
+ !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
More information about the flang-commits
mailing list