[flang] Add one semantic check for implicit interface

As Fortran 2018 C1533, a nonintrinsic elemental procedure shall not be
used as an actual argument. The semantic check for implicit iterface is
missed.

Reviewed By: klausler

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

flang/lib/Semantics/check-call.cpp

@@ -24,8 +24,8 @@ namespace characteristics = Fortran::evaluate::characteristics;
 
 namespace Fortran::semantics {
 
-static void CheckImplicitInterfaceArg(
-    evaluate::ActualArgument &arg, parser::ContextualMessages &messages) {
+static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
+    parser::ContextualMessages &messages, evaluate::FoldingContext &context) {
   auto restorer{
       messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
   if (auto kw{arg.keyword()}) {
@@ -73,6 +73,18 @@ static void CheckImplicitInterfaceArg(
         messages.Say(
             "VOLATILE argument requires an explicit interface"_err_en_US);
       }
+    } else if (auto argChars{characteristics::DummyArgument::FromActual(
+                   "actual argument", *expr, context)}) {
+      const auto *argProcDesignator{
+          std::get_if<evaluate::ProcedureDesignator>(&expr->u)};
+      const auto *argProcSymbol{
+          argProcDesignator ? argProcDesignator->GetSymbol() : nullptr};
+      if (argProcSymbol && !argChars->IsTypelessIntrinsicDummy() &&
+          argProcDesignator && argProcDesignator->IsElemental()) { // C1533
+        evaluate::SayWithDeclaration(messages, *argProcSymbol,
+            "Non-intrinsic ELEMENTAL procedure '%s' may not be passed as an actual argument"_err_en_US,
+            argProcSymbol->name());
+      }
     }
   }
 }
@@ -877,7 +889,7 @@ void CheckArguments(const characteristics::Procedure &proc,
       auto restorer{messages.SetMessages(buffer)};
       for (auto &actual : actuals) {
         if (actual) {
-          CheckImplicitInterfaceArg(*actual, messages);
+          CheckImplicitInterfaceArg(*actual, messages, context);
         }
       }
     }

flang/test/Semantics/call02.f90

@@ -26,6 +26,15 @@ subroutine s01(elem, subr)
   call subr(B"1010")
 end subroutine
 
+subroutine s02
+  !ERROR: Non-intrinsic ELEMENTAL procedure 'elem' may not be passed as an actual argument
+  call sub(elem)
+ contains
+  elemental integer function elem()
+    elem = 1
+  end function
+end
+
 module m01
   procedure(sin) :: elem01
   interface
@@ -73,6 +82,18 @@ module m02
   end subroutine
 end module
 
+module m03
+ contains
+  subroutine test
+    !ERROR: Non-intrinsic ELEMENTAL procedure 'elem' may not be passed as an actual argument
+    call sub(elem)
+   contains
+    elemental integer function elem()
+      elem = 1
+    end function
+  end
+end
+
 program p03
   logical :: l
   call s1(index)