diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -840,4 +840,29 @@ const IntrinsicProcTable &, const ProcedureRef &); } // namespace Fortran::evaluate + +namespace Fortran::semantics { + +class Scope; + +// These functions are used in Evaluate so they are defined here rather than in +// Semantics to avoid a link-time dependency on Semantics. + +bool IsVariableName(const Symbol &); +bool IsPureProcedure(const Symbol &); +bool IsPureProcedure(const Scope &); +bool IsFunction(const Symbol &); +bool IsProcedure(const Symbol &); +bool IsProcedurePointer(const Symbol &); +bool IsSaved(const Symbol &); // saved implicitly or explicitly +bool IsDummy(const Symbol &); + +// Follow use, host, and construct assocations to a variable, if any. +const Symbol *GetAssociationRoot(const Symbol &); +const Symbol *FindCommonBlockContaining(const Symbol &); +int CountLenParameters(const DerivedTypeSpec &); +const Symbol &GetUsedModule(const UseDetails &); + +} // namespace Fortran::semantics + #endif // FORTRAN_EVALUATE_TOOLS_H_ diff --git a/flang/include/flang/Semantics/scope.h b/flang/include/flang/Semantics/scope.h --- a/flang/include/flang/Semantics/scope.h +++ b/flang/include/flang/Semantics/scope.h @@ -89,7 +89,7 @@ Symbol *symbol() { return symbol_; } const Symbol *symbol() const { return symbol_; } - const Symbol *GetSymbol() const; + inline const Symbol *GetSymbol() const; const Scope *GetDerivedTypeParent() const; const Scope &GetDerivedTypeBase() const; std::optional GetName() const; @@ -255,5 +255,13 @@ friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const Scope &); }; + +// Inline so that it can be called from Evaluate without a link-time dependency. + +inline const Symbol *Scope::GetSymbol() const { + return symbol_ ? symbol_ + : derivedTypeSpec_ ? &derivedTypeSpec_->typeSymbol() : nullptr; +} + } // namespace Fortran::semantics #endif // FORTRAN_SEMANTICS_SCOPE_H_ diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -364,7 +364,6 @@ : location_{location}, symbol_{symbol} {} const SourceName &location() const { return location_; } const Symbol &symbol() const { return symbol_; } - const Symbol &module() const; private: SourceName location_; @@ -552,51 +551,13 @@ bool CanReplaceDetails(const Details &details) const; // Follow use-associations and host-associations to get the ultimate entity. - Symbol &GetUltimate() { - return const_cast( - const_cast(this)->GetUltimate()); - } - const Symbol &GetUltimate() const { - if (const auto *details{detailsIf()}) { - return details->symbol().GetUltimate(); - } else if (const auto *details{detailsIf()}) { - return details->symbol().GetUltimate(); - } else { - return *this; - } - } + inline Symbol &GetUltimate(); + inline const Symbol &GetUltimate() const; - DeclTypeSpec *GetType() { - return const_cast( - const_cast(this)->GetType()); - } - const DeclTypeSpec *GetType() const { - return std::visit( - common::visitors{ - [](const EntityDetails &x) { return x.type(); }, - [](const ObjectEntityDetails &x) { return x.type(); }, - [](const AssocEntityDetails &x) { return x.type(); }, - [](const SubprogramDetails &x) { - return x.isFunction() ? x.result().GetType() : nullptr; - }, - [](const ProcEntityDetails &x) { - if (const Symbol * symbol{x.interface().symbol()}) { - return symbol->GetType(); - } else { - return x.interface().type(); - } - }, - [&](const ProcBindingDetails &x) { return x.symbol().GetType(); }, - [](const TypeParamDetails &x) { return x.type(); }, - [](const UseDetails &x) { return x.symbol().GetType(); }, - [](const HostAssocDetails &x) { return x.symbol().GetType(); }, - [](const auto &) -> const DeclTypeSpec * { return nullptr; }, - }, - details_); - } + inline DeclTypeSpec *GetType(); + inline const DeclTypeSpec *GetType() const; void SetType(const DeclTypeSpec &); - bool IsDummy() const; bool IsFuncResult() const; bool IsObjectArray() const; bool IsSubprogram() const; @@ -753,6 +714,45 @@ return false; } +inline Symbol &Symbol::GetUltimate() { + return const_cast(const_cast(this)->GetUltimate()); +} +inline const Symbol &Symbol::GetUltimate() const { + if (const auto *details{detailsIf()}) { + return details->symbol().GetUltimate(); + } else if (const auto *details{detailsIf()}) { + return details->symbol().GetUltimate(); + } else { + return *this; + } +} + +inline DeclTypeSpec *Symbol::GetType() { + return const_cast( + const_cast(this)->GetType()); +} +inline const DeclTypeSpec *Symbol::GetType() const { + return std::visit( + common::visitors{ + [](const EntityDetails &x) { return x.type(); }, + [](const ObjectEntityDetails &x) { return x.type(); }, + [](const AssocEntityDetails &x) { return x.type(); }, + [](const SubprogramDetails &x) { + return x.isFunction() ? x.result().GetType() : nullptr; + }, + [](const ProcEntityDetails &x) { + const Symbol *symbol{x.interface().symbol()}; + return symbol ? symbol->GetType() : x.interface().type(); + }, + [](const ProcBindingDetails &x) { return x.symbol().GetType(); }, + [](const TypeParamDetails &x) { return x.type(); }, + [](const UseDetails &x) { return x.symbol().GetType(); }, + [](const HostAssocDetails &x) { return x.symbol().GetType(); }, + [](const auto &) -> const DeclTypeSpec * { return nullptr; }, + }, + details_); +} + inline bool operator<(SymbolRef x, SymbolRef y) { return *x < *y; } inline bool operator<(MutableSymbolRef x, MutableSymbolRef y) { return *x < *y; diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h --- a/flang/include/flang/Semantics/tools.h +++ b/flang/include/flang/Semantics/tools.h @@ -31,7 +31,6 @@ class Symbol; const Scope *FindModuleContaining(const Scope &); -const Symbol *FindCommonBlockContaining(const Symbol &object); const Scope *FindProgramUnitContaining(const Scope &); const Scope *FindProgramUnitContaining(const Symbol &); const Scope *FindPureProcedureContaining(const Scope &); @@ -50,9 +49,6 @@ const DeclTypeSpec *FindParentTypeSpec(const Scope &); const DeclTypeSpec *FindParentTypeSpec(const Symbol &); -// Return the Symbol of the variable of a construct association, if it exists -const Symbol *GetAssociationRoot(const Symbol &); - enum class Tristate { No, Yes, Maybe }; inline Tristate ToTristate(bool x) { return x ? Tristate::Yes : Tristate::No; } @@ -78,21 +74,17 @@ bool DoesScopeContain(const Scope *, const Symbol &); bool IsUseAssociated(const Symbol &, const Scope &); bool IsHostAssociated(const Symbol &, const Scope &); -bool IsDummy(const Symbol &); -bool IsStmtFunction(const Symbol &); +inline bool IsStmtFunction(const Symbol &symbol) { + const auto *subprogram{symbol.detailsIf()}; + return subprogram && subprogram->stmtFunction(); +} bool IsInStmtFunction(const Symbol &); bool IsStmtFunctionDummy(const Symbol &); bool IsStmtFunctionResult(const Symbol &); bool IsPointerDummy(const Symbol &); -bool IsFunction(const Symbol &); -bool IsPureProcedure(const Symbol &); -bool IsPureProcedure(const Scope &); bool IsBindCProcedure(const Symbol &); bool IsBindCProcedure(const Scope &); -bool IsProcedure(const Symbol &); bool IsProcName(const Symbol &symbol); // proc-name -bool IsVariableName(const Symbol &symbol); // variable-name -bool IsProcedurePointer(const Symbol &); bool IsFunctionResult(const Symbol &); bool IsFunctionResultWithSameNameAsFunction(const Symbol &); bool IsExtensibleType(const DerivedTypeSpec *); @@ -103,8 +95,6 @@ bool IsIsoCType(const DerivedTypeSpec *); bool IsEventTypeOrLockType(const DerivedTypeSpec *); bool IsOrContainsEventOrLockComponent(const Symbol &); -// Has an explicit or implied SAVE attribute -bool IsSaved(const Symbol &); bool CanBeTypeBoundProc(const Symbol *); bool IsInitialized(const Symbol &); bool HasIntrinsicTypeName(const Symbol &); diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h --- a/flang/include/flang/Semantics/type.h +++ b/flang/include/flang/Semantics/type.h @@ -217,13 +217,12 @@ struct ArraySpec : public std::vector { ArraySpec() {} int Rank() const { return size(); } - bool IsExplicitShape() const; - bool IsAssumedShape() const; - bool IsDeferredShape() const; - bool IsImpliedShape() const; - bool IsAssumedSize() const; - bool IsAssumedRank() const; - bool IsConstantShape() const; // explicit shape with constant bounds + inline bool IsExplicitShape() const; + inline bool IsAssumedShape() const; + inline bool IsDeferredShape() const; + inline bool IsImpliedShape() const; + inline bool IsAssumedSize() const; + inline bool IsAssumedRank() const; private: // Check non-empty and predicate is true for each element. @@ -251,7 +250,6 @@ void ReplaceScope(const Scope &); RawParameters &rawParameters() { return rawParameters_; } const ParameterMapType ¶meters() const { return parameters_; } - int NumLengthParameters() const; bool MightBeParameterized() const; bool IsForwardReferenced() const; @@ -354,10 +352,10 @@ return std::get(typeSpec_); } - IntrinsicTypeSpec *AsIntrinsic(); - const IntrinsicTypeSpec *AsIntrinsic() const; - DerivedTypeSpec *AsDerived(); - const DerivedTypeSpec *AsDerived() const; + inline IntrinsicTypeSpec *AsIntrinsic(); + inline const IntrinsicTypeSpec *AsIntrinsic() const; + inline DerivedTypeSpec *AsDerived(); + inline const DerivedTypeSpec *AsDerived() const; std::string AsFortran() const; @@ -383,5 +381,62 @@ const Symbol *symbol_{nullptr}; const DeclTypeSpec *type_{nullptr}; }; + +// Define some member functions here in the header so that they can be used by +// lib/Evaluate without link-time dependency on Semantics. + +inline bool ArraySpec::IsExplicitShape() const { + return CheckAll([](const ShapeSpec &x) { return x.ubound().isExplicit(); }); +} +inline bool ArraySpec::IsAssumedShape() const { + return CheckAll([](const ShapeSpec &x) { return x.ubound().isDeferred(); }); +} +inline bool ArraySpec::IsDeferredShape() const { + return CheckAll([](const ShapeSpec &x) { + return x.lbound().isDeferred() && x.ubound().isDeferred(); + }); +} +inline bool ArraySpec::IsImpliedShape() const { + return !IsAssumedRank() && + CheckAll([](const ShapeSpec &x) { return x.ubound().isAssumed(); }); +} +inline bool ArraySpec::IsAssumedSize() const { + return !empty() && !IsAssumedRank() && back().ubound().isAssumed() && + std::all_of(begin(), end() - 1, + [](const ShapeSpec &x) { return x.ubound().isExplicit(); }); +} +inline bool ArraySpec::IsAssumedRank() const { + return Rank() == 1 && front().lbound().isAssumed(); +} + +inline IntrinsicTypeSpec *DeclTypeSpec::AsIntrinsic() { + switch (category_) { + case Numeric: + return &std::get(typeSpec_); + case Logical: + return &std::get(typeSpec_); + case Character: + return &std::get(typeSpec_); + default: + return nullptr; + } +} +inline const IntrinsicTypeSpec *DeclTypeSpec::AsIntrinsic() const { + return const_cast(this)->AsIntrinsic(); +} + +inline DerivedTypeSpec *DeclTypeSpec::AsDerived() { + switch (category_) { + case TypeDerived: + case ClassDerived: + return &std::get(typeSpec_); + default: + return nullptr; + } +} +inline const DerivedTypeSpec *DeclTypeSpec::AsDerived() const { + return const_cast(this)->AsDerived(); +} + } // namespace Fortran::semantics #endif // FORTRAN_SEMANTICS_TYPE_H_ diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -208,7 +208,7 @@ return "derived type component or type parameter value not allowed to " "reference variable '"s + symbol.name().ToString() + "'"; - } else if (symbol.IsDummy()) { + } else if (IsDummy(symbol)) { if (symbol.attrs().test(semantics::Attr::OPTIONAL)) { return "reference to OPTIONAL dummy argument '"s + symbol.name().ToString() + "'"; diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -823,7 +823,7 @@ if (const auto *use{symbol.detailsIf()}) { message.Attach(use->location(), "'%s' is USE-associated with '%s' in module '%s'"_en_US, symbol.name(), - unhosted->name(), use->module().name()); + unhosted->name(), GetUsedModule(*use).name()); } else { message.Attach( unhosted->name(), "Declaration of '%s'"_en_US, unhosted->name()); @@ -872,3 +872,156 @@ } } // namespace Fortran::evaluate + +namespace Fortran::semantics { + +// When a construct association maps to a variable, and that variable +// is not an array with a vector-valued subscript, return the base +// Symbol of that variable, else nullptr. Descends into other construct +// associations when one associations maps to another. +static const Symbol *GetAssociatedVariable( + const semantics::AssocEntityDetails &details) { + if (const auto &expr{details.expr()}) { + if (IsVariable(*expr) && !HasVectorSubscript(*expr)) { + if (const Symbol * varSymbol{GetFirstSymbol(*expr)}) { + return GetAssociationRoot(*varSymbol); + } + } + } + return nullptr; +} + +const Symbol *GetAssociationRoot(const Symbol &symbol) { + const Symbol &ultimate{symbol.GetUltimate()}; + const auto *details{ultimate.detailsIf()}; + return details ? GetAssociatedVariable(*details) : &ultimate; +} + +bool IsVariableName(const Symbol &symbol) { + const Symbol *root{GetAssociationRoot(symbol)}; + return root && root->has() && !IsNamedConstant(*root); +} + +bool IsPureProcedure(const Symbol &symbol) { + if (const auto *procDetails{symbol.detailsIf()}) { + if (const Symbol * procInterface{procDetails->interface().symbol()}) { + // procedure component with a pure interface + return IsPureProcedure(*procInterface); + } + } else if (const auto *details{symbol.detailsIf()}) { + return IsPureProcedure(details->symbol()); + } else if (!IsProcedure(symbol)) { + return false; + } + if (IsStmtFunction(symbol)) { + // Section 15.7(1) states that a statement function is PURE if it does not + // reference an IMPURE procedure or a VOLATILE variable + if (const auto &expr{symbol.get().stmtFunction()}) { + for (const SymbolRef &ref : evaluate::CollectSymbols(*expr)) { + if (IsFunction(*ref) && !IsPureProcedure(*ref)) { + return false; + } + const Symbol *root{GetAssociationRoot(*ref)}; + if (root && root->attrs().test(Attr::VOLATILE)) { + return false; + } + } + } + return true; // statement function was not found to be impure + } + return symbol.attrs().test(Attr::PURE) || + (symbol.attrs().test(Attr::ELEMENTAL) && + !symbol.attrs().test(Attr::IMPURE)); +} + +bool IsPureProcedure(const Scope &scope) { + const Symbol *symbol{scope.GetSymbol()}; + return symbol && IsPureProcedure(*symbol); +} + +bool IsFunction(const Symbol &symbol) { + return std::visit( + common::visitors{ + [](const SubprogramDetails &x) { return x.isFunction(); }, + [&](const SubprogramNameDetails &) { + return symbol.test(Symbol::Flag::Function); + }, + [](const ProcEntityDetails &x) { + const auto &ifc{x.interface()}; + return ifc.type() || (ifc.symbol() && IsFunction(*ifc.symbol())); + }, + [](const ProcBindingDetails &x) { return IsFunction(x.symbol()); }, + [](const UseDetails &x) { return IsFunction(x.symbol()); }, + [](const auto &) { return false; }, + }, + symbol.details()); +} + +bool IsProcedure(const Symbol &symbol) { + return std::visit( + common::visitors{ + [](const SubprogramDetails &) { return true; }, + [](const SubprogramNameDetails &) { return true; }, + [](const ProcEntityDetails &) { return true; }, + [](const GenericDetails &) { return true; }, + [](const ProcBindingDetails &) { return true; }, + [](const UseDetails &x) { return IsProcedure(x.symbol()); }, + // TODO: FinalProcDetails? + [](const auto &) { return false; }, + }, + symbol.details()); +} + +const Symbol *FindCommonBlockContaining(const Symbol &object) { + const auto *details{object.detailsIf()}; + return details ? details->commonBlock() : nullptr; +} + +bool IsProcedurePointer(const Symbol &symbol) { + return symbol.has() && IsPointer(symbol); +} + +bool IsSaved(const Symbol &symbol) { + auto scopeKind{symbol.owner().kind()}; + if (scopeKind == Scope::Kind::Module || scopeKind == Scope::Kind::BlockData) { + return true; + } else if (scopeKind == Scope::Kind::DerivedType) { + return false; // this is a component + } else if (IsNamedConstant(symbol)) { + return false; + } else if (symbol.attrs().test(Attr::SAVE)) { + return true; + } else if (const auto *object{symbol.detailsIf()}; + object && object->init()) { + return true; + } else if (IsProcedurePointer(symbol) && + symbol.get().init()) { + return true; + } else if (const Symbol * block{FindCommonBlockContaining(symbol)}; + block && block->attrs().test(Attr::SAVE)) { + return true; + } else { + return false; + } +} + +bool IsDummy(const Symbol &symbol) { + return std::visit( + common::visitors{[](const EntityDetails &x) { return x.isDummy(); }, + [](const ObjectEntityDetails &x) { return x.isDummy(); }, + [](const ProcEntityDetails &x) { return x.isDummy(); }, + [](const HostAssocDetails &x) { return IsDummy(x.symbol()); }, + [](const auto &) { return false; }}, + symbol.details()); +} + +int CountLenParameters(const DerivedTypeSpec &type) { + return std::count_if(type.parameters().begin(), type.parameters().end(), + [](const auto &pair) { return pair.second.isLen(); }); +} + +const Symbol &GetUsedModule(const UseDetails &details) { + return DEREF(details.symbol().owner().symbol()); +} + +} // namespace Fortran::semantics diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp --- a/flang/lib/Evaluate/type.cpp +++ b/flang/lib/Evaluate/type.cpp @@ -23,6 +23,7 @@ // IsDescriptor() predicate // TODO there's probably a better place for this predicate than here namespace Fortran::semantics { + static bool IsDescriptor(const ObjectEntityDetails &details) { if (const auto *type{details.type()}) { if (auto dynamicType{evaluate::DynamicType::From(*type)}) { @@ -32,7 +33,14 @@ } } // TODO: Automatic (adjustable) arrays - are they descriptors? - return !details.shape().empty() && !details.shape().IsConstantShape(); + for (const ShapeSpec &shapeSpec : details.shape()) { + const auto &lb{shapeSpec.lbound().GetExplicit()}; + const auto &ub{shapeSpec.ubound().GetExplicit()}; + if (!lb || !ub || !IsConstantExpr(*lb) || !IsConstantExpr(*ub)) { + return true; + } + } + return false; } static bool IsDescriptor(const ProcEntityDetails &details) { @@ -427,7 +435,7 @@ bool DynamicType::RequiresDescriptor() const { return IsPolymorphic() || IsUnknownLengthCharacter() || - (derived_ && derived_->NumLengthParameters() > 0); + (derived_ && CountLenParameters(*derived_) > 0); } bool DynamicType::HasDeferredTypeParameter() const { diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -341,7 +341,7 @@ const Symbol &symbol, const ObjectEntityDetails &details) { if (const DeclTypeSpec * type{symbol.GetType()}; type && type->category() == DeclTypeSpec::TypeStar) { - if (!symbol.IsDummy()) { + if (!IsDummy(symbol)) { messages_.Say( "Assumed-type entity '%s' must be a dummy argument"_err_en_US, symbol.name()); @@ -477,7 +477,7 @@ if (const DeclTypeSpec * type{details.type()}) { // C708 if (type->IsPolymorphic() && !(type->IsAssumedType() || IsAllocatableOrPointer(symbol) || - symbol.IsDummy())) { + IsDummy(symbol))) { messages_.Say("CLASS entity '%s' must be a dummy argument or have " "ALLOCATABLE or POINTER attribute"_err_en_US, symbol.name()); @@ -530,7 +530,7 @@ " assumed rank"_err_en_US; } } - } else if (symbol.IsDummy()) { + } else if (IsDummy(symbol)) { if (isImplied && !isAssumedSize) { // C836 msg = "Dummy array argument '%s' may not have implied shape"_err_en_US; } diff --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp --- a/flang/lib/Semantics/compute-offsets.cpp +++ b/flang/lib/Semantics/compute-offsets.cpp @@ -212,7 +212,7 @@ if (IsDescriptor(symbol) || IsProcedure(symbol)) { int lenParams{0}; if (const DerivedTypeSpec * derived{type->AsDerived()}) { - lenParams = derived->NumLengthParameters(); + lenParams = CountLenParameters(*derived); } std::size_t size{ runtime::Descriptor::SizeInBytes(symbol.Rank(), false, lenParams)}; diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -389,7 +389,7 @@ void ModFileWriter::PutUse(const Symbol &symbol) { auto &details{symbol.get()}; auto &use{details.symbol()}; - uses_ << "use " << details.module().name(); + uses_ << "use " << GetUsedModule(details).name(); PutGenericName(uses_ << ",only:", symbol); // Can have intrinsic op with different local-name and use-name // (e.g. `operator(<)` and `operator(.lt.)`) but rename is not allowed diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp --- a/flang/lib/Semantics/resolve-names-utils.cpp +++ b/flang/lib/Semantics/resolve-names-utils.cpp @@ -557,7 +557,7 @@ if (symbol.owner().IsDerivedType()) { // C8107 msg = "Derived type component '%s'" " is not allowed in an equivalence set"_err_en_US; - } else if (symbol.IsDummy()) { // C8106 + } else if (IsDummy(symbol)) { // C8106 msg = "Dummy argument '%s' is not allowed in an equivalence set"_err_en_US; } else if (symbol.IsFuncResult()) { // C8106 msg = "Function result '%s' is not allow in an equivalence set"_err_en_US; diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -931,7 +931,7 @@ } else if (auto *details{symbol.detailsIf()}) { Say(name.source, "'%s' is use-associated from module '%s' and cannot be re-declared"_err_en_US, - name.source, details->module().name()); + name.source, GetUsedModule(*details).name()); } else if (auto *details{symbol.detailsIf()}) { if (details->kind() == SubprogramKind::Module) { Say2(name, @@ -1932,7 +1932,7 @@ Say(name, "'%s' is already declared in this scoping unit"_err_en_US) .Attach(details->location(), "It is use-associated with '%s' in module '%s'"_err_en_US, - details->symbol().name(), details->module().name()); + details->symbol().name(), GetUsedModule(*details).name()); } else { SayAlreadyDeclared(name, prev.name()); } @@ -2363,14 +2363,14 @@ Say(location, "Generic interface '%s' has ambiguous specific procedures" " from modules '%s' and '%s'"_err_en_US, - localSymbol.name(), useDetails->module().name(), + localSymbol.name(), GetUsedModule(*useDetails).name(), useSymbol.owner().GetName().value()); } else if (generic1.derivedType() && generic2.derivedType() && generic1.derivedType() != generic2.derivedType()) { Say(location, "Generic interface '%s' has ambiguous derived types" " from modules '%s' and '%s'"_err_en_US, - localSymbol.name(), useDetails->module().name(), + localSymbol.name(), GetUsedModule(*useDetails).name(), useSymbol.owner().GetName().value()); } else { generic1.CopyFrom(generic2); @@ -4420,7 +4420,7 @@ // If SAVE attribute can't be set on symbol, return error message. std::optional DeclarationVisitor::CheckSaveAttr( const Symbol &symbol) { - if (symbol.IsDummy()) { + if (IsDummy(symbol)) { return "SAVE attribute may not be applied to dummy argument '%s'"_err_en_US; } else if (symbol.IsFuncResult()) { return "SAVE attribute may not be applied to function result '%s'"_err_en_US; @@ -4483,7 +4483,7 @@ } 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 (symbol->IsDummy()) { + } else if (IsDummy(*symbol)) { Say(name, "Dummy argument '%s' may not appear in a COMMON block"_err_en_US); } else if (symbol->IsFuncResult()) { @@ -4609,7 +4609,7 @@ return false; } if (const DeclTypeSpec * type{symbol.GetType()}) { - if (type->IsPolymorphic() && symbol.IsDummy() && + if (type->IsPolymorphic() && IsDummy(symbol) && !IsPointer(symbol)) { // C1128 SayWithDecl(name, symbol, "Nonpointer polymorphic argument '%s' not allowed in a " @@ -5499,7 +5499,7 @@ if (CheckUseError(name)) { return nullptr; // reported an error } - if (symbol->IsDummy() || + if (IsDummy(*symbol) || (!symbol->GetType() && FindCommonBlockContaining(*symbol))) { ConvertToObjectEntity(*symbol); ApplyImplicitRules(*symbol); @@ -5841,7 +5841,7 @@ ConvertToProcEntity(*symbol); if (symbol->has()) { symbol->set(flag); - if (symbol->IsDummy()) { + if (IsDummy(*symbol)) { symbol->attrs().set(Attr::EXTERNAL); } ApplyImplicitRules(*symbol); diff --git a/flang/lib/Semantics/scope.cpp b/flang/lib/Semantics/scope.cpp --- a/flang/lib/Semantics/scope.cpp +++ b/flang/lib/Semantics/scope.cpp @@ -362,16 +362,6 @@ } } -const Symbol *Scope::GetSymbol() const { - if (symbol_) { - return symbol_; - } - if (derivedTypeSpec_) { - return &derivedTypeSpec_->typeSymbol(); - } - return nullptr; -} - const Scope *Scope::GetDerivedTypeParent() const { if (const Symbol * symbol{GetSymbol()}) { if (const DerivedTypeSpec * parent{symbol->GetParentTypeSpec(this)}) { diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp --- a/flang/lib/Semantics/symbol.cpp +++ b/flang/lib/Semantics/symbol.cpp @@ -141,13 +141,8 @@ } } -const Symbol &UseDetails::module() const { - // owner is a module so it must have a symbol: - return *symbol_->owner().symbol(); -} - UseErrorDetails::UseErrorDetails(const UseDetails &useDetails) { - add_occurrence(useDetails.location(), *useDetails.module().scope()); + add_occurrence(useDetails.location(), *GetUsedModule(useDetails).scope()); } UseErrorDetails &UseErrorDetails::add_occurrence( const SourceName &location, const Scope &module) { @@ -287,16 +282,6 @@ details_); } -bool Symbol::IsDummy() const { - return std::visit( - common::visitors{[](const EntityDetails &x) { return x.isDummy(); }, - [](const ObjectEntityDetails &x) { return x.isDummy(); }, - [](const ProcEntityDetails &x) { return x.isDummy(); }, - [](const HostAssocDetails &x) { return x.symbol().IsDummy(); }, - [](const auto &) { return false; }}, - details_); -} - bool Symbol::IsFuncResult() const { return std::visit( common::visitors{[](const EntityDetails &x) { return x.isFuncResult(); }, @@ -389,7 +374,7 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Details &details) { os << DetailsToString(details); - std::visit( + std::visit( // common::visitors{ [&](const UnknownDetails &) {}, [&](const MainProgramDetails &) {}, @@ -413,7 +398,8 @@ os << ' ' << EnumToString(x.kind()); }, [&](const UseDetails &x) { - os << " from " << x.symbol().name() << " in " << x.module().name(); + os << " from " << x.symbol().name() << " in " + << GetUsedModule(x).name(); }, [&](const UseErrorDetails &x) { os << " uses:"; diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -42,14 +42,6 @@ start, [](const Scope &scope) { return scope.IsModule(); }); } -const Symbol *FindCommonBlockContaining(const Symbol &object) { - if (const auto *details{object.detailsIf()}) { - return details->commonBlock(); - } else { - return nullptr; - } -} - const Scope *FindProgramUnitContaining(const Scope &start) { return FindScopeContaining(start, [](const Scope &scope) { switch (scope.kind()) { @@ -193,21 +185,6 @@ DoesScopeContain(FindProgramUnitContaining(symbol), *subprogram); } -bool IsDummy(const Symbol &symbol) { - if (const auto *details{symbol.detailsIf()}) { - return details->isDummy(); - } else if (const auto *details{symbol.detailsIf()}) { - return details->isDummy(); - } else { - return false; - } -} - -bool IsStmtFunction(const Symbol &symbol) { - const auto *subprogram{symbol.detailsIf()}; - return subprogram && subprogram->stmtFunction(); -} - bool IsInStmtFunction(const Symbol &symbol) { if (const Symbol * function{symbol.owner().symbol()}) { return IsStmtFunction(*function); @@ -227,80 +204,11 @@ return IsPointer(symbol) && IsDummy(symbol); } -// variable-name -bool IsVariableName(const Symbol &symbol) { - if (const Symbol * root{GetAssociationRoot(symbol)}) { - return root->has() && !IsNamedConstant(*root); - } else { - return false; - } -} - // proc-name bool IsProcName(const Symbol &symbol) { return symbol.GetUltimate().has(); } -bool IsFunction(const Symbol &symbol) { - return std::visit( - common::visitors{ - [](const SubprogramDetails &x) { return x.isFunction(); }, - [&](const SubprogramNameDetails &) { - return symbol.test(Symbol::Flag::Function); - }, - [](const ProcEntityDetails &x) { - const auto &ifc{x.interface()}; - return ifc.type() || (ifc.symbol() && IsFunction(*ifc.symbol())); - }, - [](const ProcBindingDetails &x) { return IsFunction(x.symbol()); }, - [](const UseDetails &x) { return IsFunction(x.symbol()); }, - [](const auto &) { return false; }, - }, - symbol.details()); -} - -bool IsPureProcedure(const Symbol &symbol) { - if (const auto *procDetails{symbol.detailsIf()}) { - if (const Symbol * procInterface{procDetails->interface().symbol()}) { - // procedure component with a pure interface - return IsPureProcedure(*procInterface); - } - } else if (const auto *details{symbol.detailsIf()}) { - return IsPureProcedure(details->symbol()); - } else if (!IsProcedure(symbol)) { - return false; - } - if (IsStmtFunction(symbol)) { - // Section 15.7(1) states that a statement function is PURE if it does not - // reference an IMPURE procedure or a VOLATILE variable - const MaybeExpr &expr{symbol.get().stmtFunction()}; - if (expr) { - for (const Symbol &refSymbol : evaluate::CollectSymbols(*expr)) { - if (IsFunction(refSymbol) && !IsPureProcedure(refSymbol)) { - return false; - } - if (const Symbol * root{GetAssociationRoot(refSymbol)}) { - if (root->attrs().test(Attr::VOLATILE)) { - return false; - } - } - } - } - return true; // statement function was not found to be impure - } - return symbol.attrs().test(Attr::PURE) || - (symbol.attrs().test(Attr::ELEMENTAL) && - !symbol.attrs().test(Attr::IMPURE)); -} - -bool IsPureProcedure(const Scope &scope) { - if (const Symbol * symbol{scope.GetSymbol()}) { - return IsPureProcedure(*symbol); - } else { - return false; - } -} - bool IsBindCProcedure(const Symbol &symbol) { if (const auto *procDetails{symbol.detailsIf()}) { if (const Symbol * procInterface{procDetails->interface().symbol()}) { @@ -319,25 +227,6 @@ } } -bool IsProcedure(const Symbol &symbol) { - return std::visit( - common::visitors{ - [](const SubprogramDetails &) { return true; }, - [](const SubprogramNameDetails &) { return true; }, - [](const ProcEntityDetails &) { return true; }, - [](const GenericDetails &) { return true; }, - [](const ProcBindingDetails &) { return true; }, - [](const UseDetails &x) { return IsProcedure(x.symbol()); }, - // TODO: FinalProcDetails? - [](const auto &) { return false; }, - }, - symbol.details()); -} - -bool IsProcedurePointer(const Symbol &symbol) { - return symbol.has() && IsPointer(symbol); -} - static const Symbol *FindPointerComponent( const Scope &scope, std::set &visited) { if (!scope.IsDerivedType()) { @@ -555,33 +444,6 @@ return nullptr; } -// When a construct association maps to a variable, and that variable -// is not an array with a vector-valued subscript, return the base -// Symbol of that variable, else nullptr. Descends into other construct -// associations when one associations maps to another. -static const Symbol *GetAssociatedVariable(const AssocEntityDetails &details) { - if (const MaybeExpr & expr{details.expr()}) { - if (evaluate::IsVariable(*expr) && !evaluate::HasVectorSubscript(*expr)) { - if (const Symbol * varSymbol{evaluate::GetFirstSymbol(*expr)}) { - return GetAssociationRoot(*varSymbol); - } - } - } - return nullptr; -} - -// Return the Symbol of the variable of a construct association, if it exists -// Return nullptr if the name is associated with an expression -const Symbol *GetAssociationRoot(const Symbol &symbol) { - const Symbol &ultimate{symbol.GetUltimate()}; - if (const auto *details{ultimate.detailsIf()}) { - // We have a construct association - return GetAssociatedVariable(*details); - } else { - return &ultimate; - } -} - bool IsExtensibleType(const DerivedTypeSpec *derived) { return derived && !IsIsoCType(derived) && !derived->typeSymbol().attrs().test(Attr::BIND_C) && @@ -627,35 +489,6 @@ return false; } -bool IsSaved(const Symbol &symbol) { - auto scopeKind{symbol.owner().kind()}; - if (scopeKind == Scope::Kind::Module || scopeKind == Scope::Kind::BlockData) { - return true; - } else if (scopeKind == Scope::Kind::DerivedType) { - return false; // this is a component - } else if (IsNamedConstant(symbol)) { - return false; - } else if (symbol.attrs().test(Attr::SAVE)) { - return true; - } else { - if (const auto *object{symbol.detailsIf()}) { - if (object->init()) { - return true; - } - } else if (IsProcedurePointer(symbol)) { - if (symbol.get().init()) { - return true; - } - } - if (const Symbol * block{FindCommonBlockContaining(symbol)}) { - if (block->attrs().test(Attr::SAVE)) { - return true; - } - } - return false; - } -} - // Check this symbol suitable as a type-bound procedure - C769 bool CanBeTypeBoundProc(const Symbol *symbol) { if (!symbol || IsDummy(*symbol) || IsProcedurePointer(*symbol)) { diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp --- a/flang/lib/Semantics/type.cpp +++ b/flang/lib/Semantics/type.cpp @@ -165,16 +165,6 @@ CHECK(pair.second); // name was not already present } -int DerivedTypeSpec::NumLengthParameters() const { - int result{0}; - for (const auto &pair : parameters_) { - if (pair.second.isLen()) { - ++result; - } - } - return result; -} - bool DerivedTypeSpec::MightBeParameterized() const { return !cooked_ || !parameters_.empty(); } @@ -487,37 +477,6 @@ return o; } -bool ArraySpec::IsExplicitShape() const { - return CheckAll([](const ShapeSpec &x) { return x.ubound().isExplicit(); }); -} -bool ArraySpec::IsAssumedShape() const { - return CheckAll([](const ShapeSpec &x) { return x.ubound().isDeferred(); }); -} -bool ArraySpec::IsDeferredShape() const { - return CheckAll([](const ShapeSpec &x) { - return x.lbound().isDeferred() && x.ubound().isDeferred(); - }); -} -bool ArraySpec::IsImpliedShape() const { - return !IsAssumedRank() && - CheckAll([](const ShapeSpec &x) { return x.ubound().isAssumed(); }); -} -bool ArraySpec::IsAssumedSize() const { - return !empty() && !IsAssumedRank() && back().ubound().isAssumed() && - std::all_of(begin(), end() - 1, - [](const ShapeSpec &x) { return x.ubound().isExplicit(); }); -} -bool ArraySpec::IsAssumedRank() const { - return Rank() == 1 && front().lbound().isAssumed(); -} -bool ArraySpec::IsConstantShape() const { - return CheckAll([](const ShapeSpec &x) { - const auto &lb{x.lbound().GetExplicit()}; - const auto &ub{x.ubound().GetExplicit()}; - return lb && ub && IsConstantExpr(*lb) && IsConstantExpr(*ub); - }); -} - llvm::raw_ostream &operator<<( llvm::raw_ostream &os, const ArraySpec &arraySpec) { char sep{'('}; @@ -634,35 +593,6 @@ return false; } -IntrinsicTypeSpec *DeclTypeSpec::AsIntrinsic() { - switch (category_) { - case Numeric: - return &std::get(typeSpec_); - case Logical: - return &std::get(typeSpec_); - case Character: - return &std::get(typeSpec_); - default: - return nullptr; - } -} -const IntrinsicTypeSpec *DeclTypeSpec::AsIntrinsic() const { - return const_cast(this)->AsIntrinsic(); -} - -DerivedTypeSpec *DeclTypeSpec::AsDerived() { - switch (category_) { - case TypeDerived: - case ClassDerived: - return &std::get(typeSpec_); - default: - return nullptr; - } -} -const DerivedTypeSpec *DeclTypeSpec::AsDerived() const { - return const_cast(this)->AsDerived(); -} - const NumericTypeSpec &DeclTypeSpec::numericTypeSpec() const { CHECK(category_ == Numeric); return std::get(typeSpec_);