diff options
Diffstat (limited to 'flang/lib/Semantics/resolve-names.cpp')
| -rw-r--r-- | flang/lib/Semantics/resolve-names.cpp | 428 |
1 files changed, 265 insertions, 163 deletions
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 2f350f016c1f..699de417a629 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" @@ -357,6 +358,7 @@ protected: DeclTypeSpec::Category category{DeclTypeSpec::TypeDerived}; } derived; bool allowForwardReferenceToDerivedType{false}; + const parser::Expr *originalKindParameter{nullptr}; }; bool allowForwardReferenceToDerivedType() const { @@ -365,8 +367,10 @@ protected: void set_allowForwardReferenceToDerivedType(bool yes) { state_.allowForwardReferenceToDerivedType = yes; } + void set_inPDTDefinition(bool yes) { inPDTDefinition_ = yes; } - const DeclTypeSpec *GetDeclTypeSpec(); + const DeclTypeSpec *GetDeclTypeSpec() const; + const parser::Expr *GetOriginalKindParameter() const; void BeginDeclTypeSpec(); void EndDeclTypeSpec(); void SetDeclTypeSpec(const DeclTypeSpec &); @@ -380,6 +384,7 @@ protected: private: State state_; + bool inPDTDefinition_{false}; void MakeNumericType(TypeCategory, int kind); }; @@ -1081,8 +1086,12 @@ public: 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<common::Indirection<parser::DataStmtValue>> &values); void CheckExplicitInterface(const parser::Name &); void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &); @@ -1106,8 +1115,9 @@ protected: // or nullptr on error. Symbol *DeclareStatementEntity(const parser::DoVariable &, const std::optional<parser::IntegerTypeSpec> &); - Symbol &MakeCommonBlockSymbol(const parser::Name &); - Symbol &MakeCommonBlockSymbol(const std::optional<parser::Name> &); + Symbol &MakeCommonBlockSymbol(const parser::Name &, SourceName); + Symbol &MakeCommonBlockSymbol( + const std::optional<parser::Name> &, SourceName); bool CheckUseError(const parser::Name &); void CheckAccessibility(const SourceName &, bool, Symbol &); void CheckCommonBlocks(); @@ -1130,7 +1140,7 @@ protected: std::optional<SourceName> BeginCheckOnIndexUseInOwnBounds( const parser::DoVariable &name) { std::optional<SourceName> result{checkIndexUseInOwnBounds_}; - checkIndexUseInOwnBounds_ = name.thing.thing.source; + checkIndexUseInOwnBounds_ = parser::UnwrapRef<parser::Name>(name).source; return result; } void EndCheckOnIndexUseInOwnBounds(const std::optional<SourceName> &restore) { @@ -1244,8 +1254,6 @@ private: bool OkToAddComponent(const parser::Name &, const Symbol *extends = nullptr); ParamValue GetParamValue( const parser::TypeParamValue &, common::TypeParamAttr attr); - void CheckCommonBlockDerivedType( - const SourceName &, const Symbol &, UnorderedSymbolSet &); Attrs HandleSaveName(const SourceName &, Attrs); void AddSaveName(std::set<SourceName> &, const SourceName &); bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &); @@ -1387,6 +1395,8 @@ private: // Create scopes for OpenACC constructs class AccVisitor : public virtual DeclarationVisitor { public: + explicit AccVisitor(SemanticsContext &context) : context_{context} {} + void AddAccSourceRange(const parser::CharBlock &); static bool NeedsScope(const parser::OpenACCBlockConstruct &); @@ -1395,6 +1405,7 @@ public: void Post(const parser::OpenACCBlockConstruct &); bool Pre(const parser::OpenACCCombinedConstruct &); void Post(const parser::OpenACCCombinedConstruct &); + bool Pre(const parser::AccClause::UseDevice &x); bool Pre(const parser::AccBeginBlockDirective &x) { AddAccSourceRange(x.source); return true; @@ -1430,6 +1441,11 @@ public: void Post(const parser::AccBeginLoopDirective &x) { messageHandler().set_currStmtSource(std::nullopt); } + + void CopySymbolWithDevice(const parser::Name *name); + +private: + SemanticsContext &context_; }; bool AccVisitor::NeedsScope(const parser::OpenACCBlockConstruct &x) { @@ -1459,6 +1475,60 @@ bool AccVisitor::Pre(const parser::OpenACCBlockConstruct &x) { return true; } +void AccVisitor::CopySymbolWithDevice(const parser::Name *name) { + // When CUDA Fortran is enabled together with OpenACC, new + // symbols are created for the one appearing in the use_device + // clause. These new symbols have the CUDA Fortran device + // attribute. + if (context_.languageFeatures().IsEnabled(common::LanguageFeature::CUDA)) { + name->symbol = currScope().CopySymbol(*name->symbol); + if (auto *object{name->symbol->detailsIf<ObjectEntityDetails>()}) { + object->set_cudaDataAttr(common::CUDADataAttr::Device); + } + } +} + +bool AccVisitor::Pre(const parser::AccClause::UseDevice &x) { + for (const auto &accObject : x.v.v) { + common::visit( + common::visitors{ + [&](const parser::Designator &designator) { + if (const auto *name{ + semantics::getDesignatorNameIfDataRef(designator)}) { + Symbol *prev{currScope().FindSymbol(name->source)}; + if (prev != name->symbol) { + name->symbol = prev; + } + CopySymbolWithDevice(name); + } else { + if (const auto *dataRef{ + std::get_if<parser::DataRef>(&designator.u)}) { + using ElementIndirection = + common::Indirection<parser::ArrayElement>; + if (auto *ind{std::get_if<ElementIndirection>(&dataRef->u)}) { + const parser::ArrayElement &arrayElement{ind->value()}; + Walk(arrayElement.subscripts); + const parser::DataRef &base{arrayElement.base}; + if (auto *name{std::get_if<parser::Name>(&base.u)}) { + Symbol *prev{currScope().FindSymbol(name->source)}; + if (prev != name->symbol) { + name->symbol = prev; + } + CopySymbolWithDevice(name); + } + } + } + } + }, + [&](const parser::Name &name) { + // TODO: common block in use_device? + }, + }, + accObject.u); + } + return false; +} + void AccVisitor::Post(const parser::OpenACCBlockConstruct &x) { if (NeedsScope(x)) { PopScope(); @@ -1618,12 +1688,14 @@ public: void Post(const parser::OpenMPDeclareTargetConstruct &) { SkipImplicitTyping(false); } - bool Pre(const parser::OpenMPDeclarativeAllocate &) { + bool Pre(const parser::OpenMPDeclarativeAllocate &x) { + AddOmpSourceRange(x.source); SkipImplicitTyping(true); return true; } void Post(const parser::OpenMPDeclarativeAllocate &) { SkipImplicitTyping(false); + messageHandler().set_currStmtSource(std::nullopt); } bool Pre(const parser::OpenMPDeclarativeConstruct &x) { AddOmpSourceRange(x.source); @@ -2036,7 +2108,8 @@ public: ResolveNamesVisitor( SemanticsContext &context, ImplicitRulesMap &rules, Scope &top) - : BaseVisitor{context, *this, rules}, topScope_{top} { + : BaseVisitor{context, *this, rules}, AccVisitor(context), + topScope_{top} { PushScope(top); } @@ -2057,7 +2130,7 @@ public: void Post(const parser::SubstringInquiry &); template <typename A, typename B> void Post(const parser::LoopBounds<A, B> &x) { - ResolveName(*parser::Unwrap<parser::Name>(x.name)); + ResolveName(parser::UnwrapRef<parser::Name>(x.name)); } void Post(const parser::ProcComponentRef &); bool Pre(const parser::FunctionReference &); @@ -2390,9 +2463,12 @@ bool AttrsVisitor::Pre(const common::CUDADataAttr x) { // DeclTypeSpecVisitor implementation -const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() { +const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() const { return state_.declTypeSpec; } +const parser::Expr *DeclTypeSpecVisitor::GetOriginalKindParameter() const { + return state_.originalKindParameter; +} void DeclTypeSpecVisitor::BeginDeclTypeSpec() { CHECK(!state_.expectDeclTypeSpec); @@ -2477,6 +2553,21 @@ void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) { KindExpr DeclTypeSpecVisitor::GetKindParamExpr( TypeCategory category, const std::optional<parser::KindSelector> &kind) { + if (inPDTDefinition_) { + if (category != TypeCategory::Derived && kind) { + if (const auto *expr{ + std::get_if<parser::ScalarIntConstantExpr>(&kind->u)}) { + CHECK(!state_.originalKindParameter); + // Save a pointer to the KIND= expression in the parse tree + // in case we need to reanalyze it during PDT instantiation. + state_.originalKindParameter = parser::Unwrap<parser::Expr>(expr); + } + } + // Inhibit some errors now that will be caught later during instantiations. + auto restorer{ + context().foldingContext().AnalyzingPDTComponentKindSelector()}; + return AnalyzeKindSelector(context(), category, kind); + } return AnalyzeKindSelector(context(), category, kind); } @@ -3898,8 +3989,26 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, } } + auto AreSameModuleProcOrBothInterfaces{[](const Symbol &p1, + const Symbol &p2) { + if (IsProcedure(p1) && !IsPointer(p1) && IsProcedure(p2) && + !IsPointer(p2)) { + auto classification{ClassifyProcedure(p1)}; + if (classification == ClassifyProcedure(p2)) { + if (classification == ProcedureDefinitionClass::External) { + const auto *subp1{p1.detailsIf<SubprogramDetails>()}; + const auto *subp2{p2.detailsIf<SubprogramDetails>()}; + return subp1 && subp1->isInterface() && subp2 && subp2->isInterface(); + } else if (classification == ProcedureDefinitionClass::Module) { + return AreSameModuleSymbol(p1, p2); + } + } + } + return false; + }}; + auto AreSameProcedure{[&](const Symbol &p1, const Symbol &p2) { - if (&p1 == &p2) { + if (&p1.GetUltimate() == &p2.GetUltimate()) { return true; } else if (p1.name() != p2.name()) { return false; @@ -3907,31 +4016,16 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, p2.attrs().test(Attr::INTRINSIC)) { return p1.attrs().test(Attr::INTRINSIC) && p2.attrs().test(Attr::INTRINSIC); - } else if (!IsProcedure(p1) || !IsProcedure(p2)) { - return false; - } else if (IsPointer(p1) || IsPointer(p2)) { - return false; - } else if (const auto *subp{p1.detailsIf<SubprogramDetails>()}; - subp && !subp->isInterface()) { - return false; // defined in module, not an external - } else if (const auto *subp{p2.detailsIf<SubprogramDetails>()}; - subp && !subp->isInterface()) { - return false; // defined in module, not an external + } else if (AreSameModuleProcOrBothInterfaces(p1, p2)) { + // Both are external interfaces, perhaps to the same procedure, + // or both are module procedures from modules with the same name. + auto p1Chars{evaluate::characteristics::Procedure::Characterize( + p1, GetFoldingContext())}; + auto p2Chars{evaluate::characteristics::Procedure::Characterize( + p2, GetFoldingContext())}; + return p1Chars && p2Chars && *p1Chars == *p2Chars; } else { - // Both are external interfaces, perhaps to the same procedure - auto class1{ClassifyProcedure(p1)}; - auto class2{ClassifyProcedure(p2)}; - if (class1 == ProcedureDefinitionClass::External && - class2 == ProcedureDefinitionClass::External) { - auto chars1{evaluate::characteristics::Procedure::Characterize( - p1, GetFoldingContext())}; - auto chars2{evaluate::characteristics::Procedure::Characterize( - p2, GetFoldingContext())}; - // same procedure interface defined identically in two modules? - return chars1 && chars2 && *chars1 == *chars2; - } else { - return false; - } + return false; } }}; @@ -4032,13 +4126,32 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, localSymbol = &newSymbol; } if (useGeneric) { - // Combine two use-associated generics + // Combine two use-associated generics. localSymbol->attrs() = useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE}; localSymbol->flags() = useSymbol.flags(); AddGenericUse(*localGeneric, localName, useUltimate); - localGeneric->clear_derivedType(); - localGeneric->CopyFrom(*useGeneric); + // Don't duplicate specific procedures. + std::size_t originalLocalSpecifics{localGeneric->specificProcs().size()}; + std::size_t useSpecifics{useGeneric->specificProcs().size()}; + CHECK(originalLocalSpecifics == localGeneric->bindingNames().size()); + CHECK(useSpecifics == useGeneric->bindingNames().size()); + std::size_t j{0}; + for (const Symbol &useSpecific : useGeneric->specificProcs()) { + SourceName useBindingName{useGeneric->bindingNames()[j++]}; + bool isDuplicate{false}; + std::size_t k{0}; + for (const Symbol &localSpecific : localGeneric->specificProcs()) { + if (localGeneric->bindingNames()[k++] == useBindingName && + AreSameProcedure(localSpecific, useSpecific)) { + isDuplicate = true; + break; + } + } + if (!isDuplicate) { + localGeneric->AddSpecificProc(useSpecific, useBindingName); + } + } } localGeneric->clear_derivedType(); if (combinedDerivedType) { @@ -5499,7 +5612,7 @@ bool DeclarationVisitor::Pre(const parser::BindEntity &x) { if (kind == parser::BindEntity::Kind::Object) { symbol = &HandleAttributeStmt(Attr::BIND_C, name); } else { - symbol = &MakeCommonBlockSymbol(name); + symbol = &MakeCommonBlockSymbol(name, name.source); SetExplicitAttr(*symbol, Attr::BIND_C); } // 8.6.4(1) @@ -5536,6 +5649,7 @@ bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) { if (details->init() || symbol.test(Symbol::Flag::InDataStmt)) { Say(name, "Named constant '%s' already has a value"_err_en_US); } + parser::CharBlock at{parser::UnwrapRef<parser::Expr>(expr).source}; if (inOldStyleParameterStmt_) { // non-standard extension PARAMETER statement (no parentheses) Walk(expr); @@ -5544,7 +5658,6 @@ bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) { SayWithDecl(name, symbol, "Alternative style PARAMETER '%s' must not already have an explicit type"_err_en_US); } else if (folded) { - auto at{expr.thing.value().source}; if (evaluate::IsActuallyConstant(*folded)) { if (const auto *type{currScope().GetType(*folded)}) { if (type->IsPolymorphic()) { @@ -5569,8 +5682,7 @@ bool DeclarationVisitor::Pre(const parser::NamedConstantDef &x) { // standard-conforming PARAMETER statement (with parentheses) ApplyImplicitRules(symbol); Walk(expr); - if (auto converted{EvaluateNonPointerInitializer( - symbol, expr, expr.thing.value().source)}) { + if (auto converted{EvaluateNonPointerInitializer(symbol, expr, at)}) { details->set_init(std::move(*converted)); } } @@ -5724,7 +5836,8 @@ void DeclarationVisitor::DeclareIntrinsic(const parser::Name &name) { } } if (!symbol.test(Symbol::Flag::Function) && - !symbol.test(Symbol::Flag::Subroutine)) { + !symbol.test(Symbol::Flag::Subroutine) && + !context().intrinsics().IsDualIntrinsic(name.source.ToString())) { if (context().intrinsics().IsIntrinsicFunction(name.source.ToString())) { symbol.set(Symbol::Flag::Function); } else if (context().intrinsics().IsIntrinsicSubroutine( @@ -6035,7 +6148,7 @@ bool DeclarationVisitor::Pre(const parser::KindParam &x) { if (const auto *kind{std::get_if< parser::Scalar<parser::Integer<parser::Constant<parser::Name>>>>( &x.u)}) { - const parser::Name &name{kind->thing.thing.thing}; + const auto &name{parser::UnwrapRef<parser::Name>(kind)}; if (!FindSymbol(name)) { Say(name, "Parameter '%s' not found"_err_en_US); } @@ -6323,6 +6436,7 @@ bool DeclarationVisitor::Pre(const parser::DerivedTypeDef &x) { details.set_isForwardReferenced(false); derivedTypeInfo_ = {}; PopScope(); + set_inPDTDefinition(false); return false; } @@ -6350,6 +6464,10 @@ void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) { // component without producing spurious errors about already // existing. const Symbol &extendsSymbol{extendsType->typeSymbol()}; + if (extendsSymbol.scope() && + extendsSymbol.scope()->IsParameterizedDerivedType()) { + set_inPDTDefinition(true); + } auto restorer{common::ScopedSet(extendsName->symbol, nullptr)}; if (OkToAddComponent(*extendsName, &extendsSymbol)) { auto &comp{DeclareEntity<ObjectEntityDetails>(*extendsName, Attrs{})}; @@ -6368,8 +6486,12 @@ void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) { } // Create symbols now for type parameters so that they shadow names // from the enclosing specification part. + const auto ¶mNames{std::get<std::list<parser::Name>>(x.t)}; + if (!paramNames.empty()) { + set_inPDTDefinition(true); + } if (auto *details{symbol.detailsIf<DerivedTypeDetails>()}) { - for (const auto &name : std::get<std::list<parser::Name>>(x.t)) { + for (const auto &name : paramNames) { if (Symbol * symbol{MakeTypeSymbol(name, TypeParamDetails{})}) { details->add_paramNameOrder(*symbol); } @@ -6457,8 +6579,7 @@ void DeclarationVisitor::Post(const parser::ComponentDecl &x) { if (const auto *derived{declType->AsDerived()}) { if (!attrs.HasAny({Attr::POINTER, Attr::ALLOCATABLE})) { if (derivedTypeInfo_.type == &derived->typeSymbol()) { // C744 - Say("Recursive use of the derived type requires " - "POINTER or ALLOCATABLE"_err_en_US); + Say("Recursive use of the derived type requires POINTER or ALLOCATABLE"_err_en_US); } } } @@ -6471,7 +6592,11 @@ void DeclarationVisitor::Post(const parser::ComponentDecl &x) { Initialization(name, *init, /*inComponentDecl=*/true); } } - currScope().symbol()->get<DerivedTypeDetails>().add_component(symbol); + auto &details{currScope().symbol()->get<DerivedTypeDetails>()}; + details.add_component(symbol); + if (const parser::Expr *kindExpr{GetOriginalKindParameter()}) { + details.add_originalKindParameter(name.source, kindExpr); + } } ClearArraySpec(); ClearCoarraySpec(); @@ -7081,7 +7206,7 @@ bool DeclarationVisitor::Pre(const parser::SaveStmt &x) { auto kind{std::get<parser::SavedEntity::Kind>(y.t)}; const auto &name{std::get<parser::Name>(y.t)}; if (kind == parser::SavedEntity::Kind::Common) { - MakeCommonBlockSymbol(name); + MakeCommonBlockSymbol(name, name.source); AddSaveName(specPartState_.saveInfo.commons, name.source); } else { HandleAttributeStmt(Attr::SAVE, name); @@ -7161,59 +7286,22 @@ void DeclarationVisitor::CheckCommonBlocks() { if (symbol.get<CommonBlockDetails>().objects().empty() && symbol.attrs().test(Attr::BIND_C)) { Say(symbol.name(), - "'%s' appears as a COMMON block in a BIND statement but not in" - " a COMMON statement"_err_en_US); - } - } - // check objects in common blocks - for (const auto &name : specPartState_.commonBlockObjects) { - const auto *symbol{currScope().FindSymbol(name)}; - if (!symbol) { - continue; - } - const auto &attrs{symbol->attrs()}; - if (attrs.test(Attr::ALLOCATABLE)) { - Say(name, - "ALLOCATABLE object '%s' may not appear in a COMMON block"_err_en_US); - } else if (attrs.test(Attr::BIND_C)) { - Say(name, - "Variable '%s' with BIND attribute may not appear in a COMMON block"_err_en_US); - } else if (IsNamedConstant(*symbol)) { - Say(name, - "A named constant '%s' may not appear in a COMMON block"_err_en_US); - } else if (IsDummy(*symbol)) { - Say(name, - "Dummy argument '%s' may not appear in a COMMON block"_err_en_US); - } else if (symbol->IsFuncResult()) { - Say(name, - "Function result '%s' may not appear in a COMMON block"_err_en_US); - } else if (const DeclTypeSpec * type{symbol->GetType()}) { - if (type->category() == DeclTypeSpec::ClassStar) { - Say(name, - "Unlimited polymorphic pointer '%s' may not appear in a COMMON block"_err_en_US); - } else if (const auto *derived{type->AsDerived()}) { - if (!IsSequenceOrBindCType(derived)) { - Say(name, - "Derived type '%s' in COMMON block must have the BIND or" - " SEQUENCE attribute"_err_en_US); - } - UnorderedSymbolSet typeSet; - CheckCommonBlockDerivedType(name, derived->typeSymbol(), typeSet); - } + "'%s' appears as a COMMON block in a BIND statement but not in a COMMON statement"_err_en_US); } } specPartState_.commonBlockObjects = {}; } -Symbol &DeclarationVisitor::MakeCommonBlockSymbol(const parser::Name &name) { - return Resolve(name, currScope().MakeCommonBlock(name.source)); +Symbol &DeclarationVisitor::MakeCommonBlockSymbol( + const parser::Name &name, SourceName location) { + return Resolve(name, currScope().MakeCommonBlock(name.source, location)); } Symbol &DeclarationVisitor::MakeCommonBlockSymbol( - const std::optional<parser::Name> &name) { + const std::optional<parser::Name> &name, SourceName location) { if (name) { - return MakeCommonBlockSymbol(*name); + return MakeCommonBlockSymbol(*name, location); } else { - return MakeCommonBlockSymbol(parser::Name{}); + return MakeCommonBlockSymbol(parser::Name{}, location); } } @@ -7221,43 +7309,6 @@ bool DeclarationVisitor::NameIsKnownOrIntrinsic(const parser::Name &name) { return FindSymbol(name) || HandleUnrestrictedSpecificIntrinsicFunction(name); } -// Check if this derived type can be in a COMMON block. -void DeclarationVisitor::CheckCommonBlockDerivedType(const SourceName &name, - const Symbol &typeSymbol, UnorderedSymbolSet &typeSet) { - if (auto iter{typeSet.find(SymbolRef{typeSymbol})}; iter != typeSet.end()) { - return; - } - typeSet.emplace(typeSymbol); - if (const auto *scope{typeSymbol.scope()}) { - for (const auto &pair : *scope) { - const Symbol &component{*pair.second}; - if (component.attrs().test(Attr::ALLOCATABLE)) { - Say2(name, - "Derived type variable '%s' may not appear in a COMMON block" - " due to ALLOCATABLE component"_err_en_US, - component.name(), "Component with ALLOCATABLE attribute"_en_US); - return; - } - const auto *details{component.detailsIf<ObjectEntityDetails>()}; - if (component.test(Symbol::Flag::InDataStmt) || - (details && details->init())) { - Say2(name, - "Derived type variable '%s' may not appear in a COMMON block due to component with default initialization"_err_en_US, - component.name(), "Component with default initialization"_en_US); - return; - } - if (details) { - if (const auto *type{details->type()}) { - if (const auto *derived{type->AsDerived()}) { - const Symbol &derivedTypeSymbol{derived->typeSymbol()}; - CheckCommonBlockDerivedType(name, derivedTypeSymbol, typeSet); - } - } - } - } - } -} - bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction( const parser::Name &name) { if (auto interface{context().intrinsics().IsSpecificIntrinsicFunction( @@ -7408,7 +7459,7 @@ void DeclarationVisitor::DeclareLocalEntity( Symbol *DeclarationVisitor::DeclareStatementEntity( const parser::DoVariable &doVar, const std::optional<parser::IntegerTypeSpec> &type) { - const parser::Name &name{doVar.thing.thing}; + const auto &name{parser::UnwrapRef<parser::Name>(doVar)}; const DeclTypeSpec *declTypeSpec{nullptr}; if (auto *prev{FindSymbol(name)}) { if (prev->owner() == currScope()) { @@ -7841,13 +7892,14 @@ bool ConstructVisitor::Pre(const parser::DataIDoObject &x) { common::visit( common::visitors{ [&](const parser::Scalar<Indirection<parser::Designator>> &y) { - Walk(y.thing.value()); - const parser::Name &first{parser::GetFirstName(y.thing.value())}; + const auto &designator{parser::UnwrapRef<parser::Designator>(y)}; + Walk(designator); + const parser::Name &first{parser::GetFirstName(designator)}; if (first.symbol) { first.symbol->set(Symbol::Flag::InDataStmt); } }, - [&](const Indirection<parser::DataImpliedDo> &y) { Walk(y.value()); }, + [&](const Indirection<parser::DataImpliedDo> &y) { Walk(y); }, }, x.u); return false; @@ -8530,8 +8582,7 @@ public: void Post(const parser::WriteStmt &) { inAsyncIO_ = false; } void Post(const parser::IoControlSpec::Size &size) { if (const auto *designator{ - std::get_if<common::Indirection<parser::Designator>>( - &size.v.thing.thing.u)}) { + parser::Unwrap<common::Indirection<parser::Designator>>(size)}) { NoteAsyncIODesignator(designator->value()); } } @@ -8982,6 +9033,14 @@ void DeclarationVisitor::Initialization(const parser::Name &name, ultimate.set(Symbol::Flag::InDataStmt); } }, + [&](const std::list<Indirection<parser::DataStmtValue>> &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)}) { @@ -9015,11 +9074,6 @@ void DeclarationVisitor::Initialization(const parser::Name &name, ultimate.set(Symbol::Flag::InDataStmt); } }, - [&](const std::list<Indirection<parser::DataStmtValue>> &values) { - // Handled later in data-to-inits conversion - ultimate.set(Symbol::Flag::InDataStmt); - Walk(values); - }, }, init.u); } @@ -9090,36 +9144,83 @@ 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<ObjectEntityDetails>()}) { 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 &constExpr) { + if (CheckNonPointerInitialization( + name, /*inLegacyDataInitialization=*/false)) { + Symbol &ultimate{name.symbol->GetUltimate()}; + auto &details{ultimate.get<ObjectEntityDetails>()}; + const auto &expr{parser::UnwrapRef<parser::Expr>(constExpr)}; + if (ultimate.owner().IsParameterizedDerivedType()) { + // Save the expression for per-instantiation analysis. + details.set_unanalyzedPDTComponentInit(&expr); + } else if (MaybeExpr folded{EvaluateNonPointerInitializer( + ultimate, constExpr, expr.source)}) { + details.set_init(std::move(*folded)); + ultimate.set(Symbol::Flag::InDataStmt, false); + } + } +} + +void DeclarationVisitor::LegacyDataInitialization(const parser::Name &name, + const std::list<common::Indirection<parser::DataStmtValue>> &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( @@ -9589,7 +9690,7 @@ void ResolveNamesVisitor::CreateCommonBlockSymbols( const parser::CommonStmt &commonStmt) { for (const parser::CommonStmt::Block &block : commonStmt.blocks) { const auto &[name, objects] = block.t; - Symbol &commonBlock{MakeCommonBlockSymbol(name)}; + Symbol &commonBlock{MakeCommonBlockSymbol(name, commonStmt.source)}; for (const auto &object : objects) { Symbol &obj{DeclareObjectEntity(std::get<parser::Name>(object.t))}; if (auto *details{obj.detailsIf<ObjectEntityDetails>()}) { @@ -10469,12 +10570,16 @@ private: if (const auto *target{ std::get_if<parser::InitialDataTarget>(&init->u)}) { resolver_.PointerInitialization(name, *target); - } else if (const auto *expr{ - std::get_if<parser::ConstantExpr>(&init->u)}) { - if (name.symbol) { - if (const auto *object{name.symbol->detailsIf<ObjectEntityDetails>()}; - !object || !object->init()) { + } else if (name.symbol) { + if (const auto *object{name.symbol->detailsIf<ObjectEntityDetails>()}; + !object || !object->init()) { + if (const auto *expr{std::get_if<parser::ConstantExpr>(&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. } } } @@ -10582,9 +10687,6 @@ void ResolveNamesVisitor::Post(const parser::Program &x) { CHECK(!attrs_); CHECK(!cudaDataAttr_); CHECK(!GetDeclTypeSpec()); - // Top-level resolution to propagate information across program units after - // each of them has been resolved separately. - ResolveOmpTopLevelParts(context(), x); } // A singleton instance of the scope -> IMPLICIT rules mapping is |