[flang] Allow restricted specific intrinsic functions as implicitly-interfaced procedure pointer targets

The predicate "CanBeCalledViaImplicitInterface()" was returning false for
restricted specific intrinsic functions (e.g., SIN) because their procedure
characteristics have the elemental attribute; this leads to a bogus semantic
error when one attempts to use them as proc-targets in procedure pointer
assignment statements when the left-hand side of the assignment is a procedure
pointer with an implicit interface.  However, these restricted specific intrinsic
functions have always been allowed as special cases for such usage -- it is
as if they are elemental when it is necessary for them to be so, but not
when it's a problem.

Differential Revision: https://reviews.llvm.org/D130386

1 files changed, 13 insertions, 12 deletions

diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index cfb5159..71b7387 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -67,8 +67,9 @@ private:
   bool Check(const evaluate::ProcedureDesignator &);
   bool Check(const evaluate::ProcedureRef &);
   // Target is a procedure
-  bool Check(
-      parser::CharBlock rhsName, bool isCall, const Procedure * = nullptr);
+  bool Check(parser::CharBlock rhsName, bool isCall,
+      const Procedure * = nullptr,
+      const evaluate::SpecificIntrinsic *specific = nullptr);
   bool LhsOkForUnlimitedPoly() const;
   template <typename... A> parser::Message *Say(A &&...);
 
@@ -255,11 +256,12 @@ bool PointerAssignmentChecker::Check(const evaluate::Designator<T> &d) {
 }
 
 // Common handling for procedure pointer right-hand sides
-bool PointerAssignmentChecker::Check(
-    parser::CharBlock rhsName, bool isCall, const Procedure *rhsProcedure) {
+bool PointerAssignmentChecker::Check(parser::CharBlock rhsName, bool isCall,
+    const Procedure *rhsProcedure,
+    const evaluate::SpecificIntrinsic *specific) {
   std::string whyNot;
   if (std::optional<MessageFixedText> msg{evaluate::CheckProcCompatibility(
-          isCall, procedure_, rhsProcedure, whyNot)}) {
+          isCall, procedure_, rhsProcedure, specific, whyNot)}) {
     Say(std::move(*msg), description_, rhsName, whyNot);
     return false;
   }
@@ -268,24 +270,23 @@ bool PointerAssignmentChecker::Check(
 
 bool PointerAssignmentChecker::Check(const evaluate::ProcedureDesignator &d) {
   if (auto chars{Procedure::Characterize(d, context_)}) {
-    return Check(d.GetName(), false, &*chars);
+    return Check(d.GetName(), false, &*chars, d.GetSpecificIntrinsic());
   } else {
     return Check(d.GetName(), false);
   }
 }
 
 bool PointerAssignmentChecker::Check(const evaluate::ProcedureRef &ref) {
-  const Procedure *procedure{nullptr};
-  auto chars{Procedure::Characterize(ref, context_)};
-  if (chars) {
-    procedure = &*chars;
+  if (auto chars{Procedure::Characterize(ref, context_)}) {
     if (chars->functionResult) {
       if (const auto *proc{chars->functionResult->IsProcedurePointer()}) {
-        procedure = proc;
+        return Check(ref.proc().GetName(), true, proc);
       }
     }
+    return Check(ref.proc().GetName(), true, &*chars);
+  } else {
+    return Check(ref.proc().GetName(), true, nullptr);
   }
-  return Check(ref.proc().GetName(), true, procedure);
 }
 
 // The target can be unlimited polymorphic if the pointer is, or if it is