diff --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp index d6f1351c12d3c..5459290e59103 100644 --- a/flang/lib/Semantics/check-data.cpp +++ b/flang/lib/Semantics/check-data.cpp @@ -257,9 +257,7 @@ void DataChecker::Leave(const parser::DataStmtSet &set) { currentSetHasFatalErrors_ = false; } -// Handle legacy DATA-style initialization, e.g. REAL PI/3.14159/, for -// variables and components (esp. for DEC STRUCTUREs) -template void DataChecker::LegacyDataInit(const A &decl) { +void DataChecker::Leave(const parser::EntityDecl &decl) { if (const auto &init{ std::get>(decl.t)}) { const Symbol *name{std::get(decl.t).symbol}; @@ -272,14 +270,6 @@ template void DataChecker::LegacyDataInit(const A &decl) { } } -void DataChecker::Leave(const parser::ComponentDecl &decl) { - LegacyDataInit(decl); -} - -void DataChecker::Leave(const parser::EntityDecl &decl) { - LegacyDataInit(decl); -} - void DataChecker::CompileDataInitializationsIntoInitializers() { ConvertToInitializers(inits_, exprAnalyzer_); } diff --git a/flang/lib/Semantics/check-data.h b/flang/lib/Semantics/check-data.h index 479d32568fa66..8cd2ac912f1f8 100644 --- a/flang/lib/Semantics/check-data.h +++ b/flang/lib/Semantics/check-data.h @@ -37,10 +37,7 @@ class DataChecker : public virtual BaseChecker { void Enter(const parser::DataImpliedDo &); void Leave(const parser::DataImpliedDo &); void Leave(const parser::DataStmtSet &); - // These cases are for legacy DATA-like /initializations/ - void Leave(const parser::ComponentDecl &); void Leave(const parser::EntityDecl &); - // After all DATA statements have been processed, converts their // initializations into per-symbol static initializers. void CompileDataInitializationsIntoInitializers(); diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index b7c7603d667d8..c8e458ecc0f2d 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -7,6 +7,7 @@ #include "resolve-names.h" #include "assignment.h" +#include "data-to-inits.h" #include "definable.h" #include "mod-file.h" #include "pointer-assignment.h" @@ -1081,8 +1082,12 @@ class DeclarationVisitor : public ArraySpecVisitor, const parser::Name &, const parser::InitialDataTarget &); void PointerInitialization( const parser::Name &, const parser::ProcPointerInit &); + bool CheckNonPointerInitialization( + const parser::Name &, bool inLegacyDataInitialization); void NonPointerInitialization( const parser::Name &, const parser::ConstantExpr &); + void LegacyDataInitialization(const parser::Name &, + const std::list> &values); void CheckExplicitInterface(const parser::Name &); void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &); @@ -8995,6 +9000,14 @@ void DeclarationVisitor::Initialization(const parser::Name &name, ultimate.set(Symbol::Flag::InDataStmt); } }, + [&](const std::list> &values) { + Walk(values); + if (inComponentDecl) { + LegacyDataInitialization(name, values); + } else { + ultimate.set(Symbol::Flag::InDataStmt); + } + }, [&](const parser::NullInit &null) { // => NULL() Walk(null); if (auto nullInit{EvaluateExpr(null)}) { @@ -9028,11 +9041,6 @@ void DeclarationVisitor::Initialization(const parser::Name &name, ultimate.set(Symbol::Flag::InDataStmt); } }, - [&](const std::list> &values) { - // Handled later in data-to-inits conversion - ultimate.set(Symbol::Flag::InDataStmt); - Walk(values); - }, }, init.u); } @@ -9103,36 +9111,82 @@ void DeclarationVisitor::PointerInitialization( } } -void DeclarationVisitor::NonPointerInitialization( - const parser::Name &name, const parser::ConstantExpr &expr) { +bool DeclarationVisitor::CheckNonPointerInitialization( + const parser::Name &name, bool inLegacyDataInitialization) { if (!context().HasError(name.symbol)) { Symbol &ultimate{name.symbol->GetUltimate()}; if (!context().HasError(ultimate)) { - if (IsPointer(ultimate)) { + if (IsPointer(ultimate) && !inLegacyDataInitialization) { Say(name, "'%s' is a pointer but is not initialized like one"_err_en_US); } else if (auto *details{ultimate.detailsIf()}) { if (details->init()) { SayWithDecl(name, *name.symbol, "'%s' has already been initialized"_err_en_US); - } else if (details->isCDefined()) { - context().Warn(common::UsageWarning::CdefinedInit, name.source, - "CDEFINED variable should not have an initializer"_warn_en_US); } else if (IsAllocatable(ultimate)) { Say(name, "Allocatable object '%s' cannot be initialized"_err_en_US); - } else if (ultimate.owner().IsParameterizedDerivedType()) { - // Save the expression for per-instantiation analysis. - details->set_unanalyzedPDTComponentInit(&expr.thing.value()); - } else if (MaybeExpr folded{EvaluateNonPointerInitializer( - ultimate, expr, expr.thing.value().source)}) { - details->set_init(std::move(*folded)); - ultimate.set(Symbol::Flag::InDataStmt, false); + } else { + if (details->isCDefined()) { + context().Warn(common::UsageWarning::CdefinedInit, name.source, + "CDEFINED variable should not have an initializer"_warn_en_US); + } + return true; } } else { Say(name, "'%s' is not an object that can be initialized"_err_en_US); } } } + return false; +} + +void DeclarationVisitor::NonPointerInitialization( + const parser::Name &name, const parser::ConstantExpr &expr) { + if (CheckNonPointerInitialization( + name, /*inLegacyDataInitialization=*/false)) { + Symbol &ultimate{name.symbol->GetUltimate()}; + auto &details{ultimate.get()}; + if (ultimate.owner().IsParameterizedDerivedType()) { + // Save the expression for per-instantiation analysis. + details.set_unanalyzedPDTComponentInit(&expr.thing.value()); + } else if (MaybeExpr folded{EvaluateNonPointerInitializer( + ultimate, expr, expr.thing.value().source)}) { + details.set_init(std::move(*folded)); + ultimate.set(Symbol::Flag::InDataStmt, false); + } + } +} + +void DeclarationVisitor::LegacyDataInitialization(const parser::Name &name, + const std::list> &values) { + if (CheckNonPointerInitialization( + name, /*inLegacyDataInitialization=*/true)) { + Symbol &ultimate{name.symbol->GetUltimate()}; + if (ultimate.owner().IsParameterizedDerivedType()) { + Say(name, + "Component '%s' in a parameterized data type may not be initialized with a legacy DATA-style value list"_err_en_US, + name.source); + } else { + evaluate::ExpressionAnalyzer exprAnalyzer{context()}; + for (const auto &value : values) { + exprAnalyzer.Analyze(value.value()); + } + DataInitializations inits; + auto oldSize{ultimate.size()}; + if (auto chars{evaluate::characteristics::TypeAndShape::Characterize( + ultimate, GetFoldingContext())}) { + if (auto size{evaluate::ToInt64( + chars->MeasureSizeInBytes(GetFoldingContext()))}) { + // Temporarily set the byte size of the component so that we don't + // get bogus "initialization out of range" errors below. + ultimate.set_size(*size); + } + } + AccumulateDataInitializations(inits, exprAnalyzer, ultimate, values); + ConvertToInitializers(inits, exprAnalyzer); + ultimate.set_size(oldSize); + } + } } void ResolveNamesVisitor::HandleCall( @@ -10482,12 +10536,16 @@ class DeferredCheckVisitor { if (const auto *target{ std::get_if(&init->u)}) { resolver_.PointerInitialization(name, *target); - } else if (const auto *expr{ - std::get_if(&init->u)}) { - if (name.symbol) { - if (const auto *object{name.symbol->detailsIf()}; - !object || !object->init()) { + } else if (name.symbol) { + if (const auto *object{name.symbol->detailsIf()}; + !object || !object->init()) { + if (const auto *expr{std::get_if(&init->u)}) { resolver_.NonPointerInitialization(name, *expr); + } else { + // Don't check legacy DATA /initialization/ here. Component + // initializations will have already been handled, and variable + // initializations need to be done in DATA checking so that + // EQUIVALENCE storage association can be handled. } } } diff --git a/flang/test/Semantics/bug161989.f90 b/flang/test/Semantics/bug161989.f90 new file mode 100644 index 0000000000000..6185cdea24b58 --- /dev/null +++ b/flang/test/Semantics/bug161989.f90 @@ -0,0 +1,28 @@ +!RUN: %python %S/test_errors.py %s %flang_fc1 +program test + real, target :: x + type t1 + integer :: j/1/ + real, pointer :: ap/x/ + end type + type, extends(t1) :: t2 + integer :: k/2/ + end type + type t3(k) + integer, kind :: k + !ERROR: Component 'j' in a parameterized data type may not be initialized with a legacy DATA-style value list + integer :: j/3/ + end type + type t4 + !ERROR: DATA statement set has more values than objects + integer j(1) /4, 5/ + end type + type t5 + integer uninitialized + end type + type(t2), parameter :: x2 = t2() !ok + integer(kind=merge(1,-1,x2%j==1)) tx2j + integer(kind=merge(2,-1,x2%k==2)) tx2k + !ERROR: Structure constructor lacks a value for component 'uninitialized' + type(t5), parameter :: x5 = t5() +end diff --git a/flang/test/Semantics/data21.f90 b/flang/test/Semantics/data21.f90 index 639f78440840a..181ae441a644a 100644 --- a/flang/test/Semantics/data21.f90 +++ b/flang/test/Semantics/data21.f90 @@ -1,6 +1,6 @@ ! RUN: %flang_fc1 -fdebug-dump-symbols %s 2>&1 | FileCheck %s ! Ensure that DATA-like default component initializers work. -! CHECK: j (InDataStmt) size=4 offset=0: ObjectEntity type: INTEGER(4) init:123_4 +! CHECK: j size=4 offset=0: ObjectEntity type: INTEGER(4) init:123_4 type t integer j/123/ end type