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