[flang-commits] [flang] 3de92ca - [flang] Add tests for procedure arguments with implicit interfaces

[Peter Steinfeld via flang-commits]

Author: Peter Steinfeld
Date: 2021-01-13T16:43:09-08:00
New Revision: 3de92ca78cd4e180920acc077452f87c44c7d935

URL: https://github.com/llvm/llvm-project/commit/3de92ca78cd4e180920acc077452f87c44c7d935
DIFF: https://github.com/llvm/llvm-project/commit/3de92ca78cd4e180920acc077452f87c44c7d935.diff

LOG: [flang] Add tests for procedure arguments with implicit interfaces

It's possible to declare an external procedure and then pass it as an
actual argument to a subprogram expecting a procedure argument.  I added
tests for this and added an error message to distinguish passing an
actual argument with an implicit interface from passing an argument with
a mismatched explicit interface.

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

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index c954dba58fbc..ffae3410a852 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -537,9 +537,20 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
           }
           if (interface.HasExplicitInterface()) {
             if (interface != argInterface) {
-              messages.Say(
-                  "Actual argument procedure has interface incompatible with %s"_err_en_US,
-                  dummyName);
+              // 15.5.2.9(1): Explicit interfaces must match
+              if (argInterface.HasExplicitInterface()) {
+                messages.Say(
+                    "Actual procedure argument has interface incompatible with %s"_err_en_US,
+                    dummyName);
+                return;
+              } else {
+                messages.Say(
+                    "Actual procedure argument has an implicit interface "
+                    "which is not known to be compatible with %s which has an "
+                    "explcit interface"_err_en_US,
+                    dummyName);
+                return;
+              }
             }
           } else { // 15.5.2.9(2,3)
             if (interface.IsSubroutine() && argInterface.IsFunction()) {

diff  --git a/flang/test/Semantics/call09.f90 b/flang/test/Semantics/call09.f90
index 8c21d376fd60..e7f22e32ed44 100644
--- a/flang/test/Semantics/call09.f90
+++ b/flang/test/Semantics/call09.f90
@@ -19,6 +19,9 @@ subroutine s01(p)
   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,28 +50,33 @@ subroutine test1 ! 15.5.2.9(5)
     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
-    !ERROR: Actual argument procedure has interface incompatible with dummy argument 'p='
+    !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p='
     call s01(intfunc)
     call s01(p) ! ok
     call s01(procptr()) ! ok
-    !ERROR: Actual argument procedure has interface incompatible with dummy argument 'p='
+    !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p='
     call s01(intprocptr())
     call s01(null()) ! ok
     call s01(null(p)) ! ok
-    !ERROR: Actual argument procedure has interface incompatible with dummy argument 'p='
+    !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p='
     call s01(null(ip))
     call s01(sin) ! ok
     !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure
     call s01(null(intPtr))
     !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure
     call s01(B"0101")
+    !ERROR: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p=' which has an explcit interface
+    call s01(extfunc)
     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
     call s02(realfunc)
     call s02(p) ! ok
-    !ERROR: Actual argument procedure has interface incompatible with dummy argument 'p='
+    !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p='
     call s02(ip)
     !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
     call s02(procptr())
@@ -78,6 +86,10 @@ subroutine test1 ! 15.5.2.9(5)
     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 procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p=' which has an explcit interface
+    call s02(extfunc)
+    !ERROR: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p=' which has an explcit interface
+    call s03(extfuncPtr)
   end subroutine
 
   subroutine callsub(s)