ieee_9.f90: XFAIL on arm*-*-gnueabi[hf].
[official-gcc.git] / gcc / testsuite / gfortran.dg / dummy_procedure_7.f90
blob1f6a77b751d77a738e41838bfce359c02880321d
1 ! { dg-do run }
3 ! PR fortran/52022
6 module check
7 integer, save :: icheck = 0
8 end module check
10 module t
11 implicit none
12 contains
13 subroutine sol(cost)
14 use check
15 interface
16 function cost(p) result(y)
17 double precision,dimension(:) :: p
18 double precision,dimension(:),allocatable :: y
19 end function cost
20 end interface
22 if (any (cost([1d0,2d0]) /= [2.d0, 4.d0])) STOP 1
23 icheck = icheck + 1
24 end subroutine
26 end module t
28 module tt
29 procedure(cost1),pointer :: pcost
30 contains
31 subroutine init()
32 pcost=>cost1
33 end subroutine
35 function cost1(x) result(y)
36 double precision,dimension(:) :: x
37 double precision,dimension(:),allocatable :: y
38 allocate(y(2))
39 y=2d0*x
40 end function cost1
44 function cost(x) result(y)
45 double precision,dimension(:) :: x
46 double precision,dimension(:),allocatable :: y
47 allocate(y(2))
48 y=pcost(x)
49 end function cost
50 end module
52 program test
53 use tt
54 use t
55 use check
56 implicit none
58 call init()
59 if (any (cost([3.d0,7.d0]) /= [6.d0, 14.d0])) STOP 2
60 if (icheck /= 0) STOP 3
61 call sol(cost)
62 if (icheck /= 1) STOP 4
63 end program test