diff options
author | Peter Klausler <pklausler@nvidia.com> | 2022-10-24 22:06:56 +0300 |
---|---|---|
committer | Peter Klausler <pklausler@nvidia.com> | 2022-10-30 23:48:09 +0300 |
commit | d9f85656a641d94b1ff05bb40fa925ce35e7a21c (patch) | |
tree | 45e93ea430214248bcdd26c245f0981966823bf1 /flang | |
parent | 1f1fb208dae8490e7847a6107778de97175a2557 (diff) |
[flang] Correct a predicate around a semantic check
When a dummy argument is a procedure pointer without INTENT(IN),
any actual argument must also be a procedure pointer, whether the
dummy procedure pointer's interface is explicit or not.
Differential Revision: https://reviews.llvm.org/D136989
Diffstat (limited to 'flang')
-rw-r--r-- | flang/lib/Semantics/check-call.cpp | 3 | ||||
-rw-r--r-- | flang/test/Semantics/call09.f90 | 15 |
2 files changed, 15 insertions, 3 deletions
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index 1f2af55cbdd2..832dd0d34a3f 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -658,8 +658,7 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg, 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 && diff --git a/flang/test/Semantics/call09.f90 b/flang/test/Semantics/call09.f90 index 36ab64ecce50..c8fa19c88294 100644 --- a/flang/test/Semantics/call09.f90 +++ b/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 @@ module m 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 @@ module m 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) |