diff options
author | Peter Klausler <pklausler@nvidia.com> | 2022-05-03 20:10:11 +0300 |
---|---|---|
committer | Peter Klausler <pklausler@nvidia.com> | 2022-05-10 03:41:39 +0300 |
commit | 78a166b47beb919b50594f13c1d0c23bda3e4fd7 (patch) | |
tree | 50fbac9e40cfbd2b8f0f7cc4c0b03f941a0f7c76 /flang | |
parent | 45ac2c730bc4f78d2d90a76e98fab66de92433b6 (diff) |
[flang] Allow NULL() actual argument for optional dummy procedure
A disassociated procedure pointer is allowed to be passed as an absent
actual argument that corresponds to an optional dummy procedure,
but not NULL(); accept that case as well.
Differential Revision: https://reviews.llvm.org/D125127
Diffstat (limited to 'flang')
-rw-r--r-- | flang/lib/Semantics/check-call.cpp | 4 | ||||
-rw-r--r-- | flang/test/Semantics/call02.f90 | 8 |
2 files changed, 11 insertions, 1 deletions
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index 8f49953f4b14..fee716248cbf 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -635,7 +635,9 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg, dummyName); } } else if (IsNullPointer(*expr)) { - if (!dummyIsPointer) { + if (!dummyIsPointer && + !dummy.attrs.test( + characteristics::DummyProcedure::Attr::Optional)) { messages.Say( "Actual argument associated with procedure %s is a null pointer"_err_en_US, dummyName); diff --git a/flang/test/Semantics/call02.f90 b/flang/test/Semantics/call02.f90 index dfd1ba5537d4..a4ceaf65d1ed 100644 --- a/flang/test/Semantics/call02.f90 +++ b/flang/test/Semantics/call02.f90 @@ -15,6 +15,12 @@ subroutine s01(elem, subr) !ERROR: A dummy procedure may not be ELEMENTAL procedure(elem) :: dummy end subroutine + subroutine optionalsubr(dummy) + procedure(sin), optional :: dummy + end subroutine + subroutine ptrsubr(dummy) + procedure(sin), pointer, intent(in) :: dummy + end subroutine end interface intrinsic :: cos call subr(cos) ! not an error @@ -22,6 +28,8 @@ subroutine s01(elem, subr) call subr(elem) ! C1533 !ERROR: Actual argument associated with procedure dummy argument 'dummy=' is a null pointer call subr(null()) + call optionalsubr(null()) ! ok + call ptrsubr(null()) ! ok !ERROR: Actual argument associated with procedure dummy argument 'dummy=' is typeless call subr(B"1010") end subroutine |