From ee28b7082718885b191dea73071f0dbb596a2297 Mon Sep 17 00:00:00 2001 From: Tim Keith Date: Tue, 15 Jan 2019 16:59:20 -0800 Subject: [PATCH] [flang] Resolve names in ASSOCIATE and SELECT TYPE Create `AssocEntityDetails` for symbols that represent entities identified by the associate-name in ASSOCIATE and SELECT TYPE constructs. For ASSOCIATE, create a new scope for the associated entity. For SELECT TYPE, create a new scope for each of type guard blocks. Each one contains an associated entity with the appropriate type. For SELECT TYPE, also create a place-holder symbol for the associate-name in the SELECT TYPE statement. The real symbols are in the new scopes and none of them is uniquely identified with the associate-name. Handling of `Selector` is common between these, with `associate-name => expr | variable` recorded in `ConstructVisitor::association_`. When the selector is an expression, derive the type of the associated entity from the type of the expression. This required some refactoring of how `DeclTypeSpec`s are created. The `DerivedTypeSpec` that comes from and expression is const so we can only create const `DeclTypeSpec`s from it. But there were times during name resolution when we needed to set type parameters in the current `DeclTypeSpec`. Now the non-const `DerivedTypeSpec` is saved separately from the const `DeclTypeSpec` while we are processing a declaration type spec. This makes it unnecessary to save the derived type name. Add a type alias for `common::Indirection` to reduce verbosity. Original-commit: flang-compiler/f18@b7668cebe49a122ea23c89c81eafdeba243bbfaf Reviewed-on: https://github.com/flang-compiler/f18/pull/261 Tree-same-pre-rewrite: false --- flang/lib/semantics/resolve-names.cc | 273 ++++++++++++++++++++++++++++------- flang/lib/semantics/scope.cc | 21 +-- flang/lib/semantics/scope.h | 17 ++- flang/lib/semantics/semantics.cc | 6 +- flang/lib/semantics/semantics.h | 6 +- flang/lib/semantics/symbol.cc | 19 ++- flang/lib/semantics/symbol.h | 20 ++- flang/lib/semantics/type.cc | 6 +- flang/lib/semantics/type.h | 15 +- flang/test/semantics/CMakeLists.txt | 2 + flang/test/semantics/resolve39.f90 | 24 +++ flang/test/semantics/symbol11.f90 | 95 ++++++++++++ flang/test/semantics/test_symbols.sh | 4 +- 13 files changed, 403 insertions(+), 105 deletions(-) create mode 100644 flang/test/semantics/resolve39.f90 create mode 100644 flang/test/semantics/symbol11.f90 diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc index 3de9d81..abf65cc 100644 --- a/flang/lib/semantics/resolve-names.cc +++ b/flang/lib/semantics/resolve-names.cc @@ -39,6 +39,7 @@ namespace Fortran::semantics { using namespace parser::literals; +template using Indirection = common::Indirection; using Message = parser::Message; using Messages = parser::Messages; using MessageFixedText = parser::MessageFixedText; @@ -248,6 +249,7 @@ public: void Post(const parser::IntrinsicTypeSpec::Complex &); void Post(const parser::IntrinsicTypeSpec::DoublePrecision &); void Post(const parser::IntrinsicTypeSpec::DoubleComplex &); + bool Pre(const parser::DeclarationTypeSpec::Class &); void Post(const parser::DeclarationTypeSpec::ClassStar &); void Post(const parser::DeclarationTypeSpec::TypeStar &); void Post(const parser::TypeParamSpec &); @@ -258,17 +260,19 @@ public: protected: struct State { bool expectDeclTypeSpec{false}; // should only see decl-type-spec when true - DeclTypeSpec *declTypeSpec{nullptr}; - const parser::Name *derivedTypeName{nullptr}; + const DeclTypeSpec *declTypeSpec{nullptr}; + struct { + DerivedTypeSpec *type{nullptr}; + DeclTypeSpec::Category category{DeclTypeSpec::TypeDerived}; + } derived; }; - DeclTypeSpec *GetDeclTypeSpec(); + const DeclTypeSpec *GetDeclTypeSpec(); void BeginDeclTypeSpec(); void EndDeclTypeSpec(); State SetDeclTypeSpecState(State); - const parser::Name *derivedTypeName() const { return state_.derivedTypeName; } - void SetDeclTypeSpec(const parser::Name &, DeclTypeSpec &); - void SetDeclTypeSpec(DeclTypeSpec &); + void SetDeclTypeSpec(const DeclTypeSpec &); + DerivedTypeSpec &SetDerivedTypeSpec(Scope &, const parser::Name &); ParamValue GetParamValue(const parser::TypeParamValue &); private: @@ -624,7 +628,6 @@ public: void Post(const parser::CharSelector::LengthAndKind &); void Post(const parser::CharLength &); void Post(const parser::LengthSelector &); - void Post(const parser::DeclarationTypeSpec::Class &); bool Pre(const parser::DeclarationTypeSpec::Record &); bool Pre(const parser::DerivedTypeSpec &); void Post(const parser::DerivedTypeDef &x); @@ -691,7 +694,7 @@ private: Symbol &DeclareObjectEntity(const parser::Name &, Attrs); Symbol &DeclareProcEntity(const parser::Name &, Attrs, const ProcInterface &); void SetType(const parser::Name &, const DeclTypeSpec &); - const Symbol *ResolveDerivedType(const parser::Name * = nullptr); + const Symbol *ResolveDerivedType(const parser::Name &); bool CanBeTypeBoundProc(const Symbol &); Symbol *FindExplicitInterface(const parser::Name &); const Symbol *FindTypeSymbol(const parser::Name &); @@ -757,17 +760,21 @@ public: void Post(const parser::ForallStmt &); bool Pre(const parser::BlockStmt &); bool Pre(const parser::EndBlockStmt &); + void Post(const parser::Selector &); + bool Pre(const parser::AssociateStmt &); + void Post(const parser::EndAssociateStmt &); + void Post(const parser::Association &); + void Post(const parser::SelectTypeStmt &); + bool Pre(const parser::SelectTypeConstruct::TypeCase &); + void Post(const parser::SelectTypeConstruct::TypeCase &); + void Post(const parser::TypeGuardStmt::Guard &); // Definitions of construct names bool Pre(const parser::WhereConstructStmt &x) { return CheckDef(x.t); } bool Pre(const parser::ForallConstructStmt &x) { return CheckDef(x.t); } - bool Pre(const parser::AssociateStmt &x) { return CheckDef(x.t); } bool Pre(const parser::ChangeTeamStmt &x) { return CheckDef(x.t); } bool Pre(const parser::CriticalStmt &x) { return CheckDef(x.t); } - bool Pre(const parser::LabelDoStmt &x) { - CHECK(false); - return false; - } + bool Pre(const parser::LabelDoStmt &x) { common::die("should not happen"); } bool Pre(const parser::NonLabelDoStmt &x) { return CheckDef(x.t); } bool Pre(const parser::IfThenStmt &x) { return CheckDef(x.t); } bool Pre(const parser::SelectCaseStmt &x) { return CheckDef(x.t); } @@ -777,12 +784,12 @@ public: bool Pre(const parser::SelectTypeStmt &x) { return CheckDef(std::get<0>(x.t)); } + // References to construct names void Post(const parser::MaskedElsewhereStmt &x) { CheckRef(x.t); } void Post(const parser::ElsewhereStmt &x) { CheckRef(x.v); } void Post(const parser::EndWhereStmt &x) { CheckRef(x.v); } void Post(const parser::EndForallStmt &x) { CheckRef(x.v); } - void Post(const parser::EndAssociateStmt &x) { CheckRef(x.v); } void Post(const parser::EndChangeTeamStmt &x) { CheckRef(x.t); } void Post(const parser::EndCriticalStmt &x) { CheckRef(x.v); } void Post(const parser::EndDoStmt &x) { CheckRef(x.v); } @@ -797,6 +804,14 @@ public: void Post(const parser::ExitStmt &x) { CheckRef(x.v); } private: + // The represents: associate-name => expr | variable + // expr is set unless there were errors + struct { + const parser::Name *name{nullptr}; + const parser::Name *variable{nullptr}; + MaybeExpr expr; + } association_; + template bool CheckDef(const T &t) { return CheckDef(std::get>(t)); } @@ -806,6 +821,10 @@ private: bool CheckDef(const std::optional &); void CheckRef(const std::optional &); void CheckIntegerType(const Symbol &); + const DeclTypeSpec &ToDeclTypeSpec(const evaluate::DynamicType &); + Symbol *MakeAssocEntity(); + void SetTypeFromAssociation(Symbol &); + void SetAttrsFromAssociation(Symbol &); }; // Walk the parse tree and resolve names to symbols. @@ -1069,7 +1088,7 @@ bool AttrsVisitor::Pre(const parser::Pass &x) { // DeclTypeSpecVisitor implementation -DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() { +const DeclTypeSpec *DeclTypeSpecVisitor::GetDeclTypeSpec() { return state_.declTypeSpec; } @@ -1089,7 +1108,8 @@ DeclTypeSpecVisitor::State DeclTypeSpecVisitor::SetDeclTypeSpecState(State x) { } void DeclTypeSpecVisitor::Post(const parser::TypeParamSpec &x) { - DerivedTypeSpec &derivedTypeSpec{state_.declTypeSpec->derivedTypeSpec()}; + CHECK(state_.derived.type); + DerivedTypeSpec &derivedTypeSpec{*state_.derived.type}; const auto &value{std::get(x.t)}; if (const auto &keyword{std::get>(x.t)}) { derivedTypeSpec.AddParamValue(keyword->v.source, GetParamValue(value)); @@ -1163,6 +1183,10 @@ void DeclTypeSpecVisitor::MakeNumericType(TypeCategory category, int kind) { SetDeclTypeSpec(context().MakeNumericType(category, kind)); } +bool DeclTypeSpecVisitor::Pre(const parser::DeclarationTypeSpec::Class &x) { + state_.derived.category = DeclTypeSpec::ClassDerived; + return true; +} void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::ClassStar &) { SetDeclTypeSpec(context().globalScope().MakeClassStarType()); } @@ -1172,16 +1196,19 @@ void DeclTypeSpecVisitor::Post(const parser::DeclarationTypeSpec::TypeStar &) { // Check that we're expecting to see a DeclTypeSpec (and haven't seen one yet) // and save it in state_.declTypeSpec. -void DeclTypeSpecVisitor::SetDeclTypeSpec(DeclTypeSpec &declTypeSpec) { +void DeclTypeSpecVisitor::SetDeclTypeSpec(const DeclTypeSpec &declTypeSpec) { CHECK(state_.expectDeclTypeSpec); CHECK(!state_.declTypeSpec); state_.declTypeSpec = &declTypeSpec; } -// Set both the derived type name and corresponding DeclTypeSpec. -void DeclTypeSpecVisitor::SetDeclTypeSpec( - const parser::Name &name, DeclTypeSpec &declTypeSpec) { - state_.derivedTypeName = &name; - SetDeclTypeSpec(declTypeSpec); + +// Set the current DeclTypeSpec to a derived type created from this name. +DerivedTypeSpec &DeclTypeSpecVisitor::SetDerivedTypeSpec( + Scope &scope, const parser::Name &typeName) { + DerivedTypeSpec &derived{scope.MakeDerivedType(*typeName.symbol)}; + SetDeclTypeSpec(scope.MakeDerivedType(state_.derived.category, derived)); + state_.derived.type = &derived; + return derived; } int DeclTypeSpecVisitor::GetKindParamValue( @@ -1607,7 +1634,7 @@ bool ScopeHandler::ConvertToProcEntity(Symbol &symbol) { bool ModuleVisitor::Pre(const parser::Only &x) { std::visit( common::visitors{ - [&](const common::Indirection &generic) { + [&](const Indirection &generic) { std::visit( common::visitors{ [&](const parser::Name &name) { AddUse(name); }, @@ -2510,20 +2537,14 @@ void DeclarationVisitor::Post(const parser::LengthSelector &x) { } } -void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Class &x) { - // created by default with TypeDerived; change to ClassDerived - GetDeclTypeSpec()->set_category(DeclTypeSpec::ClassDerived); -} - bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Record &) { return true; // TODO } bool DeclarationVisitor::Pre(const parser::DerivedTypeSpec &x) { const auto &typeName{std::get(x.t)}; - if (const auto *symbol{ResolveDerivedType(&typeName)}) { - SetDeclTypeSpec(typeName, currScope().MakeDerivedType(*symbol)); - GetDeclTypeSpec()->derivedTypeSpec().set_scope(*symbol->scope()); + if (const auto *symbol{ResolveDerivedType(typeName)}) { + SetDerivedTypeSpec(currScope(), typeName).set_scope(*symbol->scope()); } return true; } @@ -2581,16 +2602,17 @@ void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) { auto &symbol{MakeSymbol(name, GetAttrs(), DerivedTypeDetails{})}; PushScope(Scope::Kind::DerivedType, &symbol); if (auto *extendsName{derivedTypeInfo_.extends}) { - if (const Symbol * extends{ResolveDerivedType(extendsName)}) { + if (const Symbol * extends{ResolveDerivedType(*extendsName)}) { symbol.get().set_extends(extendsName->source); // Declare the "parent component"; private if the type is if (OkToAddComponent(*extendsName, extends)) { auto &comp{DeclareEntity(*extendsName, Attrs{})}; comp.attrs().set(Attr::PRIVATE, extends->attrs().test(Attr::PRIVATE)); comp.set(Symbol::Flag::ParentComp); - auto &type{currScope().MakeDerivedType(*extends)}; - type.derivedTypeSpec().set_scope(currScope()); - comp.SetType(type); + DerivedTypeSpec &derived{currScope().MakeDerivedType(*extends)}; + derived.set_scope(currScope()); + comp.SetType( + currScope().MakeDerivedType(DeclTypeSpec::TypeDerived, derived)); } } } @@ -2748,8 +2770,7 @@ void DeclarationVisitor::Post(const parser::FinalProcedureStmt &x) { } bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) { - const auto &genericSpec{ - std::get>(x.t)}; + const auto &genericSpec{std::get>(x.t)}; const auto *genericName{GetGenericSpecName(*genericSpec)}; if (!genericName) { return false; @@ -2808,7 +2829,6 @@ bool DeclarationVisitor::Pre(const parser::AllocateStmt &) { return true; } void DeclarationVisitor::Post(const parser::AllocateStmt &) { - ResolveDerivedType(); EndDeclTypeSpec(); } @@ -2817,7 +2837,6 @@ bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) { BeginDeclTypeSpec(); Walk(std::get(x.t)); Walk(std::get>(x.t)); - ResolveDerivedType(); EndDeclTypeSpec(); SetDeclTypeSpecState(savedState); return false; @@ -2868,20 +2887,14 @@ void DeclarationVisitor::SetType( } } -// Find the Symbol for this derived type; derivedTypeName if not specified. -const Symbol *DeclarationVisitor::ResolveDerivedType(const parser::Name *name) { - if (name == nullptr) { - name = derivedTypeName(); - if (name == nullptr) { - return nullptr; - } - } - const auto *symbol{FindSymbol(*name)}; +// Find the Symbol for this derived type. +const Symbol *DeclarationVisitor::ResolveDerivedType(const parser::Name &name) { + const auto *symbol{FindSymbol(name)}; if (!symbol) { - Say(*name, "Derived type '%s' not found"_err_en_US); + Say(name, "Derived type '%s' not found"_err_en_US); return nullptr; } - if (CheckUseError(*name)) { + if (CheckUseError(name)) { return nullptr; } if (auto *details{symbol->detailsIf()}) { @@ -2893,7 +2906,7 @@ const Symbol *DeclarationVisitor::ResolveDerivedType(const parser::Name *name) { } } if (!symbol->has()) { - Say(*name, "'%s' is not a derived type"_err_en_US); + Say(name, "'%s' is not a derived type"_err_en_US); return nullptr; } return symbol; @@ -3108,6 +3121,87 @@ bool ConstructVisitor::Pre(const parser::EndBlockStmt &x) { return false; } +void ConstructVisitor::Post(const parser::Selector &x) { + association_ = {}; + const parser::Name *variable{nullptr}; + MaybeExpr expr{std::visit( + common::visitors{ + [&](const parser::Expr &y) { return EvaluateExpr(y); }, + [&](const parser::Variable &y) { + if (const auto *des{ + std::get_if>(&y.u)}) { + if (const auto *dr{std::get_if(&(*des)->u)}) { + variable = std::get_if(&dr->u); + if (variable && !FindSymbol(*variable)) { + variable = nullptr; + return MaybeExpr{}; + } + } + } + return std::visit( + [&](const auto &z) { return EvaluateExpr(*z); }, y.u); + }, + }, + x.u)}; + if (expr) { + association_.expr = std::move(expr); + association_.variable = variable; + } +} + +bool ConstructVisitor::Pre(const parser::AssociateStmt &x) { + CheckDef(x.t); + PushScope(Scope::Kind::Block, nullptr); + return true; +} +void ConstructVisitor::Post(const parser::EndAssociateStmt &x) { + PopScope(); + CheckRef(x.v); +} + +void ConstructVisitor::Post(const parser::Association &x) { + const auto &name{std::get(x.t)}; + association_.name = &name; + if (auto *symbol{MakeAssocEntity()}) { + SetTypeFromAssociation(*symbol); + SetAttrsFromAssociation(*symbol); + } +} + +void ConstructVisitor::Post(const parser::SelectTypeStmt &x) { + if (!association_.expr) { + return; // reported error in expression evaluation + } + if (const std::optional &name{std::get<1>(x.t)}) { + // This isn't a name in the current scope, it is in each TypeGuardStmt + MakePlaceholder(*name, MiscDetails::Kind::SelectTypeAssociateName); + association_.name = &*name; + } else if (!association_.variable) { + Say("Selector is not a named variable: 'associate-name =>' is required"_err_en_US); + association_ = {}; + return; + } +} + +bool ConstructVisitor::Pre(const parser::SelectTypeConstruct::TypeCase &) { + PushScope(Scope::Kind::Block, nullptr); + return true; +} +void ConstructVisitor::Post(const parser::SelectTypeConstruct::TypeCase &) { + PopScope(); +} + +void ConstructVisitor::Post(const parser::TypeGuardStmt::Guard &x) { + if (auto *symbol{MakeAssocEntity()}) { + if (std::holds_alternative(x.u)) { + SetTypeFromAssociation(*symbol); + } else if (const auto *type{GetDeclTypeSpec()}) { + symbol->SetType(*type); + } + SetAttrsFromAssociation(*symbol); + } +} + bool ConstructVisitor::CheckDef(const std::optional &x) { if (x) { MakeSymbol(*x, MiscDetails{MiscDetails::Kind::ConstructName}); @@ -3130,6 +3224,72 @@ void ConstructVisitor::CheckIntegerType(const Symbol &symbol) { } } +// Make a symbol representing an associating entity from association_. +Symbol *ConstructVisitor::MakeAssocEntity() { + if (!association_.name) { + return nullptr; + } + auto &symbol{MakeSymbol(*association_.name, UnknownDetails{})}; + if (symbol.has() && symbol.owner() == currScope()) { + Say(*association_.name, // C1104 + "The associate name '%s' is already used in this associate statement"_err_en_US); + return nullptr; + } + if (auto &expr{association_.expr}) { + symbol.set_details(AssocEntityDetails{std::move(*expr)}); + } + return &symbol; +} + +// Set the type of symbol based on the current association variable or expr. +void ConstructVisitor::SetTypeFromAssociation(Symbol &symbol) { + if (association_.variable) { + if (const Symbol * varSymbol{association_.variable->symbol}) { + if (const DeclTypeSpec * type{varSymbol->GetType()}) { + symbol.SetType(*type); + } + } + } else if (const auto &expr{association_.expr}) { + if (std::optional type{expr->GetType()}) { + symbol.SetType(ToDeclTypeSpec(*type)); + } + } +} + +// If current selector is a variable, set some of its attributes on symbol. +void ConstructVisitor::SetAttrsFromAssociation(Symbol &symbol) { + if (association_.variable) { + if (const auto *varSymbol{association_.variable->symbol}) { + symbol.attrs() |= varSymbol->attrs() & + Attrs{Attr::TARGET, Attr::ASYNCHRONOUS, Attr::VOLATILE, + Attr::CONTIGUOUS}; + if (varSymbol->attrs().test(Attr::POINTER)) { + symbol.attrs().set(Attr::TARGET); + } + } + } +} + +const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec( + const evaluate::DynamicType &type) { + switch (type.category) { + case common::TypeCategory::Integer: + case common::TypeCategory::Real: + case common::TypeCategory::Complex: + return context().MakeNumericType(type.category, type.kind); + case common::TypeCategory::Logical: + return context().MakeLogicalType(type.kind); + case common::TypeCategory::Character: + // TODO: need length from DynamicType + return currScope().MakeCharacterType(ParamValue::Deferred(), type.kind); + case common::TypeCategory::Derived: + CHECK(type.derived); + return currScope().MakeDerivedType( + DeclTypeSpec::TypeDerived, *type.derived); + default: CRASH_NO_CASE; + } +} + // ResolveNamesVisitor implementation bool ResolveNamesVisitor::Pre(const parser::CommonBlockObject &x) { @@ -3222,13 +3382,13 @@ const parser::Name *ResolveNamesVisitor::ResolveDataRef( return std::visit( common::visitors{ [=](const parser::Name &y) { return ResolveName(y); }, - [=](const common::Indirection &y) { + [=](const Indirection &y) { return ResolveStructureComponent(*y); }, - [=](const common::Indirection &y) { + [=](const Indirection &y) { return ResolveArrayElement(*y); }, - [=](const common::Indirection &y) { + [=](const Indirection &y) { return ResolveCoindexedNamedObject(*y); }, }, @@ -3267,7 +3427,7 @@ const parser::Name *ResolveNamesVisitor::FindComponent( return nullptr; } auto &symbol{*base->symbol}; - if (!ConvertToObjectEntity(symbol)) { + if (!symbol.has() && !ConvertToObjectEntity(symbol)) { Say2(*base, "'%s' is an invalid base for a component reference"_err_en_US, symbol, "Declaration of '%s'"_en_US); return nullptr; @@ -3454,7 +3614,7 @@ bool ModuleVisitor::Pre(const parser::AccessStmt &x) { std::visit( common::visitors{ [=](const parser::Name &y) { SetAccess(y, accessAttr); }, - [=](const common::Indirection &y) { + [=](const Indirection &y) { std::visit( common::visitors{ [=](const parser::Name &z) { @@ -3576,6 +3736,7 @@ bool ResolveNamesVisitor::Pre(const parser::ImplicitStmt &x) { } return ImplicitRulesVisitor::Pre(x); } + void ResolveNamesVisitor::Post(const parser::PointerObject &x) { std::visit( common::visitors{ diff --git a/flang/lib/semantics/scope.cc b/flang/lib/semantics/scope.cc index 5dab9a6..7edd456 100644 --- a/flang/lib/semantics/scope.cc +++ b/flang/lib/semantics/scope.cc @@ -70,21 +70,21 @@ bool Scope::AddSubmodule(const SourceName &name, Scope &submodule) { return submodules_.emplace(name, &submodule).second; } -DeclTypeSpec &Scope::MakeNumericType(TypeCategory category, int kind) { +const DeclTypeSpec &Scope::MakeNumericType(TypeCategory category, int kind) { return MakeLengthlessType(NumericTypeSpec{category, kind}); } -DeclTypeSpec &Scope::MakeLogicalType(int kind) { +const DeclTypeSpec &Scope::MakeLogicalType(int kind) { return MakeLengthlessType(LogicalTypeSpec{kind}); } -DeclTypeSpec &Scope::MakeTypeStarType() { +const DeclTypeSpec &Scope::MakeTypeStarType() { return MakeLengthlessType(DeclTypeSpec{DeclTypeSpec::TypeStar}); } -DeclTypeSpec &Scope::MakeClassStarType() { +const DeclTypeSpec &Scope::MakeClassStarType() { return MakeLengthlessType(DeclTypeSpec{DeclTypeSpec::ClassStar}); } // Types that can't have length parameters can be reused without having to // compare length expressions. They are stored in the global scope. -DeclTypeSpec &Scope::MakeLengthlessType(const DeclTypeSpec &type) { +const DeclTypeSpec &Scope::MakeLengthlessType(const DeclTypeSpec &type) { auto it{std::find(declTypeSpecs_.begin(), declTypeSpecs_.end(), type)}; if (it != declTypeSpecs_.end()) { return *it; @@ -94,15 +94,18 @@ DeclTypeSpec &Scope::MakeLengthlessType(const DeclTypeSpec &type) { } } -DeclTypeSpec &Scope::MakeCharacterType(ParamValue &&length, int kind) { +const DeclTypeSpec &Scope::MakeCharacterType(ParamValue &&length, int kind) { characterTypeSpecs_.emplace_back(std::move(length), kind); declTypeSpecs_.emplace_back(characterTypeSpecs_.back()); return declTypeSpecs_.back(); } -DeclTypeSpec &Scope::MakeDerivedType(const Symbol &typeSymbol) { - DerivedTypeSpec &spec{derivedTypeSpecs_.emplace_back(typeSymbol)}; - return declTypeSpecs_.emplace_back(DeclTypeSpec::TypeDerived, spec); +DerivedTypeSpec &Scope::MakeDerivedType(const Symbol &typeSymbol) { + return derivedTypeSpecs_.emplace_back(typeSymbol); +} +const DeclTypeSpec &Scope::MakeDerivedType( + DeclTypeSpec::Category category, const DerivedTypeSpec &derived) { + return declTypeSpecs_.emplace_back(category, derived); } Scope::ImportKind Scope::GetImportKind() const { diff --git a/flang/lib/semantics/scope.h b/flang/lib/semantics/scope.h index 7ea55a1..96ce136 100644 --- a/flang/lib/semantics/scope.h +++ b/flang/lib/semantics/scope.h @@ -121,12 +121,15 @@ public: Scope *FindSubmodule(const SourceName &) const; bool AddSubmodule(const SourceName &, Scope &); - DeclTypeSpec &MakeNumericType(TypeCategory, int kind); - DeclTypeSpec &MakeLogicalType(int kind); - DeclTypeSpec &MakeCharacterType(ParamValue &&length, int kind = 0); - DeclTypeSpec &MakeDerivedType(const Symbol &); - DeclTypeSpec &MakeTypeStarType(); - DeclTypeSpec &MakeClassStarType(); + DerivedTypeSpec &MakeDerivedType(const Symbol &); + + const DeclTypeSpec &MakeNumericType(TypeCategory, int kind); + const DeclTypeSpec &MakeLogicalType(int kind); + const DeclTypeSpec &MakeCharacterType(ParamValue &&length, int kind = 0); + const DeclTypeSpec &MakeDerivedType( + DeclTypeSpec::Category, const DerivedTypeSpec &); + const DeclTypeSpec &MakeTypeStarType(); + const DeclTypeSpec &MakeClassStarType(); // For modules read from module files, this is the stream of characters // that are referenced by SourceName objects. @@ -168,7 +171,7 @@ private: static Symbols<1024> allSymbols; bool CanImport(const SourceName &) const; - DeclTypeSpec &MakeLengthlessType(const DeclTypeSpec &); + const DeclTypeSpec &MakeLengthlessType(const DeclTypeSpec &); friend std::ostream &operator<<(std::ostream &, const Scope &); }; diff --git a/flang/lib/semantics/semantics.cc b/flang/lib/semantics/semantics.cc index 96fce6b..2eab98b 100644 --- a/flang/lib/semantics/semantics.cc +++ b/flang/lib/semantics/semantics.cc @@ -1,4 +1,4 @@ -// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved. +// Copyright (c) 2018-2019, NVIDIA CORPORATION. All rights reserved. // // Licensed under the Apache License, Version 2.0 (the "License"); // you may not use this file except in compliance with the License. @@ -37,14 +37,14 @@ SemanticsContext::SemanticsContext( foldingContext_{evaluate::FoldingContext{ parser::ContextualMessages{parser::CharBlock{}, &messages_}}} {} -DeclTypeSpec &SemanticsContext::MakeNumericType( +const DeclTypeSpec &SemanticsContext::MakeNumericType( TypeCategory category, int kind) { if (kind == 0) { kind = defaultKinds_.GetDefaultKind(category); } return globalScope_.MakeNumericType(category, kind); } -DeclTypeSpec &SemanticsContext::MakeLogicalType(int kind) { +const DeclTypeSpec &SemanticsContext::MakeLogicalType(int kind) { if (kind == 0) { kind = defaultKinds_.GetDefaultKind(TypeCategory::Logical); } diff --git a/flang/lib/semantics/semantics.h b/flang/lib/semantics/semantics.h index 1a55bd4..a7bfecd 100644 --- a/flang/lib/semantics/semantics.h +++ b/flang/lib/semantics/semantics.h @@ -1,4 +1,4 @@ -// Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved. +// Copyright (c) 2018-2019, NVIDIA CORPORATION. All rights reserved. // // Licensed under the Apache License, Version 2.0 (the "License"); // you may not use this file except in compliance with the License. @@ -67,8 +67,8 @@ public: return *this; } - DeclTypeSpec &MakeNumericType(TypeCategory, int kind = 0); - DeclTypeSpec &MakeLogicalType(int kind = 0); + const DeclTypeSpec &MakeNumericType(TypeCategory, int kind = 0); + const DeclTypeSpec &MakeLogicalType(int kind = 0); bool AnyFatalError() const; template parser::Message &Say(A... args) { diff --git a/flang/lib/semantics/symbol.cc b/flang/lib/semantics/symbol.cc index 7f1711c..771e2b6 100644 --- a/flang/lib/semantics/symbol.cc +++ b/flang/lib/semantics/symbol.cc @@ -74,9 +74,7 @@ void EntityDetails::set_type(const DeclTypeSpec &type) { type_ = &type; } -void EntityDetails::ReplaceType(const DeclTypeSpec &type) { - type_ = &type; -} +void EntityDetails::ReplaceType(const DeclTypeSpec &type) { type_ = &type; } void ObjectEntityDetails::set_shape(const ArraySpec &shape) { CHECK(shape_.empty()); @@ -198,7 +196,7 @@ std::string DetailsToString(const Details &details) { [](const FinalProcDetails &) { return "FinalProc"; }, [](const TypeParamDetails &) { return "TypeParam"; }, [](const MiscDetails &) { return "Misc"; }, - [](const auto &) { return "unknown"; }, + [](const AssocEntityDetails &) { return "AssocEntity"; }, }, details); } @@ -253,6 +251,7 @@ const DeclTypeSpec *Symbol::GetType() const { common::visitors{ [](const EntityDetails &x) { return x.type(); }, [](const ObjectEntityDetails &x) { return x.type(); }, + [](const AssocEntityDetails &x) { return x.type(); }, [](const ProcEntityDetails &x) { return x.interface().type(); }, [](const TypeParamDetails &x) { return x.type(); }, [](const auto &) -> const DeclTypeSpec * { return nullptr; }, @@ -265,6 +264,7 @@ void Symbol::SetType(const DeclTypeSpec &type) { common::visitors{ [&](EntityDetails &x) { x.set_type(type); }, [&](ObjectEntityDetails &x) { x.set_type(type); }, + [&](AssocEntityDetails &x) { x.set_type(type); }, [&](ProcEntityDetails &x) { x.interface().set_type(type); }, [&](TypeParamDetails &x) { x.set_type(type); }, [](auto &) {}, @@ -366,6 +366,12 @@ std::ostream &operator<<(std::ostream &os, const ObjectEntityDetails &x) { return os; } +std::ostream &operator<<(std::ostream &os, const AssocEntityDetails &x) { + os << *static_cast(&x); + x.expr().AsFortran(os << ' '); + return os; +} + bool ProcEntityDetails::HasExplicitInterface() const { if (auto *symbol{interface_.symbol()}) { return symbol->HasExplicitInterface(); @@ -451,10 +457,6 @@ std::ostream &operator<<(std::ostream &os, const Details &details) { [&](const SubprogramNameDetails &x) { os << ' ' << EnumToString(x.kind()); }, - [&](const EntityDetails &x) { os << x; }, - [&](const ObjectEntityDetails &x) { os << x; }, - [&](const ProcEntityDetails &x) { os << x; }, - [&](const DerivedTypeDetails &x) { os << x; }, [&](const UseDetails &x) { os << " from " << x.symbol().name() << " in " << x.module().name(); }, @@ -497,6 +499,7 @@ std::ostream &operator<<(std::ostream &os, const Details &details) { [&](const MiscDetails &x) { os << ' ' << MiscDetails::EnumToString(x.kind()); }, + [&](const auto &x) { os << x; }, }, details); return os; diff --git a/flang/lib/semantics/symbol.h b/flang/lib/semantics/symbol.h index 22efa0b..2169d67 100644 --- a/flang/lib/semantics/symbol.h +++ b/flang/lib/semantics/symbol.h @@ -123,6 +123,16 @@ private: friend std::ostream &operator<<(std::ostream &, const EntityDetails &); }; +// Symbol is associated with a name or expression in a SELECT TYPE or ASSOCIATE. +class AssocEntityDetails : public EntityDetails { +public: + AssocEntityDetails(SomeExpr &&expr) : expr_{std::move(expr)} {} + const SomeExpr &expr() const { return expr_; } + +private: + SomeExpr expr_; +}; + // An entity known to be an object. class ObjectEntityDetails : public EntityDetails { public: @@ -241,7 +251,8 @@ class FinalProcDetails {}; class MiscDetails { public: ENUM_CLASS(Kind, None, ConstructName, ScopeName, PassName, ComplexPartRe, - ComplexPartIm, KindParamInquiry, LenParamInquiry); + ComplexPartIm, KindParamInquiry, LenParamInquiry, + SelectTypeAssociateName); MiscDetails(Kind kind) : kind_{kind} {} Kind kind() const { return kind_; } @@ -340,9 +351,10 @@ class UnknownDetails {}; using Details = std::variant; + ObjectEntityDetails, ProcEntityDetails, AssocEntityDetails, + DerivedTypeDetails, UseDetails, UseErrorDetails, HostAssocDetails, + GenericDetails, ProcBindingDetails, GenericBindingDetails, FinalProcDetails, + TypeParamDetails, MiscDetails>; std::ostream &operator<<(std::ostream &, const Details &); std::string DetailsToString(const Details &); diff --git a/flang/lib/semantics/type.cc b/flang/lib/semantics/type.cc index 4b9a8aa..6bc0e2c 100644 --- a/flang/lib/semantics/type.cc +++ b/flang/lib/semantics/type.cc @@ -134,7 +134,7 @@ DeclTypeSpec::DeclTypeSpec(const LogicalTypeSpec &typeSpec) : category_{Logical}, typeSpec_{typeSpec} {} DeclTypeSpec::DeclTypeSpec(CharacterTypeSpec &typeSpec) : category_{Character}, typeSpec_{&typeSpec} {} -DeclTypeSpec::DeclTypeSpec(Category category, DerivedTypeSpec &typeSpec) +DeclTypeSpec::DeclTypeSpec(Category category, const DerivedTypeSpec &typeSpec) : category_{category}, typeSpec_{&typeSpec} { CHECK(category == TypeDerived || category == ClassDerived); } @@ -171,10 +171,6 @@ const CharacterTypeSpec &DeclTypeSpec::characterTypeSpec() const { CHECK(category_ == Character); return *typeSpec_.character; } -DerivedTypeSpec &DeclTypeSpec::derivedTypeSpec() { - CHECK(category_ == TypeDerived || category_ == ClassDerived); - return *typeSpec_.derived; -} const DerivedTypeSpec &DeclTypeSpec::derivedTypeSpec() const { CHECK(category_ == TypeDerived || category_ == ClassDerived); return *typeSpec_.derived; diff --git a/flang/lib/semantics/type.h b/flang/lib/semantics/type.h index b1bd017..1cf7768 100644 --- a/flang/lib/semantics/type.h +++ b/flang/lib/semantics/type.h @@ -85,8 +85,8 @@ private: // A type parameter value: integer expression or assumed or deferred. class ParamValue { public: - static const ParamValue Assumed() { return Category::Assumed; } - static const ParamValue Deferred() { return Category::Deferred; } + static ParamValue Assumed() { return Category::Assumed; } + static ParamValue Deferred() { return Category::Deferred; } explicit ParamValue(MaybeIntExpr &&expr); explicit ParamValue(std::int64_t); bool isExplicit() const { return category_ == Category::Explicit; } @@ -242,7 +242,7 @@ public: // character DeclTypeSpec(CharacterTypeSpec &); // TYPE(derived-type-spec) or CLASS(derived-type-spec) - DeclTypeSpec(Category, DerivedTypeSpec &); + DeclTypeSpec(Category, const DerivedTypeSpec &); // TYPE(*) or CLASS(*) DeclTypeSpec(Category); DeclTypeSpec() = delete; @@ -258,7 +258,6 @@ public: const LogicalTypeSpec &logicalTypeSpec() const; const CharacterTypeSpec &characterTypeSpec() const; const DerivedTypeSpec &derivedTypeSpec() const; - DerivedTypeSpec &derivedTypeSpec(); void set_category(Category category) { category_ = category; } private: @@ -267,12 +266,12 @@ private: TypeSpec() : derived{nullptr} {} TypeSpec(NumericTypeSpec numeric) : numeric{numeric} {} TypeSpec(LogicalTypeSpec logical) : logical{logical} {} - TypeSpec(CharacterTypeSpec *character) : character{character} {} - TypeSpec(DerivedTypeSpec *derived) : derived{derived} {} + TypeSpec(const CharacterTypeSpec *character) : character{character} {} + TypeSpec(const DerivedTypeSpec *derived) : derived{derived} {} NumericTypeSpec numeric; LogicalTypeSpec logical; - CharacterTypeSpec *character; - DerivedTypeSpec *derived; + const CharacterTypeSpec *character; + const DerivedTypeSpec *derived; } typeSpec_; }; std::ostream &operator<<(std::ostream &, const DeclTypeSpec &); diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt index 8c54b31..3950730 100644 --- a/flang/test/semantics/CMakeLists.txt +++ b/flang/test/semantics/CMakeLists.txt @@ -63,6 +63,7 @@ set(ERROR_TESTS resolve36.f90 resolve37.f90 resolve38.f90 + resolve39.f90 ) # These test files have expected symbols in the source @@ -77,6 +78,7 @@ set(SYMBOL_TESTS symbol08.f90 symbol09.f90 symbol10.f90 + symbol11.f90 ) # These test files have expected .mod file contents in the source diff --git a/flang/test/semantics/resolve39.f90 b/flang/test/semantics/resolve39.f90 new file mode 100644 index 0000000..72c2b31 --- /dev/null +++ b/flang/test/semantics/resolve39.f90 @@ -0,0 +1,24 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +subroutine s1 + implicit none + real(8) :: x = 2.0 + !ERROR: The associate name 'a' is already used in this associate statement + associate(a => x, b => x+1, a => x+2) + x = b + end associate + !ERROR: No explicit type declared for 'b' + x = b +end diff --git a/flang/test/semantics/symbol11.f90 b/flang/test/semantics/symbol11.f90 new file mode 100644 index 0000000..a6d3cd0 --- /dev/null +++ b/flang/test/semantics/symbol11.f90 @@ -0,0 +1,95 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +!DEF: /s1 Subprogram +subroutine s1 + implicit none + !DEF: /s1/x ObjectEntity REAL(8) + real(kind=8) :: x = 2.0 + !DEF: /s1/a ObjectEntity INTEGER(4) + integer a + !DEF: /s1/t DerivedType + type :: t + end type + !REF: /s1/t + !DEF: /s1/z ALLOCATABLE ObjectEntity CLASS(t) + class(t), allocatable :: z + !DEF: /s1/Block1/a AssocEntity REAL(8) + !REF: /s1/x + !DEF: /s1/Block1/b AssocEntity REAL(8) + !DEF: /s1/Block1/c AssocEntity CLASS(t) + !REF: /s1/z + associate (a => x, b => x+1, c => z) + !REF: /s1/x + !REF: /s1/Block1/a + x = a + end associate +end subroutine + +!DEF: /s2 Subprogram +subroutine s2 + !DEF: /s2/x ObjectEntity CHARACTER(4_4,1) + !DEF: /s2/y ObjectEntity CHARACTER(4_4,1) + character(len=4) x, y + !DEF: /s2/Block1/z AssocEntity CHARACTER(4_4,1) + !REF: /s2/x + associate (z => x) + !REF: /s2/Block1/z + print *, "z:", z + end associate + !TODO: need correct length for z + !DEF: /s2/Block2/z AssocEntity CHARACTER(:,1) + !REF: /s2/x + !REF: /s2/y + associate (z => x//y) + !REF: /s2/Block2/z + print *, "z:", z + end associate +end subroutine + +!DEF: /s3 Subprogram +subroutine s3 + !DEF: /s3/t1 DerivedType + type :: t1 + !DEF: /s3/t1/a1 ObjectEntity INTEGER(4) + integer :: a1 + end type + !REF: /s3/t1 + !DEF: /s3/t2 DerivedType + type, extends(t1) :: t2 + !DEF: /s3/t2/a2 ObjectEntity INTEGER(4) + integer :: a2 + end type + !DEF: /s3/i ObjectEntity INTEGER(4) + integer i + !REF: /s3/t1 + !DEF: /s3/x POINTER ObjectEntity CLASS(t1) + class(t1), pointer :: x + !REF: /s3/x + select type (y => x) + !REF: /s3/t2 + class is (t2) + !REF: /s3/i + !DEF: /s3/Block1/y TARGET AssocEntity TYPE(t2) + !REF: /s3/t2/a2 + i = y%a2 + type is (integer(kind=8)) + !REF: /s3/i + !DEF: /s3/Block2/y TARGET AssocEntity INTEGER(8) + i = y + class default + !DEF: /s3/Block3/y TARGET AssocEntity CLASS(t1) + print *, y + end select +end subroutine diff --git a/flang/test/semantics/test_symbols.sh b/flang/test/semantics/test_symbols.sh index 55ce147..c64753a 100755 --- a/flang/test/semantics/test_symbols.sh +++ b/flang/test/semantics/test_symbols.sh @@ -1,5 +1,5 @@ #!/usr/bin/env bash -# Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved. +# Copyright (c) 2018-2019, NVIDIA CORPORATION. All rights reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -46,7 +46,7 @@ sed -e 's/!\([DR]EF:\)/KEEP \1/' \ egrep -v '^ *!' $src1 > $src2 # strip out meaningful comments $CMD $src2 > $src3 # compile, inserting comments for symbols -if diff -U999999 $src1 $src3 > $diffs; then +if diff -w -U999999 $src1 $src3 > $diffs; then echo PASS else sed '1,/^\@\@/d' $diffs -- 2.7.4