1! { dg-do run }
2!
3! PR 36322/36463
4!
5! Original code by James Van Buskirk.
6! Modified by Janus Weil <janus@gcc.gnu.org>
7
8module m
9
10   use ISO_C_BINDING
11
12   character, allocatable, save :: my_message(:)
13
14   abstract interface
15      function abs_fun(x)
16         use ISO_C_BINDING
17         import my_message
18         integer(C_INT) x(:)
19         character(size(my_message),C_CHAR) abs_fun(size(x))
20      end function abs_fun
21   end interface
22
23contains
24
25  function foo(y)
26    implicit none
27    integer(C_INT) :: y(:)
28    character(size(my_message),C_CHAR) :: foo(size(y))
29    integer i,j
30    do i=1,size(y)
31      do j=1,size(my_message)
32        foo(i)(j:j) = achar(iachar(my_message(j))+y(i))
33      end do
34    end do
35  end function
36
37  subroutine check(p,a)
38    integer a(:)
39    procedure(abs_fun) :: p
40    character(size(my_message),C_CHAR) :: c(size(a))
41    integer k,l,m
42    c = p(a)
43    m=iachar('a')
44    do k=1,size(a)
45      do l=1,size(my_message)
46        if (c(k)(l:l) /= achar(m)) call abort()
47        m = m + 1
48      end do
49    end do
50  end subroutine
51
52end module
53
54program prog
55
56use m
57
58integer :: i(4) = (/0,6,12,18/)
59
60allocate(my_message(1:6))
61
62my_message = (/'a','b','c','d','e','f'/)
63
64call check(foo,i)
65
66end program
67