Subversion Repositories openrisc

! { 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" } }