[flang] Require explicit interface for some dummy procedures

[klausler]

Summary

Some of the circumstances that require that a procedure have an
explicit interface at a point of call due to a characteristic of
a dummy argument apply to dummy procedures, too.

[tschuett]

flang/lib/Evaluate/characteristics.cpp

408

return !(attrs & Attrs{Attr::Optional, Attr::Pointer}).any(); ?

[klausler]

flang/lib/Evaluate/characteristics.cpp

408

Does that seem more clear to you?

[tschuett]

flang/lib/Evaluate/characteristics.cpp

408

On second thought, no. The comment has value.

flang/include/flang/Evaluate/characteristics.h

struct DummyProcedure {
   ENUM_CLASS(Attr, Pointer, Optional)
   using Attrs = common::EnumSet<Attr, Attr_enumSize>;
   DECLARE_CONSTRUCTORS_AND_ASSIGNMENTS(DummyProcedure)
   explicit DummyProcedure(Procedure &&);
   bool operator==(const DummyProcedure &) const;
   bool operator!=(const DummyProcedure &that) const { return !(*this == that); }
   bool IsCompatibleWith(
       const DummyProcedure &, std::string *whyNot = nullptr) const;
+  bool CanBePassedViaImplicitInterface() const;
   llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
 
   CopyableIndirection<Procedure> procedure;
   common::Intent intent{common::Intent::Default};
   Attrs attrs;
 };
 
 // 15.3.2.4

flang/lib/Evaluate/characteristics.cpp

if (!procedure.value().IsCompatibleWith(actual.procedure.value(), whyNot)) {
     if (whyNot) {
       *whyNot = "incompatible dummy procedure interfaces: "s + *whyNot;
     }
     return false;
   }
   return true;
 }
 
+bool DummyProcedure::CanBePassedViaImplicitInterface() const {
+  if ((attrs & Attrs{Attr::Optional, Attr::Pointer}).any()) {
+    return false; // 15.4.2.2(3)(a)
+  }
+  return true;
+}
+
 static std::string GetSeenProcs(
     const semantics::UnorderedSymbolSet &seenProcs) {
   // Sort the symbols so that they appear in the same order on all platforms
   auto ordered{semantics::OrderBySourcePosition(seenProcs)};
   std::string result;
   llvm::interleave(
       ordered,
       [&](const SymbolRef p) { result += '\'' + p->name().ToString() + '\''; },
return common::visit(
           },
       },
       u);
 }
 
 bool DummyArgument::CanBePassedViaImplicitInterface() const {
   if (const auto *object{std::get_if<DummyDataObject>(&u)}) {
     return object->CanBePassedViaImplicitInterface();
+  } else if (const auto *proc{std::get_if<DummyProcedure>(&u)}) {
+    return proc->CanBePassedViaImplicitInterface();
   } else {
     return true;
   }
 }
 
 bool DummyArgument::IsTypelessIntrinsicDummy() const {
   const auto *argObj{std::get_if<characteristics::DummyDataObject>(&u)};
   return argObj && argObj->type.type().IsTypelessIntrinsicArgument();

flang/lib/Semantics/check-call.cpp

if (!buffer.empty()) {
       return; // don't pile on
     }
   }
   if (explicitInterface) {
     auto buffer{
         CheckExplicitInterface(proc, actuals, context, scope, intrinsic)};
     if (treatingExternalAsImplicit && !buffer.empty()) {
       if (auto *msg{messages.Say(
-              "If the procedure's interface were explicit, this reference would be in error:"_warn_en_US)}) {
+              "If the procedure's interface were explicit, this reference would be in error"_warn_en_US)}) {
         buffer.AttachTo(*msg, parser::Severity::Because);
       }
     }
     if (auto *msgs{messages.messages()}) {
       msgs->Annex(std::move(buffer));
     }
   }
 }
 } // namespace Fortran::semantics

flang/test/Semantics/call24.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! 15.4.2.2. Test that errors are reported when an explicit interface
 ! is not provided for an external procedure that requires an explicit
 ! interface (the definition needs to be visible so that the compiler
 ! can detect the violation).
 
 subroutine foo(a_pointer)
   real, pointer :: a_pointer(:)
 end subroutine
 
+subroutine bar(a_pointer)
+  procedure(real), pointer :: a_pointer
+end subroutine
+
+subroutine baz(proc)
+  external :: proc
+  real, optional :: proc
+end subroutine
+
 subroutine test()
   real, pointer :: a_pointer(:)
   real, pointer :: an_array(:)
+  intrinsic :: sin
 
   ! This call would be allowed if the interface was explicit here,
   ! but its handling with an implicit interface is different (no
   ! descriptor involved, copy-in/copy-out...)
 
   !ERROR: References to the procedure 'foo' require an explicit interface
   call foo(a_pointer)
 
   ! This call would be error if the interface was explicit here.
 
   !ERROR: References to the procedure 'foo' require an explicit interface
   call foo(an_array)
+
+  !ERROR: References to the procedure 'bar' require an explicit interface
+  !WARNING: If the procedure's interface were explicit, this reference would be in error
+  !BECAUSE: Actual argument associated with procedure pointer dummy argument 'a_pointer=' must be a POINTER unless INTENT(IN)
+  call bar(sin)
+
+  !ERROR: References to the procedure 'baz' require an explicit interface
+  call baz(sin)
 end subroutine

flang/test/Semantics/call25.f90

program main
   !CHECK: error: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
   call subr1(notChar)
   call subr2(explicitLength)
   call subr2(assumedLength)
   !CHECK: error: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
   call subr2(notChar)
   call subr3(explicitLength)
   call subr3(assumedLength)
-  !CHECK: warning: If the procedure's interface were explicit, this reference would be in error:
+  !CHECK: warning: If the procedure's interface were explicit, this reference would be in error
   !CHECK: because: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type
   call subr3(notChar)
 end program