1! { dg-do run }
2! PR37926 - the interface did not transfer the formal
3! argument list for the call to 'asz' in the specification of 'p'.
4!
5! Contributed by Janus Weil  <janus@gcc.gnu.org>
6!
7module m
8contains
9  pure integer function mysize(a)
10    integer,intent(in) :: a(:)
11    mysize = size(a)
12  end function
13end module
14
15program prog
16  use m
17  implicit none
18  character(3) :: str
19  integer :: i(3) = (/1,2,3/)
20  str = p(i,mysize)
21  if (len(str) .ne. 3) call abort
22  if (str .ne. "BCD") call abort
23contains
24  function p(y,asz)
25    implicit none
26    integer :: y(:)
27    interface
28      pure integer function asz(c)
29        integer,intent(in) :: c(:)
30      end function
31    end interface
32    character(asz(y)) p
33    integer i
34    do i=1,asz(y)
35      p(i:i) = achar(iachar('A')+y(i))
36    end do
37  end function
38end
39