[flang-commits] [PATCH] D136994: [flang] Require explicit interface for some dummy procedures

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: vdonaldson.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a project: All.
klausler requested review of this revision.

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.


https://reviews.llvm.org/D136994

Files:
  flang/include/flang/Evaluate/characteristics.h
  flang/lib/Evaluate/characteristics.cpp
  flang/lib/Semantics/check-call.cpp
  flang/test/Semantics/call24.f90
  flang/test/Semantics/call25.f90


Index: flang/test/Semantics/call25.f90
===================================================================
--- flang/test/Semantics/call25.f90
+++ flang/test/Semantics/call25.f90
@@ -43,7 +43,7 @@
   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
Index: flang/test/Semantics/call24.f90
===================================================================
--- flang/test/Semantics/call24.f90
+++ flang/test/Semantics/call24.f90
@@ -8,9 +8,19 @@
   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,10 @@
 
   !ERROR: References to the procedure 'foo' require an explicit interface
   call foo(an_array)
+
+  !ERROR: References to the procedure 'bar' require an explicit interface
+  call bar(sin)
+
+  !ERROR: References to the procedure 'baz' require an explicit interface
+  call baz(sin)
 end subroutine
Index: flang/lib/Semantics/check-call.cpp
===================================================================
--- flang/lib/Semantics/check-call.cpp
+++ flang/lib/Semantics/check-call.cpp
@@ -965,7 +965,7 @@
         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);
       }
     }
Index: flang/lib/Evaluate/characteristics.cpp
===================================================================
--- flang/lib/Evaluate/characteristics.cpp
+++ flang/lib/Evaluate/characteristics.cpp
@@ -404,6 +404,13 @@
   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 @@
 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;
   }
Index: flang/include/flang/Evaluate/characteristics.h
===================================================================
--- flang/include/flang/Evaluate/characteristics.h
+++ flang/include/flang/Evaluate/characteristics.h
@@ -213,6 +213,7 @@
   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;


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D136994.471670.patch
Type: text/x-patch
Size: 3811 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20221028/63a1ef47/attachment-0001.bin>