// 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. #include "tools.h" #include "scope.h" #include "semantics.h" #include "symbol.h" #include "type.h" #include "../common/Fortran.h" #include "../common/indirection.h" #include "../parser/message.h" #include "../parser/parse-tree.h" #include #include #include namespace Fortran::semantics { static const Symbol *FindCommonBlockInScope( const Scope &scope, const Symbol &object) { for (const auto &pair : scope.commonBlocks()) { const Symbol &block{*pair.second}; if (IsCommonBlockContaining(block, object)) { return █ } } return nullptr; } const Symbol *FindCommonBlockContaining(const Symbol &object) { for (const Scope *scope{&object.owner()}; scope->kind() != Scope::Kind::Global; scope = &scope->parent()) { if (const Symbol * block{FindCommonBlockInScope(*scope, object)}) { return block; } } return nullptr; } const Scope *FindProgramUnitContaining(const Scope &start) { const Scope *scope{&start}; while (scope != nullptr) { switch (scope->kind()) { case Scope::Kind::Module: case Scope::Kind::MainProgram: case Scope::Kind::Subprogram: return scope; case Scope::Kind::Global: case Scope::Kind::System: return nullptr; case Scope::Kind::DerivedType: case Scope::Kind::Block: case Scope::Kind::Forall: case Scope::Kind::ImpliedDos: scope = &scope->parent(); } } return nullptr; } const Scope *FindProgramUnitContaining(const Symbol &symbol) { return FindProgramUnitContaining(symbol.owner()); } const Scope *FindPureFunctionContaining(const Scope *scope) { scope = FindProgramUnitContaining(*scope); while (scope != nullptr) { if (IsPureFunction(*scope)) { return scope; } scope = FindProgramUnitContaining(scope->parent()); } return nullptr; } bool IsCommonBlockContaining(const Symbol &block, const Symbol &object) { const auto &objects{block.get().objects()}; auto found{std::find(objects.begin(), objects.end(), &object)}; return found != objects.end(); } bool IsUseAssociated(const Symbol &symbol, const Scope &scope) { const Scope *owner{FindProgramUnitContaining(symbol.GetUltimate().owner())}; return owner != nullptr && owner->kind() == Scope::Kind::Module && owner != FindProgramUnitContaining(scope); } bool DoesScopeContain( const Scope *maybeAncestor, const Scope &maybeDescendent) { if (maybeAncestor != nullptr) { const Scope *scope{&maybeDescendent}; while (scope->kind() != Scope::Kind::Global) { scope = &scope->parent(); if (scope == maybeAncestor) { return true; } } } return false; } bool DoesScopeContain(const Scope *maybeAncestor, const Symbol &symbol) { return DoesScopeContain(maybeAncestor, symbol.owner()); } bool IsHostAssociated(const Symbol &symbol, const Scope &scope) { return DoesScopeContain(FindProgramUnitContaining(symbol), scope); } 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 IsPointerDummy(const Symbol &symbol) { return IsPointer(symbol) && IsDummy(symbol); } // variable-name bool IsVariableName(const Symbol &symbol) { return symbol.has() && !IsParameter(symbol); } // proc-name bool IsProcName(const Symbol &symbol) { return symbol.has(); } bool IsFunction(const Symbol &symbol) { return std::visit( common::visitors{ [](const SubprogramDetails &x) { return x.isFunction(); }, [&](const SubprogramNameDetails &x) { return symbol.test(Symbol::Flag::Function); }, [](const ProcEntityDetails &x) { const auto &ifc{x.interface()}; return ifc.type() || (ifc.symbol() && IsFunction(*ifc.symbol())); }, [](const UseDetails &x) { return IsFunction(x.symbol()); }, [](const auto &) { return false; }, }, symbol.details()); } bool IsPureFunction(const Symbol &symbol) { return symbol.attrs().test(Attr::PURE) && IsFunction(symbol); } bool IsPureFunction(const Scope &scope) { if (const Symbol * symbol{scope.GetSymbol()}) { return IsPureFunction(*symbol); } else { return false; } } 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 UseDetails &x) { return IsProcedure(x.symbol()); }, [](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.kind() != Scope::Kind::DerivedType) { return nullptr; } if (!visited.insert(&scope).second) { return nullptr; } // If there's a top-level pointer component, return it for clearer error // messaging. for (const auto &pair : scope) { const Symbol &symbol{*pair.second}; if (IsPointer(symbol)) { return &symbol; } } for (const auto &pair : scope) { const Symbol &symbol{*pair.second}; if (const auto *details{symbol.detailsIf()}) { if (const DeclTypeSpec * type{details->type()}) { if (const DerivedTypeSpec * derived{type->AsDerived()}) { if (const Scope * nested{derived->scope()}) { if (const Symbol * pointer{FindPointerComponent(*nested, visited)}) { return pointer; } } } } } } return nullptr; } const Symbol *FindPointerComponent(const Scope &scope) { std::set visited; return FindPointerComponent(scope, visited); } const Symbol *FindPointerComponent(const DerivedTypeSpec &derived) { if (const Scope * scope{derived.scope()}) { return FindPointerComponent(*scope); } else { return nullptr; } } const Symbol *FindPointerComponent(const DeclTypeSpec &type) { if (const DerivedTypeSpec * derived{type.AsDerived()}) { return FindPointerComponent(*derived); } else { return nullptr; } } const Symbol *FindPointerComponent(const DeclTypeSpec *type) { return type ? FindPointerComponent(*type) : nullptr; } const Symbol *FindPointerComponent(const Symbol &symbol) { return IsPointer(symbol) ? &symbol : FindPointerComponent(symbol.GetType()); } // C1594 specifies several ways by which an object might be globally visible. const Symbol *FindExternallyVisibleObject( const Symbol &object, const Scope &scope) { // TODO: Storage association with any object for which this predicate holds, // once EQUIVALENCE is supported. if (IsUseAssociated(object, scope) || IsHostAssociated(object, scope) || (IsPureFunction(scope) && IsPointerDummy(object)) || (object.attrs().test(Attr::INTENT_IN) && IsDummy(object))) { return &object; } else if (const Symbol * block{FindCommonBlockContaining(object)}) { return block; } else { return nullptr; } } bool ExprHasTypeCategory( const SomeExpr &expr, const common::TypeCategory &type) { auto dynamicType{expr.GetType()}; return dynamicType.has_value() && dynamicType->category() == type; } bool ExprTypeKindIsDefault( const SomeExpr &expr, const SemanticsContext &context) { auto dynamicType{expr.GetType()}; return dynamicType.has_value() && dynamicType->category() != common::TypeCategory::Derived && dynamicType->kind() == context.defaultKinds().GetDefaultKind(dynamicType->category()); } const Symbol *FindFunctionResult(const Symbol &symbol) { if (const auto *procEntity{symbol.detailsIf()}) { const ProcInterface &interface{procEntity->interface()}; if (interface.symbol() != nullptr) { return FindFunctionResult(*interface.symbol()); } } else if (const auto *subp{symbol.detailsIf()}) { if (subp->isFunction()) { return &subp->result(); } } return nullptr; } bool IsDerivedTypeFromModule( const DerivedTypeSpec *derived, const char *module, const char *name) { if (!derived) { return false; } else { const auto &symbol{derived->typeSymbol()}; return symbol.name() == name && symbol.owner().IsModule() && symbol.owner().name() == module; } } bool IsTeamType(const DerivedTypeSpec *derived) { return IsDerivedTypeFromModule(derived, "iso_fortran_env", "team_type"); } const Symbol *HasCoarrayUltimateComponent( const DerivedTypeSpec &derivedTypeSpec) { const Symbol &symbol{derivedTypeSpec.typeSymbol()}; // TODO is it guaranteed that derived type symbol have a scope and is it the // right scope to look into? CHECK(symbol.scope()); for (const Symbol *componentSymbol : symbol.get().OrderComponents(*symbol.scope())) { CHECK(componentSymbol); const ObjectEntityDetails &objectDetails{ componentSymbol->get()}; if (objectDetails.IsCoarray()) { // Coarrays are ultimate components because they must be allocatable // according to C746. return componentSymbol; } if (!IsAllocatableOrPointer(*componentSymbol)) { if (const DeclTypeSpec * declTypeSpec{objectDetails.type()}) { if (const DerivedTypeSpec * componentDerivedTypeSpec{declTypeSpec->AsDerived()}) { // Avoid infinite loop, though this should not happen due to C744 CHECK(&symbol != &componentDerivedTypeSpec->typeSymbol()); if (const Symbol * subcomponent{ HasCoarrayUltimateComponent(*componentDerivedTypeSpec)}) { return subcomponent; } } } } } return nullptr; } const bool IsEventTypeOrLockType(const DerivedTypeSpec *derivedTypeSpec) { return IsDerivedTypeFromModule( derivedTypeSpec, "iso_fortran_env", "event_type") || IsDerivedTypeFromModule(derivedTypeSpec, "iso_fortran_env", "lock_type"); } const Symbol *HasEventOrLockPotentialComponent( const DerivedTypeSpec &derivedTypeSpec) { const Symbol &symbol{derivedTypeSpec.typeSymbol()}; // TODO is it guaranteed that derived type symbol have a scope and is it the // right scope to look into? CHECK(symbol.scope()); for (const Symbol *componentSymbol : symbol.get().OrderComponents(*symbol.scope())) { CHECK(componentSymbol); if (!IsPointer(*componentSymbol)) { if (const DeclTypeSpec * declTypeSpec{componentSymbol->GetType()}) { if (const DerivedTypeSpec * componentDerivedTypeSpec{declTypeSpec->AsDerived()}) { // Avoid infinite loop, that may happen if the component // is an allocatable of the same type as the derived type. // TODO: Is it legal to have longer type loops: i.e type B has a // component of type A that has an allocatable component of type B? if (&symbol != &componentDerivedTypeSpec->typeSymbol()) { if (IsEventTypeOrLockType(componentDerivedTypeSpec)) { return componentSymbol; } else if (const Symbol * subcomponent{HasEventOrLockPotentialComponent( *componentDerivedTypeSpec)}) { return subcomponent; } } } } } } return nullptr; } }