1! { dg-do run }
2!
3! PR fortran/52022
4!
5
6module check
7  integer, save :: icheck = 0
8end module check
9
10module t
11implicit none
12      contains
13subroutine  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
21
22   if (any (cost([1d0,2d0]) /= [2.d0, 4.d0])) call abort ()
23   icheck = icheck + 1
24end subroutine
25
26end module t
27
28module tt
29   procedure(cost1),pointer :: pcost
30contains
31  subroutine init()
32        pcost=>cost1
33  end subroutine
34
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
41
42
43
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
50end module
51
52program test
53        use tt
54        use t
55        use check
56        implicit none
57
58        call init()
59        if (any (cost([3.d0,7.d0]) /= [6.d0, 14.d0])) call abort ()
60        if (icheck /= 0) call abort ()
61        call sol(cost)
62        if (icheck /= 1) call abort ()
63end program test
64