diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -632,6 +632,14 @@ void CheckHelper::CheckProcEntity( const Symbol &symbol, const ProcEntityDetails &details) { if (details.isDummy()) { + if (!symbol.attrs().test(Attr::POINTER) && // C843 + (symbol.attrs().test(Attr::INTENT_IN) || + symbol.attrs().test(Attr::INTENT_OUT) || + symbol.attrs().test(Attr::INTENT_INOUT))) { + messages_.Say("A dummy procedure without the POINTER attribute" + " may not have an INTENT attribute"_err_en_US); + } + const Symbol *interface{details.interface().symbol()}; if (!symbol.attrs().test(Attr::INTRINSIC) && (symbol.attrs().test(Attr::ELEMENTAL) || diff --git a/flang/test/Semantics/assign03.f90 b/flang/test/Semantics/assign03.f90 --- a/flang/test/Semantics/assign03.f90 +++ b/flang/test/Semantics/assign03.f90 @@ -42,7 +42,7 @@ ! C1030 and 10.2.2.4 - procedure names as target of procedure pointer subroutine s4(s_dummy) - procedure(s), intent(in) :: s_dummy + procedure(s) :: s_dummy procedure(s), pointer :: p, q procedure(), pointer :: r integer :: i diff --git a/flang/test/Semantics/call09.f90 b/flang/test/Semantics/call09.f90 --- a/flang/test/Semantics/call09.f90 +++ b/flang/test/Semantics/call09.f90 @@ -1,5 +1,8 @@ ! RUN: %S/test_errors.sh %s %t %f18 ! 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 +! dummy procedure pointer. module m contains @@ -22,6 +25,10 @@ subroutine s03(p) procedure(realfunc) :: p end subroutine + subroutine s04(p) + !ERROR: A dummy procedure without the POINTER attribute may not have an INTENT attribute + procedure(realfunc), intent(in) :: p + end subroutine subroutine selemental1(p) procedure(cos) :: p ! ok diff --git a/flang/test/Semantics/separate-mp02.f90 b/flang/test/Semantics/separate-mp02.f90 --- a/flang/test/Semantics/separate-mp02.f90 +++ b/flang/test/Semantics/separate-mp02.f90 @@ -157,9 +157,9 @@ module m3 interface module subroutine s1(x, y, z) - procedure(real), intent(in) :: x - procedure(real), intent(out) :: y - procedure(real), intent(out) :: z + procedure(real), pointer, intent(in) :: x + procedure(real), pointer, intent(out) :: y + procedure(real), pointer, intent(out) :: z end module subroutine s2(x, y) procedure(real), pointer :: x @@ -171,11 +171,11 @@ submodule(m3) sm3 contains module subroutine s1(x, y, z) - procedure(real), intent(in) :: x + procedure(real), pointer, intent(in) :: x !ERROR: The intent of dummy argument 'y' does not match the intent of the corresponding argument in the interface body - procedure(real), intent(inout) :: y + procedure(real), pointer, intent(inout) :: y !ERROR: The intent of dummy argument 'z' does not match the intent of the corresponding argument in the interface body - procedure(real) :: z + procedure(real), pointer :: z end module subroutine s2(x, y) !ERROR: Dummy argument 'x' has the OPTIONAL attribute; the corresponding argument in the interface body does not