! { dg-do run } ! ! PR 36322/36463 ! ! Original code by James Van Buskirk. ! Modified by Janus Weil module m use ISO_C_BINDING character, allocatable, save :: my_message(:) abstract interface function abs_fun(x) use ISO_C_BINDING import my_message integer(C_INT) x(:) character(size(my_message),C_CHAR) abs_fun(size(x)) end function abs_fun end interface contains function foo(y) implicit none integer(C_INT) :: y(:) character(size(my_message),C_CHAR) :: foo(size(y)) integer i,j do i=1,size(y) do j=1,size(my_message) foo(i)(j:j) = achar(iachar(my_message(j))+y(i)) end do end do end function subroutine check(p,a) integer a(:) procedure(abs_fun) :: p character(size(my_message),C_CHAR) :: c(size(a)) integer k,l,m c = p(a) m=iachar('a') do k=1,size(a) do l=1,size(my_message) if (c(k)(l:l) /= achar(m)) call abort() m = m + 1 end do end do end subroutine end module program prog use m integer :: i(4) = (/0,6,12,18/) allocate(my_message(1:6)) my_message = (/'a','b','c','d','e','f'/) call check(foo,i) end program ! { dg-final { cleanup-modules "m" } }