flang] Upgrade warning to error in case of PURE procedure

[klausler]

Summary

[A procedure actual argument to a PURE procedure should be required
to have an explicit interface. Implicit-interface actual arguments
to non-PURE procedures remain a warning.

[PeteSteinfeld]

Looks great!

flang/lib/Semantics/check-call.cpp

if (actualRank == dummy.type.Rank() && !actualIsContiguous) {
             "Actual argument associated with coarray %s (not assumed shape or rank) must be simply contiguous"_err_en_US,
             dummyName);
       }
     }
   }
 }
 
 static void CheckProcedureArg(evaluate::ActualArgument &arg,
-    const characteristics::DummyProcedure &proc, const std::string &dummyName,
+    const characteristics::Procedure &proc,
+    const characteristics::DummyProcedure &dummy, const std::string &dummyName,
     evaluate::FoldingContext &context) {
   parser::ContextualMessages &messages{context.messages()};
-  const characteristics::Procedure &interface{proc.procedure.value()};
+  const characteristics::Procedure &interface { dummy.procedure.value() };
   if (const auto *expr{arg.UnwrapExpr()}) {
     bool dummyIsPointer{
-        proc.attrs.test(characteristics::DummyProcedure::Attr::Pointer)};
+        dummy.attrs.test(characteristics::DummyProcedure::Attr::Pointer)};
     const auto *argProcDesignator{
         std::get_if<evaluate::ProcedureDesignator>(&expr->u)};
     const auto *argProcSymbol{
         argProcDesignator ? argProcDesignator->GetSymbol() : nullptr};
     if (auto argChars{characteristics::DummyArgument::FromActual(
             "actual argument", *expr, context)}) {
       if (!argChars->IsTypelessIntrinsicDummy()) {
         if (auto *argProc{
if (auto argChars{characteristics::DummyArgument::FromActual(
           if (interface.HasExplicitInterface()) {
             if (interface != argInterface) {
               // 15.5.2.9(1): Explicit interfaces must match
               if (argInterface.HasExplicitInterface()) {
                 messages.Say(
                     "Actual procedure argument has interface incompatible with %s"_err_en_US,
                     dummyName);
                 return;
+              } else if (proc.IsPure()) {
+                messages.Say(
+                    "Actual procedure argument for %s of a PURE procedure must have an explicit interface"_err_en_US,
+                    dummyName);
               } else {
                 messages.Say(
                     "Actual procedure argument has an implicit interface "
                     "which is not known to be compatible with %s which has an "
                     "explicit interface"_en_US,
                     dummyName);
               }
             }
if (auto argChars{characteristics::DummyArgument::FromActual(
         }
       } else {
         messages.Say(
             "Actual argument associated with procedure %s is typeless"_err_en_US,
             dummyName);
       }
     }
     if (interface.HasExplicitInterface() && dummyIsPointer &&
-        proc.intent != common::Intent::In) {
+        dummy.intent != common::Intent::In) {
       const Symbol *last{GetLastSymbol(*expr)};
       if (!(last && IsProcedurePointer(*last))) {
         // 15.5.2.9(5) -- dummy procedure POINTER
         // Interface compatibility has already been checked above by comparison.
         messages.Say(
             "Actual argument associated with procedure pointer %s must be a POINTER unless INTENT(IN)"_err_en_US,
             dummyName);
       }
std::visit(
                 if (!(details->IsAssumedShape() || details->IsAssumedRank())) {
                   messages.Say( // C711
                       "Assumed-type '%s' must be either assumed shape or assumed rank to be associated with assumed-type %s"_err_en_US,
                       assumed.name(), dummyName);
                 }
               }
             }
           },
-          [&](const characteristics::DummyProcedure &proc) {
-            CheckProcedureArg(arg, proc, dummyName, context);
+          [&](const characteristics::DummyProcedure &dummy) {
+            CheckProcedureArg(arg, proc, dummy, dummyName, context);
           },
           [&](const characteristics::AlternateReturn &) {
             // All semantic checking is done elsewhere
           },
       },
       dummy.u);
 }
 

flang/test/Semantics/call12.f90

module m
   type(t), target :: x
   type :: hasPtr
     real, pointer :: p
   end type
   type :: hasCoarray
     real, allocatable :: co[:]
   end type
  contains
+  integer pure function purefunc(x)
+    integer, intent(in) :: x
+    purefunc = x
+  end function
+  integer pure function f00(p0)
+    procedure(purefunc) :: p0
+    f00 = p0(1)
+  end function
   pure function test(ptr, in, hpd)
     use used
     type(t), pointer :: ptr, ptr2
     type(t), target, intent(in) :: in
     type(t), target :: y, z
     type(hasPtr) :: hp
     type(hasPtr), intent(in) :: hpd
     type(hasPtr), allocatable :: alloc
     type(hasCoarray), pointer :: hcp
     integer :: n
     common /block/ y
+    external :: extfunc
     !ERROR: Pure subprogram 'test' may not define 'x' because it is host-associated
     x%a = 0.
     !ERROR: Pure subprogram 'test' may not define 'y' because it is in a COMMON block
     y%a = 0. ! C1594(1)
     !ERROR: Pure subprogram 'test' may not define 'useassociated' because it is USE-associated
     useassociated = 0.  ! C1594(1)
     !ERROR: Pure subprogram 'test' may not define 'ptr' because it is a POINTER dummy argument of a pure function
     ptr%a = 0. ! C1594(1)
pure function test(ptr, in, hpd)
     !ERROR: Externally visible object 'ptr' may not be associated with pointer component 'p' in a pure procedure
     n = size([hasPtr(ptr%a)]) ! C1594(4)
     !ERROR: Externally visible object 'in' may not be associated with pointer component 'p' in a pure procedure
     n = size([hasPtr(in%a)]) ! C1594(4)
     !ERROR: A pure subprogram may not copy the value of 'hpd' because it is an INTENT(IN) dummy argument and has the POINTER component '%p'
     hp = hpd ! C1594(5)
     !ERROR: A pure subprogram may not copy the value of 'hpd' because it is an INTENT(IN) dummy argument and has the POINTER component '%p'
     allocate(alloc, source=hpd)
+    !ERROR: Actual procedure argument for dummy argument 'p0=' of a PURE procedure must have an explicit interface
+    n = f00(extfunc)
    contains
     pure subroutine internal
       type(hasPtr) :: localhp
       !ERROR: Pure subprogram 'internal' may not define 'z' because it is host-associated
       z%a = 0.
       !ERROR: Externally visible object 'z' may not be associated with pointer component 'p' in a pure procedure
       localhp = hasPtr(z%a)
     end subroutine
   end function
 end module