! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
! 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 s02b(p)
procedure(real), 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 s05(p)
procedure(realfunc), pointer, intent(in out) :: p
end subroutine
subroutine selemental1(p)
!PORTABILITY: A dummy procedure should not have an ELEMENTAL intrinsic as its interface
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
p => realfunc
ip => intfunc
call s01(realfunc) ! ok
!ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
call s01(intfunc)
call s01(p) ! ok
call s01(procptr()) ! ok
!ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
call s01(intprocptr())
call s01(null()) ! ok
call s01(null(p)) ! ok
!ERROR: Actual procedure argument has interface incompatible with dummy argument 'p=': function results have distinct types: REAL(4) vs INTEGER(4)
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 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=': function results have distinct types: REAL(4) vs INTEGER(4)
call s02(ip)
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
call s02(procptr())
call s02(null()) ! ok
!ERROR: Actual argument associated with procedure pointer dummy argument 'p=' must be a pointer unless INTENT(IN)
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=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
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)
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=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call takesrealfunc1(intfunc)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call takesrealfunc1(dif)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call takesrealfunc1(pif)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
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=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call takesrealfunc2(intfunc)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call takesrealfunc2(dif)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call takesrealfunc2(pif)
!ERROR: Actual argument function associated with procedure dummy argument 'f=' is not compatible: function results have distinct types: REAL(4) vs INTEGER(4)
call takesrealfunc2(intfunc)
end subroutine
end module
Codebase Browser
llvm