From a5db74b614db7fbb47ea13f1cd1095cad6f8ef89 Mon Sep 17 00:00:00 2001 From: Tim Keith Date: Mon, 6 Jan 2020 15:56:32 -0800 Subject: [PATCH] [flang] Add IntrinsicProcTable::IsSpecificIntrinsicFunction This replaces IsUnrestrictedSpecificIntrinsicFunction and returns information that allows the caller to distinguish between restricted and unrestricted intrinsics. The new case in `resolve46.f90` used to get an internal error. Original-commit: flang-compiler/f18@4cb1ee10b90bbc5e3c4899ab136fad4d1e841195 Reviewed-on: https://github.com/flang-compiler/f18/pull/928 Tree-same-pre-rewrite: false --- flang/lib/evaluate/characteristics.cc | 2 +- flang/lib/evaluate/intrinsics.cc | 57 +++++++++++++++++------------------ flang/lib/evaluate/intrinsics.h | 18 +++++------ flang/lib/semantics/expression.cc | 11 ++++--- flang/lib/semantics/resolve-names.cc | 11 ++++--- flang/test/semantics/resolve46.f90 | 2 ++ 6 files changed, 52 insertions(+), 49 deletions(-) diff --git a/flang/lib/evaluate/characteristics.cc b/flang/lib/evaluate/characteristics.cc index 8a05344..cd464f4 100644 --- a/flang/lib/evaluate/characteristics.cc +++ b/flang/lib/evaluate/characteristics.cc @@ -636,7 +636,7 @@ std::optional Procedure::Characterize( [&](const semantics::ProcEntityDetails &proc) -> std::optional { if (symbol.attrs().test(semantics::Attr::INTRINSIC)) { - return intrinsics.IsUnrestrictedSpecificIntrinsicFunction( + return intrinsics.IsSpecificIntrinsicFunction( symbol.name().ToString()); } const semantics::ProcInterface &interface{proc.interface()}; diff --git a/flang/lib/evaluate/intrinsics.cc b/flang/lib/evaluate/intrinsics.cc index 483bfa4..e57bfcd 100644 --- a/flang/lib/evaluate/intrinsics.cc +++ b/flang/lib/evaluate/intrinsics.cc @@ -1508,8 +1508,8 @@ public: std::optional Probe(const CallCharacteristics &, ActualArguments &, FoldingContext &, const IntrinsicProcTable &) const; - std::optional - IsUnrestrictedSpecificIntrinsicFunction(const std::string &) const; + std::optional IsSpecificIntrinsicFunction( + const std::string &) const; std::ostream &Dump(std::ostream &) const; @@ -1927,35 +1927,33 @@ std::optional IntrinsicProcTable::Implementation::Probe( return std::nullopt; } -std::optional -IntrinsicProcTable::Implementation::IsUnrestrictedSpecificIntrinsicFunction( +std::optional +IntrinsicProcTable::Implementation::IsSpecificIntrinsicFunction( const std::string &name) const { auto specificRange{specificFuncs_.equal_range(name)}; for (auto iter{specificRange.first}; iter != specificRange.second; ++iter) { const SpecificIntrinsicInterface &specific{*iter->second}; - if (!specific.isRestrictedSpecific) { - std::string genericName{name}; - if (specific.generic) { - genericName = std::string(specific.generic); - } - characteristics::FunctionResult fResult{GetSpecificType(specific.result)}; - characteristics::DummyArguments args; - int dummies{specific.CountArguments()}; - for (int j{0}; j < dummies; ++j) { - characteristics::DummyDataObject dummy{ - GetSpecificType(specific.dummy[j].typePattern)}; - dummy.intent = common::Intent::In; - args.emplace_back( - std::string{specific.dummy[j].keyword}, std::move(dummy)); - } - characteristics::Procedure::Attrs attrs; - attrs.set(characteristics::Procedure::Attr::Pure) - .set(characteristics::Procedure::Attr::Elemental); - characteristics::Procedure chars{ - std::move(fResult), std::move(args), attrs}; - return UnrestrictedSpecificIntrinsicFunctionInterface{ - std::move(chars), genericName}; + std::string genericName{name}; + if (specific.generic) { + genericName = std::string(specific.generic); + } + characteristics::FunctionResult fResult{GetSpecificType(specific.result)}; + characteristics::DummyArguments args; + int dummies{specific.CountArguments()}; + for (int j{0}; j < dummies; ++j) { + characteristics::DummyDataObject dummy{ + GetSpecificType(specific.dummy[j].typePattern)}; + dummy.intent = common::Intent::In; + args.emplace_back( + std::string{specific.dummy[j].keyword}, std::move(dummy)); } + characteristics::Procedure::Attrs attrs; + attrs.set(characteristics::Procedure::Attr::Pure) + .set(characteristics::Procedure::Attr::Elemental); + characteristics::Procedure chars{ + std::move(fResult), std::move(args), attrs}; + return SpecificIntrinsicFunctionInterface{ + std::move(chars), genericName, specific.isRestrictedSpecific}; } return std::nullopt; } @@ -1991,10 +1989,9 @@ std::optional IntrinsicProcTable::Probe( return DEREF(impl_).Probe(call, arguments, context, *this); } -std::optional -IntrinsicProcTable::IsUnrestrictedSpecificIntrinsicFunction( - const std::string &name) const { - return DEREF(impl_).IsUnrestrictedSpecificIntrinsicFunction(name); +std::optional +IntrinsicProcTable::IsSpecificIntrinsicFunction(const std::string &name) const { + return DEREF(impl_).IsSpecificIntrinsicFunction(name); } std::ostream &TypePattern::Dump(std::ostream &o) const { diff --git a/flang/lib/evaluate/intrinsics.h b/flang/lib/evaluate/intrinsics.h index e9463c8..036a401 100644 --- a/flang/lib/evaluate/intrinsics.h +++ b/flang/lib/evaluate/intrinsics.h @@ -41,12 +41,13 @@ struct SpecificCall { ActualArguments arguments; }; -struct UnrestrictedSpecificIntrinsicFunctionInterface - : public characteristics::Procedure { - UnrestrictedSpecificIntrinsicFunctionInterface( - characteristics::Procedure &&p, std::string n) - : characteristics::Procedure{std::move(p)}, genericName{n} {} +struct SpecificIntrinsicFunctionInterface : public characteristics::Procedure { + SpecificIntrinsicFunctionInterface( + characteristics::Procedure &&p, std::string n, bool isRestrictedSpecific) + : characteristics::Procedure{std::move(p)}, genericName{n}, + isRestrictedSpecific{isRestrictedSpecific} {} std::string genericName; + bool isRestrictedSpecific; // N.B. If there are multiple arguments, they all have the same type. // All argument and result types are intrinsic types with default kinds. }; @@ -71,10 +72,9 @@ public: std::optional Probe( const CallCharacteristics &, ActualArguments &, FoldingContext &) const; - // Probe the intrinsics with the name of a potential unrestricted specific - // intrinsic. - std::optional - IsUnrestrictedSpecificIntrinsicFunction(const std::string &) const; + // Probe the intrinsics with the name of a potential specific intrinsic. + std::optional IsSpecificIntrinsicFunction( + const std::string &) const; std::ostream &Dump(std::ostream &) const; diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index 373f0f3..4b89518 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -210,11 +210,12 @@ MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) { } else { CHECK(std::holds_alternative(ref.u)); if (symbol.attrs().test(semantics::Attr::INTRINSIC)) { - if (auto interface{ - context_.intrinsics().IsUnrestrictedSpecificIntrinsicFunction( - symbol.name().ToString())}) { - return Expr{ProcedureDesignator{SpecificIntrinsic{ - symbol.name().ToString(), std::move(*interface)}}}; + if (auto interface{context_.intrinsics().IsSpecificIntrinsicFunction( + symbol.name().ToString())}) { + SpecificIntrinsic intrinsic{ + symbol.name().ToString(), std::move(*interface)}; + intrinsic.isRestrictedSpecific = interface->isRestrictedSpecific; + return Expr{ProcedureDesignator{std::move(intrinsic)}}; } } else { return Expr{ProcedureDesignator{symbol}}; diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc index a1bf22e..9277f91 100644 --- a/flang/lib/semantics/resolve-names.cc +++ b/flang/lib/semantics/resolve-names.cc @@ -4152,12 +4152,15 @@ void DeclarationVisitor::CheckCommonBlockDerivedType( bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction( const parser::Name &name) { - if (context().intrinsics().IsUnrestrictedSpecificIntrinsicFunction( - name.source.ToString())) { + if (auto interface{context().intrinsics().IsSpecificIntrinsicFunction( + name.source.ToString())}) { // Unrestricted specific intrinsic function names (e.g., "cos") // are acceptable as procedure interfaces. - Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, - Attrs{Attr::INTRINSIC, Attr::ELEMENTAL})}; + Symbol &symbol{ + MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC})}; + if (interface->IsElemental()) { + symbol.attrs().set(Attr::ELEMENTAL); + } symbol.set_details(ProcEntityDetails{}); Resolve(name, symbol); return true; diff --git a/flang/test/semantics/resolve46.f90 b/flang/test/semantics/resolve46.f90 index 68e8b1c..0b36f81 100644 --- a/flang/test/semantics/resolve46.f90 +++ b/flang/test/semantics/resolve46.f90 @@ -3,6 +3,7 @@ program main intrinsic :: alog10 ! a specific intrinsic name, not generic intrinsic :: null ! a weird special case intrinsic :: bessel_j0 ! generic intrinsic, not specific + intrinsic :: amin0 !ERROR: 'haltandcatchfire' is not a known intrinsic procedure intrinsic :: haltandcatchfire procedure(sin), pointer :: p @@ -11,6 +12,7 @@ program main p => cos ! ditto, but also generic p => tan ! a generic & an unrestricted specific, not already declared !TODO ERROR: a restricted specific, to be caught in ass't semantics + p => amin0 p => amin1 !TODO ERROR: a generic, to be caught in ass't semantics p => bessel_j0 -- 2.7.4