forked from OSchip/llvm-project
190 lines
7.7 KiB
Fortran
190 lines
7.7 KiB
Fortran
! 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
|
|
|
|
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
|