[flang] Add one semantic check for implicit interface

[peixin]

Summary

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

[peixin]

Without this patch, the result is as follows:

$ cat sub.f90 
subroutine sub(f)
  integer, external :: f
  print *, f()
end
$ flang-new sub.f90 -c
$ cat main.f90 
program m
  call sub(func)
contains
  elemental integer function func()
    func = 1
  end function
end
$ flang-new main.f90 -c
$ cat test.f90 
program m
  call sub(func)
contains
  elemental integer function func()
    func = 1
  end function
end
subroutine sub(f)
  integer, external :: f
  print *, f()
end
$ flang-new test.f90 -c
./test.f90:2:3: warning: If the procedure's interface were explicit, this reference would be in error:
    call sub(func)
    ^^^^^^^^^^^^^^
./test.f90:2:12: because: Non-intrinsic ELEMENTAL procedure 'func' may not be passed as an actual argument
    call sub(func)
             ^^^^
./test.f90:4:30: Declaration of 'func'
    elemental integer function func()
                               ^^^^

[klausler]

flang/lib/Semantics/check-call.cpp

85

It would be more clear if you either (1) combined the two if() statement predicates into one, or (2) moved the declaration of argProcSymbol into the predicate of the inner if() statement.

[peixin]

Combine the two if statement predicates into one.

[peixin]

Fix the clang format using the new built clang-format. I used one old version causing the format issue previously.

[peixin]

ping

flang/lib/Semantics/check-call.cpp

 #include <string>
 
 using namespace Fortran::parser::literals;
 namespace characteristics = Fortran::evaluate::characteristics;
 
 namespace Fortran::semantics {
 
 static void CheckImplicitInterfaceArg(
-    evaluate::ActualArgument &arg, parser::ContextualMessages &messages) {
+    evaluate::ActualArgument &arg, parser::ContextualMessages &messages,
+    evaluate::FoldingContext &context) {
   auto restorer{
       messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
   if (auto kw{arg.keyword()}) {
     messages.Say(*kw,
         "Keyword '%s=' may not appear in a reference to a procedure with an implicit interface"_err_en_US,
         *kw);
   }
   if (auto type{arg.GetType()}) {
if (IsBOZLiteral(*expr)) {
       if (symbol.attrs().test(Attr::ASYNCHRONOUS)) {
         messages.Say(
             "ASYNCHRONOUS argument requires an explicit interface"_err_en_US);
       }
       if (symbol.attrs().test(Attr::VOLATILE)) {
         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());
+      }
     }
   }
 }
 
 // When scalar CHARACTER actual arguments are known to be short,
 // we extend them on the right with spaces and a warning.
 static void CheckCharacterActual(evaluate::Expr<evaluate::SomeType> &actual,
     const characteristics::TypeAndShape &dummyType,
void CheckArguments(const characteristics::Procedure &proc,
   bool explicitInterface{proc.HasExplicitInterface()};
   parser::ContextualMessages &messages{context.messages()};
   if (!explicitInterface || treatingExternalAsImplicit) {
     parser::Messages buffer;
     {
       auto restorer{messages.SetMessages(buffer)};
       for (auto &actual : actuals) {
         if (actual) {
-          CheckImplicitInterfaceArg(*actual, messages);
+          CheckImplicitInterfaceArg(*actual, messages, context);
         }
       }
     }
     if (!buffer.empty()) {
       if (auto *msgs{messages.messages()}) {
         msgs->Annex(std::move(buffer));
       }
       return; // don't pile on

flang/test/Semantics/call02.f90

subroutine s01(elem, subr)
   !ERROR: Non-intrinsic ELEMENTAL procedure 'elem' may not be passed as an actual argument
   call subr(elem) ! C1533
   !ERROR: Actual argument associated with procedure dummy argument 'dummy=' is a null pointer
   call subr(null())
   !ERROR: Actual argument associated with procedure dummy argument 'dummy=' is typeless
   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
     elemental real function elem02(x)
       real, value :: x
     end function
     subroutine callme(f)
       external f
subroutine callee(x)
     type(t), intent(in) :: x
   end subroutine
   subroutine test
     !ERROR: Coindexed object 'coarray' with POINTER ultimate component '%ptr' cannot be associated with dummy argument 'x='
     call callee(coarray[1]) ! C1537
   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)
   l = index .eq. 0  ! index is an object entity, not an intrinsic
   call s2(sin)
   !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure
   call s3(cos)
 contains