[flang] Catch procedure pointer interface error

[klausler]

Summary

A procedure pointer is allowed to name a specific intrinsic function
from F'2018 table 16.2 as its interface, but not other intrinsic
procedures. Catch this error, and thereby also fix a crash resulting
from a failure later in compilation from failed characteristics;
while here, also catch the similar error with initializers.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/lib/Evaluate/characteristics.cpp

 static std::optional<DummyArgument> CharacterizeDummyArgument(
     const semantics::Symbol &symbol, FoldingContext &context,
     semantics::UnorderedSymbolSet &seenProcs);
 
 static std::optional<Procedure> CharacterizeProcedure(
     const semantics::Symbol &original, FoldingContext &context,
     semantics::UnorderedSymbolSet &seenProcs) {
   Procedure result;
-  const auto &symbol{original.GetUltimate()};
+  const auto &symbol{ResolveAssociations(original)};
   if (seenProcs.find(symbol) != seenProcs.end()) {
     std::string procsList{GetSeenProcs(seenProcs)};
     context.messages().Say(symbol.name(),
         "Procedure '%s' is recursively defined.  Procedures in the cycle:"
         " %s"_err_en_US,
         symbol.name(), procsList);
     return std::nullopt;
   }
return std::visit(
                 return std::nullopt;
               }
             }
             return result;
           },
           [&](const semantics::ProcEntityDetails &proc)
               -> std::optional<Procedure> {
             if (symbol.attrs().test(semantics::Attr::INTRINSIC)) {
+              // Fails when the intrinsic is not a specific intrinsic function
+              // from F'2018 table 16.2.  In order to handle forward references,
+              // attempts to use impermissible intrinsic procedures as the
+              // interfaces of procedure pointers are caught and flagged in
+              // declaration checking in Semantics.
               return context.intrinsics().IsSpecificIntrinsicFunction(
                   symbol.name().ToString());
             }
             const semantics::ProcInterface &interface{proc.interface()};
             if (const semantics::Symbol * interfaceSymbol{interface.symbol()}) {
               return CharacterizeProcedure(
                   *interfaceSymbol, context, seenProcs);
             } else {
std::optional<Procedure> Procedure::Characterize(
   semantics::UnorderedSymbolSet seenProcs;
   return CharacterizeProcedure(original, context, seenProcs);
 }
 
 std::optional<Procedure> Procedure::Characterize(
     const ProcedureDesignator &proc, FoldingContext &context) {
   if (const auto *symbol{proc.GetSymbol()}) {
     if (auto result{characteristics::Procedure::Characterize(
-            symbol->GetUltimate(), context)}) {
+            ResolveAssociations(*symbol), context)}) {
       return result;
     }
   } else if (const auto *intrinsic{proc.GetSpecificIntrinsic()}) {
     return intrinsic->characteristics.value();
   }
   return std::nullopt;
 }
 

flang/lib/Semantics/check-declarations.cpp

if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
         }
       }
     } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
       if (proc->init() && *proc->init()) {
         // C1519 - must be nonelemental external or module procedure,
         // or an unrestricted specific intrinsic function.
         const Symbol &ultimate{(*proc->init())->GetUltimate()};
         if (ultimate.attrs().test(Attr::INTRINSIC)) {
+          if (!context_.intrinsics().IsSpecificIntrinsicFunction(
+                  ultimate.name().ToString())) { // C1030
+            context_.Say(
+                "Intrinsic procedure '%s' is not a specific intrinsic permitted for use as the initializer for procedure pointer '%s'"_err_en_US,
+                ultimate.name(), symbol.name());
+          }
         } else if (!ultimate.attrs().test(Attr::EXTERNAL) &&
             ultimate.owner().kind() != Scope::Kind::Module) {
           context_.Say("Procedure pointer '%s' initializer '%s' is neither "
                        "an external nor a module procedure"_err_en_US,
               symbol.name(), ultimate.name());
         } else if (ultimate.attrs().test(Attr::ELEMENTAL)) {
           context_.Say("Procedure pointer '%s' cannot be initialized with the "
                        "elemental procedure '%s"_err_en_US,
if (!symbol.attrs().test(Attr::POINTER)) { // C756
           "Procedure component '%s' must have POINTER attribute"_err_en_US,
           name);
     }
     CheckPassArg(symbol, details.interface().symbol(), details);
   }
   if (symbol.attrs().test(Attr::POINTER)) {
     CheckPointerInitialization(symbol);
     if (const Symbol * interface{details.interface().symbol()}) {
-      if (interface->attrs().test(Attr::ELEMENTAL) &&
-          !interface->attrs().test(Attr::INTRINSIC)) {
+      if (interface->attrs().test(Attr::INTRINSIC)) {
+        if (!context_.intrinsics().IsSpecificIntrinsicFunction(
+                interface->name().ToString())) { // C1515
+          messages_.Say(
+              "Intrinsic procedure '%s' is not a specific intrinsic permitted for use as the definition of the interface to procedure pointer '%s'"_err_en_US,
+              interface->name(), symbol.name());
+        }
+      } else if (interface->attrs().test(Attr::ELEMENTAL)) {
         messages_.Say("Procedure pointer '%s' may not be ELEMENTAL"_err_en_US,
             symbol.name()); // C1517
       }
     }
   } else if (symbol.attrs().test(Attr::SAVE)) {
     messages_.Say(
         "Procedure '%s' with SAVE attribute must also have POINTER attribute"_err_en_US,
         symbol.name());