[PATCH] D94505: [flang] Fix bogus message passing external procedure as an actual argument

[Pete Steinfeld via Phabricator via llvm-commits]

PeteSteinfeld created this revision.
PeteSteinfeld added reviewers: klausler, tskeith.
PeteSteinfeld requested review of this revision.
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.

It's possible to declare an external procedure and then pass it as an actual
argument to a subprogram expecting a procedure argument.  But we were
erroneously emitting an error message in this case.  I fixed this by checking
to see if the actual argument had an explicit interface before comparing its
characteristics with those of the dummy argument as the condition for emitting
an error message.  I also added some tests that use external procedures as
arguments to subprograms expecting procedure arguments.


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D94505

Files:
  flang/lib/Semantics/check-call.cpp
  flang/test/Semantics/call09.f90


Index: flang/test/Semantics/call09.f90
===================================================================
--- flang/test/Semantics/call09.f90
+++ flang/test/Semantics/call09.f90
@@ -19,6 +19,9 @@
   subroutine s02(p)
     procedure(realfunc), pointer :: p
   end subroutine
+  subroutine s03(p)
+    procedure(realfunc) :: p
+  end subroutine
 
   subroutine selemental1(p)
     procedure(cos) :: p ! ok
@@ -47,6 +50,9 @@
     procedure(realfunc), pointer :: p
     procedure(intfunc), pointer :: ip
     integer, pointer :: intPtr
+    external :: extfunc
+    external :: extfuncPtr
+    pointer :: extfuncPtr
     p => realfunc
     ip => intfunc
     call s01(realfunc) ! ok
@@ -65,6 +71,7 @@
     call s01(null(intPtr))
     !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure
     call s01(B"0101")
+    call s01(extfunc) ! ok
     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
     call s02(realfunc)
     call s02(p) ! ok
@@ -78,6 +85,9 @@
     call s02(null(p))
     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
     call s02(sin)
+    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
+    call s02(extfunc) ! ok
+    call s03(extfuncPtr) ! ok
   end subroutine
 
   subroutine callsub(s)
Index: flang/lib/Semantics/check-call.cpp
===================================================================
--- flang/lib/Semantics/check-call.cpp
+++ flang/lib/Semantics/check-call.cpp
@@ -535,7 +535,8 @@
             // 15.5.2.9(1): if dummy is not pure, actual need not be.
             argInterface.attrs.reset(characteristics::Procedure::Attr::Pure);
           }
-          if (interface.HasExplicitInterface()) {
+          if (interface.HasExplicitInterface() &&
+              argInterface.HasExplicitInterface()) {
             if (interface != argInterface) {
               messages.Say(
                   "Actual argument procedure has interface incompatible with %s"_err_en_US,


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D94505.316114.patch
Type: text/x-patch
Size: 2133 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20210112/b4f1789d/attachment.bin>