[flang] Require explicit interface for some dummy procedures

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.

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

diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 0e05564..aebb210 100644 (file)
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -213,6 +213,7 @@ struct DummyProcedure {
   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;

diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index ee6b6ca..cf43bab 100644 (file)
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -404,6 +404,13 @@ bool DummyProcedure::IsCompatibleWith(
   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
@@ -766,6 +773,8 @@ common::Intent DummyArgument::GetIntent() const {
 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;
   }

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 832dd0d..418d66d 100644 (file)
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -964,7 +964,7 @@ void CheckArguments(const characteristics::Procedure &proc,
         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);
       }
     }

diff --git a/flang/test/Semantics/call24.f90 b/flang/test/Semantics/call24.f90
index 9013a3f..7d2ba9f 100644 (file)
--- a/flang/test/Semantics/call24.f90
+++ b/flang/test/Semantics/call24.f90
@@ -8,9 +8,19 @@ 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
@@ -23,4 +33,12 @@ subroutine test()
 
   !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

diff --git a/flang/test/Semantics/call25.f90 b/flang/test/Semantics/call25.f90
index 0f9219f..7ef6beb 100644 (file)
--- a/flang/test/Semantics/call25.f90
+++ b/flang/test/Semantics/call25.f90
@@ -43,7 +43,7 @@ program main
   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