[flang-commits] [flang] b4c8652 - [flang] Downgrade inappropriate error message to a warning

[peter klausler via flang-commits]

Author: peter klausler
Date: 2021-08-31T11:28:42-07:00
New Revision: b4c86525fdc33c9220a0234cb022d408749fe61c

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

LOG: [flang] Downgrade inappropriate error message to a warning

It may not be great practice to pass a procedure (or procedure pointer)
with an implicit interface as an actual argument to correspond with
a dummy procedure (pointer), but it's not an error.  Change to a
warning, and modify tests accordingly.

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

Added: 
    flang/test/Semantics/call21.f90

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 ee0a4bfc59168..d47051522b4b6 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -553,9 +553,8 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
                 messages.Say(
                     "Actual procedure argument has an implicit interface "
                     "which is not known to be compatible with %s which has an "
-                    "explicit interface"_err_en_US,
+                    "explicit interface"_en_US,
                     dummyName);
-                return;
               }
             }
           } else { // 15.5.2.9(2,3)

diff  --git a/flang/test/Semantics/call09.f90 b/flang/test/Semantics/call09.f90
index 6ecf07ead581e..c3398293c8eeb 100644
--- a/flang/test/Semantics/call09.f90
+++ b/flang/test/Semantics/call09.f90
@@ -58,9 +58,6 @@ 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
@@ -79,8 +76,6 @@ subroutine test1 ! 15.5.2.9(5)
     call s01(null(intPtr))
     !ERROR: Actual argument associated with procedure dummy argument 'p=' is typeless
     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 explicit 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
@@ -94,10 +89,6 @@ 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 explicit 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 explicit interface
-    call s03(extfuncPtr)
   end subroutine
 
   subroutine callsub(s)

diff  --git a/flang/test/Semantics/call21.f90 b/flang/test/Semantics/call21.f90
new file mode 100644
index 0000000000000..4877551b58f63
--- /dev/null
+++ b/flang/test/Semantics/call21.f90
@@ -0,0 +1,31 @@
+! RUN: %flang -fsyntax-only 2>&1 %s | FileCheck %s
+! Verifies that warnings issue when actual arguments with implicit
+! interfaces are associated with dummy procedures and dummy procedure
+! pointers whose interfaces are explicit.
+module m
+ contains
+  real function realfunc(x)
+    real, intent(in) :: x
+    realfunc = x
+  end function
+  subroutine s00(p0)
+    procedure(realfunc) :: p0
+  end subroutine
+  subroutine s01(p1)
+    procedure(realfunc), pointer, intent(in) :: p1
+  end subroutine
+  subroutine s02(p2)
+    procedure(realfunc), pointer :: p2
+  end subroutine
+  subroutine test
+    external :: extfunc
+    external :: extfuncPtr
+    pointer :: extfuncPtr
+    !CHECK: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p0=' which has an explicit interface
+    call s00(extfunc)
+    !CHECK: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p1=' which has an explicit interface
+    call s01(extfunc)
+    !CHECK: Actual procedure argument has an implicit interface which is not known to be compatible with dummy argument 'p2=' which has an explicit interface
+    call s02(extfuncPtr)
+  end subroutine
+end module