From 2f12ee4f526536ef6ed738ca2fc0ba18d95c677d Mon Sep 17 00:00:00 2001 From: peter klausler Date: Thu, 14 Feb 2019 14:37:55 -0800 Subject: [PATCH] [flang] complete transfer of struct constructor code to expression.cc Original-commit: flang-compiler/f18@e6178b2fc73bf7c98bb0519be8866ba799c17029 Reviewed-on: https://github.com/flang-compiler/f18/pull/287 Tree-same-pre-rewrite: false --- flang/lib/semantics/expression.cc | 102 ++++++++++++++++++--------------- flang/lib/semantics/resolve-names.cc | 68 +++++----------------- flang/test/semantics/structconst01.f90 | 4 ++ 3 files changed, 74 insertions(+), 100 deletions(-) diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index 2bfd9e4..d5b149a 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -1340,6 +1340,15 @@ static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context, CHECK(spec.scope() != nullptr); const Symbol &typeSymbol{spec.typeSymbol()}; + if (typeSymbol.attrs().test(semantics::Attr::ABSTRACT)) { // C796 + if (auto *msg{context.Say(typeName, + "ABSTRACT derived type '%s' cannot be used in a structure constructor"_err_en_US, + typeName.ToString().data())}) { + msg->Attach( + typeSymbol.name(), "Declaration of ABSTRACT derived type"_en_US); + } + } + // This list holds all of the components in the derived type and its // parents. The symbols for whole parent components appear after their // own components and before the components of the types that extend them. @@ -1350,14 +1359,7 @@ static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context, // initialize X or A by name, but not both. const auto &details{typeSymbol.get()}; std::list components{details.OrderComponents(*spec.scope())}; - if (typeSymbol.attrs().test(semantics::Attr::ABSTRACT)) { // C796 - if (auto *msg{context.Say(typeName, - "ABSTRACT derived type '%s' cannot be used in a structure constructor"_err_en_US, - typeName.ToString().data())}) { - msg->Attach( - typeSymbol.name(), "Declaration of ABSTRACT derived type"_en_US); - } - } + auto nextAnonymous{components.begin()}; std::set unavailable; bool anyKeyword{false}; @@ -1369,52 +1371,62 @@ static MaybeExpr AnalyzeExpr(ExpressionAnalysisContext &context, const parser::Expr &expr{ *std::get(component.t).v}; parser::CharBlock source{expr.source}; + const Symbol *symbol{nullptr}; if (const auto &kw{std::get>(component.t)}) { source = kw->v.source; + symbol = kw->v.symbol; anyKeyword = true; - } else if (anyKeyword) { // C7100 - context.Say(source, - "Value in structure constructor lacks a component name"_err_en_US); - checkConflicts = false; // stem cascade - } - if (component.symbol == nullptr) { - context.Say( - source, "INTERNAL: StructureConstructor lacks symbol"_err_en_US); - continue; - } - const Symbol &symbol{*component.symbol}; - if (symbol.has()) { - context.Say(source, - "Type parameter '%s' cannot be a component of this structure constructor"_err_en_US, - symbol.name().ToString().data()); - } else if (checkConflicts) { - auto componentIter{ - std::find(components.begin(), components.end(), &symbol)}; - if (unavailable.find(symbol.name()) != unavailable.cend()) { - // C797, C798 + } else { + if (anyKeyword) { // C7100 context.Say(source, - "Component '%s' conflicts with another component earlier in this structure constructor"_err_en_US, - symbol.name().ToString().data()); - } else if (symbol.test(Symbol::Flag::ParentComp)) { - // Make earlier components unavailable once a whole parent appears. - for (auto it{components.begin()}; it != componentIter; ++it) { - unavailable.insert((*it)->name()); + "Value in structure constructor lacks a component name"_err_en_US); + checkConflicts = false; // stem cascade + } + while (nextAnonymous != components.end()) { + symbol = *nextAnonymous++; + if (!symbol->test(Symbol::Flag::ParentComp)) { + break; } - } else { - // Make whole parent components unavailable after any of their - // constituents appear. - for (auto it{componentIter}; it != components.end(); ++it) { - if ((*it)->test(Symbol::Flag::ParentComp)) { + } + if (symbol == nullptr) { + context.Say( + source, "Unexpected value in structure constructor"_err_en_US); + } + } + if (symbol != nullptr) { + if (symbol->has()) { + context.Say(source, + "Type parameter '%s' cannot be a component of this structure constructor"_err_en_US, + symbol->name().ToString().data()); + } else if (checkConflicts) { + auto componentIter{ + std::find(components.begin(), components.end(), symbol)}; + if (unavailable.find(symbol->name()) != unavailable.cend()) { + // C797, C798 + context.Say(source, + "Component '%s' conflicts with another component earlier in this structure constructor"_err_en_US, + symbol->name().ToString().data()); + } else if (symbol->test(Symbol::Flag::ParentComp)) { + // Make earlier components unavailable once a whole parent appears. + for (auto it{components.begin()}; it != componentIter; ++it) { unavailable.insert((*it)->name()); } + } else { + // Make whole parent components unavailable after any of their + // constituents appear. + for (auto it{componentIter}; it != components.end(); ++it) { + if ((*it)->test(Symbol::Flag::ParentComp)) { + unavailable.insert((*it)->name()); + } + } } } - } - unavailable.insert(symbol.name()); - if (MaybeExpr value{AnalyzeExpr(context, expr)}) { - // TODO pmk: C7104, C7105 check that pointer components are - // being initialized with data/procedure designators appropriately - result.Add(symbol, std::move(*value)); + unavailable.insert(symbol->name()); + if (MaybeExpr value{AnalyzeExpr(context, expr)}) { + // TODO pmk: C7104, C7105 check that pointer components are + // being initialized with data/procedure designators appropriately + result.Add(*symbol, std::move(*value)); + } } } diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc index a5d0b06..05b87ec 100644 --- a/flang/lib/semantics/resolve-names.cc +++ b/flang/lib/semantics/resolve-names.cc @@ -3109,72 +3109,30 @@ bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) { EndDeclTypeSpec(); SetDeclTypeSpecState(savedState); - auto &typeName{std::get(parsedType.t)}; - const DerivedTypeSpec *spec{type ? type->AsDerived() : nullptr}; - const Symbol *typeSymbol{spec ? &spec->typeSymbol() : nullptr}; + if (type == nullptr) { + return false; + } + const DerivedTypeSpec *spec{type->AsDerived()}; const Scope *typeScope{spec ? spec->scope() : nullptr}; - - // This list holds all of the components in the derived type and its - // parents. The symbols for whole parent components appear after their - // own components and before the components of the types that extend them. - // E.g., TYPE :: A; REAL X; END TYPE - // TYPE, EXTENDS(A) :: B; REAL Y; END TYPE - // produces the component list X, A, Y. - // The order is important below because a structure constructor can - // initialize X or A by name, but not both. - SymbolList components; - bool ok{typeSymbol != nullptr && typeScope != nullptr}; - if (ok) { - components = - typeSymbol->get().OrderComponents(*typeScope); - if (typeSymbol->attrs().test(Attr::ABSTRACT)) { // C796 - SayWithDecl(typeName, *typeSymbol, - "ABSTRACT type cannot be used in a structure constructor"_err_en_US); - } + if (typeScope == nullptr) { + return false; } // N.B C7102 is implicitly enforced by having inaccessible types not // being found in resolution. - auto nextAnonymous{components.begin()}; for (const auto &component : std::get>(x.t)) { // Visit the component spec expression, but not the keyword, since // we need to resolve its symbol in the scope of the derived type. - const parser::Expr &value{ - *std::get(component.t).v}; - Walk(value); - const auto &kw{std::get>(component.t)}; - const Symbol *symbol{nullptr}; - SourceName source{value.source}; - if (kw.has_value()) { - source = kw->v.source; - if (ok) { - symbol = FindInTypeOrParents(*typeScope, kw->v); - if (symbol == nullptr) { // C7101 - Say(source, - "Keyword '%s' is not a component of this derived type"_err_en_US); - ok = false; - } + Walk(std::get(component.t)); + if (const auto &kw{std::get>(component.t)}) { + if (const Symbol * symbol{FindInTypeOrParents(*typeScope, kw->v)}) { + CheckAccessibleComponent(kw->v.source, *symbol); // C7102 + } else { // C7101 + Say(kw->v.source, + "Keyword '%s' is not a component of this derived type"_err_en_US); } - } else if (ok) { - while (nextAnonymous != components.end()) { - symbol = *nextAnonymous++; - if (symbol->test(Symbol::Flag::ParentComp)) { - symbol = nullptr; - } else { - break; - } - } - if (symbol == nullptr) { - Say(source, "Unexpected value in structure constructor"_err_en_US); - break; - } - } - if (symbol != nullptr) { - // Save the resolved component's symbol (if any) in the parse tree. - component.symbol = symbol; - CheckAccessibleComponent(source, *symbol); // C7102 } } return false; diff --git a/flang/test/semantics/structconst01.f90 b/flang/test/semantics/structconst01.f90 index c070fee..8020254 100644 --- a/flang/test/semantics/structconst01.f90 +++ b/flang/test/semantics/structconst01.f90 @@ -57,6 +57,8 @@ module module1 call type1arg(type1(0)(n=1,2)) !ERROR: Component 'n' conflicts with another component earlier in this structure constructor call type1arg(type1(0)(n=1,n=2)) + !ERROR: Unexpected value in structure constructor + call type1arg(type1(0)(1,2)) call type2arg(type2(0,0)(n=1,m=2)) call type2arg(type2(0,0)(m=2)) !ERROR: Structure constructor lacks a value for component 'm' @@ -73,5 +75,7 @@ module module1 call type2arg(type2(0,0)(j=1, & !ERROR: Type parameter 'k' cannot be a component of this structure constructor k=2,m=3)) + !ERROR: ABSTRACT derived type 'abstract' cannot be used in a structure constructor + call abstractarg(abstract(0)(n=1)) end subroutine errors end module module1 -- 2.7.4