! { dg-do run }
|
! { dg-do run }
|
! Various runtime tests of PROCEDURE declarations.
|
! Various runtime tests of PROCEDURE declarations.
|
! Contributed by Janus Weil
|
! Contributed by Janus Weil
|
|
|
module m
|
module m
|
|
|
use ISO_C_BINDING
|
use ISO_C_BINDING
|
|
|
abstract interface
|
abstract interface
|
subroutine csub() bind(c)
|
subroutine csub() bind(c)
|
end subroutine csub
|
end subroutine csub
|
end interface
|
end interface
|
|
|
integer, parameter :: ckind = C_FLOAT_COMPLEX
|
integer, parameter :: ckind = C_FLOAT_COMPLEX
|
abstract interface
|
abstract interface
|
function stub() bind(C)
|
function stub() bind(C)
|
import ckind
|
import ckind
|
complex(ckind) stub
|
complex(ckind) stub
|
end function
|
end function
|
end interface
|
end interface
|
|
|
procedure():: mp1
|
procedure():: mp1
|
procedure(real), private:: mp2
|
procedure(real), private:: mp2
|
procedure(mfun), public:: mp3
|
procedure(mfun), public:: mp3
|
procedure(csub), public, bind(c) :: c, d
|
procedure(csub), public, bind(c) :: c, d
|
procedure(csub), public, bind(c, name="myB") :: b
|
procedure(csub), public, bind(c, name="myB") :: b
|
procedure(stub), bind(C) :: e
|
procedure(stub), bind(C) :: e
|
|
|
contains
|
contains
|
|
|
real function mfun(x,y)
|
real function mfun(x,y)
|
real x,y
|
real x,y
|
mfun=4.2
|
mfun=4.2
|
end function
|
end function
|
|
|
subroutine bar(a,b)
|
subroutine bar(a,b)
|
implicit none
|
implicit none
|
interface
|
interface
|
subroutine a()
|
subroutine a()
|
end subroutine a
|
end subroutine a
|
end interface
|
end interface
|
optional :: a
|
optional :: a
|
procedure(a), optional :: b
|
procedure(a), optional :: b
|
end subroutine bar
|
end subroutine bar
|
|
|
subroutine bar2(x)
|
subroutine bar2(x)
|
abstract interface
|
abstract interface
|
character function abs_fun()
|
character function abs_fun()
|
end function
|
end function
|
end interface
|
end interface
|
procedure(abs_fun):: x
|
procedure(abs_fun):: x
|
end subroutine
|
end subroutine
|
|
|
|
|
end module
|
end module
|
|
|
|
|
program p
|
program p
|
implicit none
|
implicit none
|
|
|
abstract interface
|
abstract interface
|
subroutine abssub(x)
|
subroutine abssub(x)
|
real x
|
real x
|
end subroutine
|
end subroutine
|
end interface
|
end interface
|
|
|
integer i
|
integer i
|
real r
|
real r
|
|
|
procedure(integer):: p1
|
procedure(integer):: p1
|
procedure(fun):: p2
|
procedure(fun):: p2
|
procedure(abssub):: p3
|
procedure(abssub):: p3
|
procedure(sub):: p4
|
procedure(sub):: p4
|
procedure():: p5
|
procedure():: p5
|
procedure(p4):: p6
|
procedure(p4):: p6
|
procedure(integer) :: p7
|
procedure(integer) :: p7
|
|
|
i=p1()
|
i=p1()
|
if (i /= 5) call abort()
|
if (i /= 5) call abort()
|
i=p2(3.1)
|
i=p2(3.1)
|
if (i /= 3) call abort()
|
if (i /= 3) call abort()
|
r=4.2
|
r=4.2
|
call p3(r)
|
call p3(r)
|
if (abs(r-5.2)>1e-6) call abort()
|
if (abs(r-5.2)>1e-6) call abort()
|
call p4(r)
|
call p4(r)
|
if (abs(r-3.7)>1e-6) call abort()
|
if (abs(r-3.7)>1e-6) call abort()
|
call p5()
|
call p5()
|
call p6(r)
|
call p6(r)
|
if (abs(r-7.4)>1e-6) call abort()
|
if (abs(r-7.4)>1e-6) call abort()
|
i=p7(4)
|
i=p7(4)
|
if (i /= -8) call abort()
|
if (i /= -8) call abort()
|
r=dummytest(p3)
|
r=dummytest(p3)
|
if (abs(r-2.1)>1e-6) call abort()
|
if (abs(r-2.1)>1e-6) call abort()
|
|
|
contains
|
contains
|
|
|
integer function fun(x)
|
integer function fun(x)
|
real x
|
real x
|
fun=7
|
fun=7
|
end function
|
end function
|
|
|
subroutine sub(x)
|
subroutine sub(x)
|
real x
|
real x
|
end subroutine
|
end subroutine
|
|
|
real function dummytest(dp)
|
real function dummytest(dp)
|
procedure(abssub):: dp
|
procedure(abssub):: dp
|
real y
|
real y
|
y=1.1
|
y=1.1
|
call dp(y)
|
call dp(y)
|
dummytest=y
|
dummytest=y
|
end function
|
end function
|
|
|
end program p
|
end program p
|
|
|
|
|
integer function p1()
|
integer function p1()
|
p1 = 5
|
p1 = 5
|
end function
|
end function
|
|
|
integer function p2(x)
|
integer function p2(x)
|
real x
|
real x
|
p2 = int(x)
|
p2 = int(x)
|
end function
|
end function
|
|
|
subroutine p3(x)
|
subroutine p3(x)
|
real,intent(inout):: x
|
real,intent(inout):: x
|
x=x+1.0
|
x=x+1.0
|
end subroutine
|
end subroutine
|
|
|
subroutine p4(x)
|
subroutine p4(x)
|
real,intent(inout):: x
|
real,intent(inout):: x
|
x=x-1.5
|
x=x-1.5
|
end subroutine
|
end subroutine
|
|
|
subroutine p5()
|
subroutine p5()
|
end subroutine
|
end subroutine
|
|
|
subroutine p6(x)
|
subroutine p6(x)
|
real,intent(inout):: x
|
real,intent(inout):: x
|
x=x*2.
|
x=x*2.
|
end subroutine
|
end subroutine
|
|
|
function p7(x)
|
function p7(x)
|
implicit none
|
implicit none
|
integer :: x, p7
|
integer :: x, p7
|
p7 = x*(-2)
|
p7 = x*(-2)
|
end function
|
end function
|
|
|
