| ! RUN: %S/test_errors.sh %s %t %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 |
| ! dummy procedure pointer. |
| |
| module m |
| contains |
| |
| integer function intfunc(x) |
| integer, intent(in) :: x |
| intfunc = x |
| end function |
| real function realfunc(x) |
| real, intent(in) :: x |
| realfunc = x |
| end function |
| |
| subroutine s01(p) |
| procedure(realfunc), pointer, intent(in) :: p |
| end subroutine |
| subroutine s02(p) |
| procedure(realfunc), pointer :: p |
| end subroutine |
| 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 |
| end subroutine |
| |
| real elemental function elemfunc(x) |
| real, intent(in) :: x |
| elemfunc = x |
| end function |
| subroutine selemental2(p) |
| !ERROR: A dummy procedure may not be ELEMENTAL |
| procedure(elemfunc) :: p |
| end subroutine |
| |
| function procptr() |
| procedure(realfunc), pointer :: procptr |
| procptr => realfunc |
| end function |
| function intprocptr() |
| procedure(intfunc), pointer :: intprocptr |
| intprocptr => intfunc |
| end function |
| |
| subroutine test1 ! 15.5.2.9(5) |
| intrinsic :: sin |
| 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 |
| !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=' |
| call s01(intfunc) |
| call s01(p) ! ok |
| call s01(procptr()) ! ok |
| !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=' |
| call s01(intprocptr()) |
| call s01(null()) ! ok |
| call s01(null(p)) ! ok |
| !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=' |
| call s01(null(ip)) |
| call s01(sin) ! ok |
| !ERROR: Actual argument associated with procedure dummy argument 'p=' is not a procedure |
| 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 |
| !ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=' |
| call s02(ip) |
| !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN) |
| call s02(procptr()) |
| !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN) |
| call s02(null()) |
| !ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a POINTER unless INTENT(IN) |
| 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) |
| call s |
| end subroutine |
| subroutine takesrealfunc1(f) |
| external f |
| real f |
| end subroutine |
| subroutine takesrealfunc2(f) |
| x = f(1) |
| end subroutine |
| subroutine forwardproc(p) |
| implicit none |
| external :: p ! function or subroutine not known |
| call foo(p) |
| end subroutine |
| |
| subroutine test2(unknown,ds,drf,dif) ! 15.5.2.9(2,3) |
| external :: unknown, ds, drf, dif |
| real :: drf |
| integer :: dif |
| procedure(callsub), pointer :: ps |
| procedure(realfunc), pointer :: prf |
| procedure(intfunc), pointer :: pif |
| call ds ! now we know that's it's a subroutine |
| call callsub(callsub) ! ok apart from infinite recursion |
| call callsub(unknown) ! ok |
| call callsub(ds) ! ok |
| call callsub(ps) ! ok |
| call takesrealfunc1(realfunc) ! ok |
| call takesrealfunc1(unknown) ! ok |
| call takesrealfunc1(drf) ! ok |
| call takesrealfunc1(prf) ! ok |
| call takesrealfunc2(realfunc) ! ok |
| call takesrealfunc2(unknown) ! ok |
| call takesrealfunc2(drf) ! ok |
| call takesrealfunc2(prf) ! ok |
| call forwardproc(callsub) ! ok |
| call forwardproc(realfunc) ! ok |
| call forwardproc(intfunc) ! ok |
| call forwardproc(unknown) ! ok |
| call forwardproc(ds) ! ok |
| call forwardproc(drf) ! ok |
| call forwardproc(dif) ! ok |
| call forwardproc(ps) ! ok |
| call forwardproc(prf) ! ok |
| call forwardproc(pif) ! ok |
| !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine |
| call callsub(realfunc) |
| !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine |
| call callsub(intfunc) |
| !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine |
| call callsub(drf) |
| !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine |
| call callsub(dif) |
| !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine |
| call callsub(prf) |
| !ERROR: Actual argument associated with procedure dummy argument 's=' is a function but must be a subroutine |
| call callsub(pif) |
| !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function |
| call takesrealfunc1(callsub) |
| !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function |
| call takesrealfunc1(ds) |
| !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function |
| call takesrealfunc1(ps) |
| !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type |
| call takesrealfunc1(intfunc) |
| !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type |
| call takesrealfunc1(dif) |
| !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type |
| call takesrealfunc1(pif) |
| !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type |
| call takesrealfunc1(intfunc) |
| !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function |
| call takesrealfunc2(callsub) |
| !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function |
| call takesrealfunc2(ds) |
| !ERROR: Actual argument associated with procedure dummy argument 'f=' is a subroutine but must be a function |
| call takesrealfunc2(ps) |
| !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type |
| call takesrealfunc2(intfunc) |
| !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type |
| call takesrealfunc2(dif) |
| !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type |
| call takesrealfunc2(pif) |
| !ERROR: Actual argument function associated with procedure dummy argument 'f=' has incompatible result type |
| call takesrealfunc2(intfunc) |
| end subroutine |
| end module |
