[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

diff --git a/flang/lib/evaluate/characteristics.cc b/flang/lib/evaluate/characteristics.cc
index 8a05344..cd464f4 100644 (file)
--- a/flang/lib/evaluate/characteristics.cc
+++ b/flang/lib/evaluate/characteristics.cc
@@ -636,7 +636,7 @@ std::optional<Procedure> Procedure::Characterize(
           [&](const semantics::ProcEntityDetails &proc)
               -> std::optional<Procedure> {
             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 (file)
--- a/flang/lib/evaluate/intrinsics.cc
+++ b/flang/lib/evaluate/intrinsics.cc
@@ -1508,8 +1508,8 @@ public:
   std::optional<SpecificCall> Probe(const CallCharacteristics &,
       ActualArguments &, FoldingContext &, const IntrinsicProcTable &) const;
 
-  std::optional<UnrestrictedSpecificIntrinsicFunctionInterface>
-  IsUnrestrictedSpecificIntrinsicFunction(const std::string &) const;
+  std::optional<SpecificIntrinsicFunctionInterface> IsSpecificIntrinsicFunction(
+      const std::string &) const;
 
   std::ostream &Dump(std::ostream &) const;
 
@@ -1927,35 +1927,33 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
   return std::nullopt;
 }
 
-std::optional<UnrestrictedSpecificIntrinsicFunctionInterface>
-IntrinsicProcTable::Implementation::IsUnrestrictedSpecificIntrinsicFunction(
+std::optional<SpecificIntrinsicFunctionInterface>
+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<SpecificCall> IntrinsicProcTable::Probe(
   return DEREF(impl_).Probe(call, arguments, context, *this);
 }
 
-std::optional<UnrestrictedSpecificIntrinsicFunctionInterface>
-IntrinsicProcTable::IsUnrestrictedSpecificIntrinsicFunction(
-    const std::string &name) const {
-  return DEREF(impl_).IsUnrestrictedSpecificIntrinsicFunction(name);
+std::optional<SpecificIntrinsicFunctionInterface>
+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 (file)
--- 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<SpecificCall> Probe(
       const CallCharacteristics &, ActualArguments &, FoldingContext &) const;
 
-  // Probe the intrinsics with the name of a potential unrestricted specific
-  // intrinsic.
-  std::optional<UnrestrictedSpecificIntrinsicFunctionInterface>
-  IsUnrestrictedSpecificIntrinsicFunction(const std::string &) const;
+  // Probe the intrinsics with the name of a potential specific intrinsic.
+  std::optional<SpecificIntrinsicFunctionInterface> 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 (file)
--- 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<SymbolRef>(ref.u));
       if (symbol.attrs().test(semantics::Attr::INTRINSIC)) {
-        if (auto interface{
-                context_.intrinsics().IsUnrestrictedSpecificIntrinsicFunction(
-                    symbol.name().ToString())}) {
-          return Expr<SomeType>{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<SomeType>{ProcedureDesignator{std::move(intrinsic)}};
         }
       } else {
         return Expr<SomeType>{ProcedureDesignator{symbol}};

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index a1bf22e..9277f91 100644 (file)
--- 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 (file)
--- 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