From 20dd13e492b89855894502bdf265bafcc4a67b4c Mon Sep 17 00:00:00 2001 From: peter klausler Date: Thu, 11 Jul 2019 11:34:01 -0700 Subject: [PATCH] [flang] Better name resolution for intrinsics Original-commit: flang-compiler/f18@31fd9c82e9bd90b03bd37accd3d9f187ccbfa979 Reviewed-on: https://github.com/flang-compiler/f18/pull/561 --- flang/lib/evaluate/characteristics.cc | 18 ++++++---------- flang/lib/semantics/expression.cc | 8 +++---- flang/lib/semantics/resolve-names.cc | 37 +++++++++++++++++--------------- flang/lib/semantics/symbol.h | 11 +++++----- flang/test/semantics/procinterface01.f90 | 8 +++---- flang/test/semantics/symbol13.f90 | 2 +- 6 files changed, 39 insertions(+), 45 deletions(-) diff --git a/flang/lib/evaluate/characteristics.cc b/flang/lib/evaluate/characteristics.cc index 0f9e187..549aee6 100644 --- a/flang/lib/evaluate/characteristics.cc +++ b/flang/lib/evaluate/characteristics.cc @@ -371,6 +371,10 @@ std::optional Procedure::Characterize( }, [&](const semantics::ProcEntityDetails &proc) -> std::optional { + if (symbol.attrs().test(semantics::Attr::INTRINSIC)) { + return intrinsics.IsUnrestrictedSpecificIntrinsicFunction( + symbol.name().ToString()); + } const semantics::ProcInterface &interface{proc.interface()}; if (const semantics::Symbol * interfaceSymbol{interface.symbol()}) { auto characterized{Characterize(*interfaceSymbol, intrinsics)}; @@ -403,21 +407,11 @@ std::optional Procedure::Characterize( [&](const semantics::ProcBindingDetails &binding) { return Characterize(binding.symbol(), intrinsics); }, - [&](const semantics::MiscDetails &misc) -> std::optional { - if (misc.kind() == - semantics::MiscDetails::Kind::SpecificIntrinsic) { - return intrinsics.IsUnrestrictedSpecificIntrinsicFunction( - symbol.name().ToString()); - } else { - return std::nullopt; - } - }, [](const semantics::GenericDetails &) -> std::optional { return std::nullopt; }, - [](const semantics::GenericBindingDetails &) -> std::optional { - return std::nullopt; - }, + [](const semantics::GenericBindingDetails &) + -> std::optional { return std::nullopt; }, [](const auto &) -> std::optional { CRASH_NO_CASE; }, }, symbol.details()); diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index e8ee22a..2cc62aa 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -1449,17 +1449,15 @@ auto ExpressionAnalyzer::Procedure(const parser::ProcedureDesignator &pd, return std::nullopt; } const Symbol &symbol{n.symbol->GetUltimate()}; - if (!symbol.HasExplicitInterface() || - (symbol.has() && - symbol.get().kind() == - semantics::MiscDetails::Kind::SpecificIntrinsic)) { - // Might be an intrinsic. + if (symbol.attrs().test(semantics::Attr::INTRINSIC)) { if (std::optional specificCall{ context_.intrinsics().Probe(CallCharacteristics{n.source}, arguments, GetFoldingContext())}) { return CalleeAndArguments{ProcedureDesignator{std::move( specificCall->specificIntrinsic)}, std::move(specificCall->arguments)}; + } else { + return std::nullopt; } } if (symbol.HasExplicitInterface()) { diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc index 6e5ff7e..5757093 100644 --- a/flang/lib/semantics/resolve-names.cc +++ b/flang/lib/semantics/resolve-names.cc @@ -1697,6 +1697,7 @@ static bool NeedsType(const Symbol &symbol) { [](const AssocEntityDetails &) { return true; }, [&](const ProcEntityDetails &p) { return symbol.test(Symbol::Flag::Function) && + !symbol.attrs().test(Attr::INTRINSIC) && p.interface().type() == nullptr && p.interface().symbol() == nullptr; }, @@ -1708,8 +1709,10 @@ void ScopeHandler::ApplyImplicitRules(Symbol &symbol) { if (NeedsType(symbol)) { if (isImplicitNoneType()) { if (symbol.has() && + !symbol.attrs().test(Attr::EXTERNAL) && context().intrinsics().IsIntrinsic(symbol.name().ToString())) { // type will be determined in expression semantics + symbol.attrs().set(Attr::INTRINSIC); } else { Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US); } @@ -3716,13 +3719,9 @@ bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction( .has_value()) { // Unrestricted specific intrinsic function names (e.g., "cos") // are acceptable as procedure interfaces. - Scope *scope{&currScope()}; - while (scope->kind() == Scope::Kind::DerivedType) { - scope = &scope->parent(); - } - Symbol &symbol{MakeSymbol(*scope, name.source, Attrs{Attr::INTRINSIC})}; - symbol.set_details(MiscDetails{MiscDetails::Kind::SpecificIntrinsic}); - CHECK(symbol.HasExplicitInterface()); + Symbol &symbol{ + MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC})}; + symbol.set_details(ProcEntityDetails{}); Resolve(name, symbol); return true; } else { @@ -4751,20 +4750,26 @@ void ResolveNamesVisitor::HandleProcedureName( CHECK(flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine); auto *symbol{FindSymbol(name)}; if (symbol == nullptr) { - symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{}); + Attrs attrs; + if (context().intrinsics().IsIntrinsic(name.source.ToString())) { + attrs.set(Attr::INTRINSIC); + } + symbol = &MakeSymbol(context().globalScope(), name.source, attrs); Resolve(name, *symbol); if (symbol->has()) { SayWithDecl(name, *symbol, "Use of '%s' as a procedure conflicts with its declaration"_err_en_US); return; } - if (isImplicitNoneExternal() && !symbol->attrs().test(Attr::EXTERNAL)) { - Say(name, - "'%s' is an external procedure without the EXTERNAL" - " attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US); - return; + if (!symbol->attrs().test(Attr::INTRINSIC)) { + if (isImplicitNoneExternal() && !symbol->attrs().test(Attr::EXTERNAL)) { + Say(name, + "'%s' is an external procedure without the EXTERNAL" + " attribute in a scope with IMPLICIT NONE(EXTERNAL)"_err_en_US); + return; + } + MakeExternal(*symbol); } - MakeExternal(*symbol); if (!symbol->has()) { ConvertToProcEntity(*symbol); } @@ -4779,9 +4784,7 @@ void ResolveNamesVisitor::HandleProcedureName( if (!SetProcFlag(name, *symbol, flag)) { return; // reported error } - if (symbol->has() || symbol->has() || - symbol->has() || symbol->has() || - symbol->has() || + if (IsProcedure(*symbol) || symbol->has() || symbol->has()) { // these are all valid as procedure-designators } else if (symbol->test(Symbol::Flag::Implicit)) { diff --git a/flang/lib/semantics/symbol.h b/flang/lib/semantics/symbol.h index 447a891..7ba88ac 100644 --- a/flang/lib/semantics/symbol.h +++ b/flang/lib/semantics/symbol.h @@ -326,8 +326,8 @@ class FinalProcDetails {}; class MiscDetails { public: ENUM_CLASS(Kind, None, ConstructName, ScopeName, PassName, ComplexPartRe, - ComplexPartIm, KindParamInquiry, LenParamInquiry, SelectTypeAssociateName, - SpecificIntrinsic); + ComplexPartIm, KindParamInquiry, LenParamInquiry, + SelectTypeAssociateName); MiscDetails(Kind kind) : kind_{kind} {} Kind kind() const { return kind_; } @@ -540,13 +540,12 @@ public: common::visitors{ [](const SubprogramDetails &) { return true; }, [](const SubprogramNameDetails &) { return true; }, - [](const ProcEntityDetails &x) { return x.HasExplicitInterface(); }, + [&](const ProcEntityDetails &x) { + return attrs_.test(Attr::INTRINSIC) || x.HasExplicitInterface(); + }, [](const UseDetails &x) { return x.symbol().HasExplicitInterface(); }, - [](const MiscDetails &x) { - return x.kind() == MiscDetails::Kind::SpecificIntrinsic; - }, [](const auto &) { return false; }, }, details_); diff --git a/flang/test/semantics/procinterface01.f90 b/flang/test/semantics/procinterface01.f90 index de24b65..b9cff7c 100644 --- a/flang/test/semantics/procinterface01.f90 +++ b/flang/test/semantics/procinterface01.f90 @@ -66,13 +66,13 @@ module module1 !DEF: /module1/derived1/p5 NOPASS, POINTER ProcEntity COMPLEX(4) !DEF: /module1/nested4 PUBLIC Subprogram COMPLEX(4) procedure(complex), pointer, nopass :: p5 => nested4 + !DEF: /module1/sin INTRINSIC, PUBLIC ProcEntity !DEF: /module1/derived1/p6 NOPASS, POINTER ProcEntity !REF: /module1/nested1 - ! NOTE: sin is not dumped as a DEF here because specific - ! intrinsic functions are represented with MiscDetails - ! and those are omitted from dumping. procedure(sin), pointer, nopass :: p6 => nested1 + !REF: /module1/sin !DEF: /module1/derived1/p7 NOPASS, POINTER ProcEntity + !DEF: /module1/cos INTRINSIC, PUBLIC ProcEntity procedure(sin), pointer, nopass :: p7 => cos !REF: /module1/tan !DEF: /module1/derived1/p8 NOPASS, POINTER ProcEntity CHARACTER(1_4,1) @@ -118,7 +118,7 @@ contains !REF: /module1/nested4/x real, intent(in) :: x !DEF: /module1/nested4/nested4 ObjectEntity COMPLEX(4) - !DEF: /cmplx EXTERNAL (implicit) ProcEntity REAL(4) + !DEF: /cmplx INTRINSIC ProcEntity !REF: /module1/nested4/x nested4 = cmplx(x+4., 6.) end function nested4 diff --git a/flang/test/semantics/symbol13.f90 b/flang/test/semantics/symbol13.f90 index c6a136c..680119b 100644 --- a/flang/test/semantics/symbol13.f90 +++ b/flang/test/semantics/symbol13.f90 @@ -23,7 +23,7 @@ character*1 function f1(x1, x2) !REF: /f1/n !REF: /f1/x1 !REF: /f1/x2 - !DEF: /len EXTERNAL (implicit) ProcEntity INTEGER(4) + !DEF: /len INTRINSIC ProcEntity character*(n), intent(in) :: x1, x2*(len(x1)+1) !DEF: /f1/t DerivedType type :: t -- 2.7.4