[flang-commits] [PATCH] D136989: [flang] Correct a predicate around a semantic check

[Peter Klausler via Phabricator via flang-commits]

This revision was automatically updated to reflect the committed changes.
Closed by commit rGd9f85656a641: [flang] Correct a predicate around a semantic check (authored by klausler).

Repository:
  rG LLVM Github Monorepo

CHANGES SINCE LAST ACTION
  https://reviews.llvm.org/D136989/new/

https://reviews.llvm.org/D136989

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
@@ -1,7 +1,7 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Test 15.5.2.9(2,3,5) dummy procedure requirements
 ! C843
-!   An entity with the INTENT attribute shall be a dummy data object or a 
+!   An entity with the INTENT attribute shall be a dummy data object or a
 !   dummy procedure pointer.
 
 module m
@@ -22,6 +22,9 @@
   subroutine s02(p)
     procedure(realfunc), pointer :: p
   end subroutine
+  subroutine s02b(p)
+    procedure(real), pointer :: p
+  end subroutine
   subroutine s03(p)
     procedure(realfunc) :: p
   end subroutine
@@ -90,6 +93,16 @@
     call s05(null())
     !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 s02b(realfunc)
+    call s02b(p) ! ok
+    !ERROR: Actual argument function associated with procedure dummy argument 'p=' has incompatible result type
+    call s02b(ip)
+    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
+    call s02b(procptr())
+    call s02b(null())
+    !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN)
+    call s02b(sin)
   end subroutine
 
   subroutine callsub(s)
Index: flang/lib/Semantics/check-call.cpp
===================================================================
--- flang/lib/Semantics/check-call.cpp
+++ flang/lib/Semantics/check-call.cpp
@@ -658,8 +658,7 @@
             dummyName);
       }
     }
-    if (interface.HasExplicitInterface() && dummyIsPointer &&
-        dummy.intent != common::Intent::In) {
+    if (dummyIsPointer && dummy.intent != common::Intent::In) {
       const Symbol *last{GetLastSymbol(*expr)};
       if (!(last && IsProcedurePointer(*last)) &&
           !(dummy.intent == common::Intent::Default &&


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D136989.471867.patch
Type: text/x-patch
Size: 2147 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20221030/14f02a7d/attachment.bin>