1! { dg-do run }
2! PR fortran/35830
3!
4module m
5contains
6  subroutine one(a)
7      integer a(:)
8      print *, lbound(a), ubound(a), size(a)
9      if ((lbound(a,dim=1) /= 1) .or. (ubound(a,dim=1) /= 3)) &
10        call abort()
11      print *, a
12      if (any(a /= [1,2,3])) call abort()
13  end subroutine one
14end module m
15
16program test
17  use m
18  implicit none
19  call foo1(one)
20  call foo2(one)
21contains
22  subroutine foo1(f)
23    ! The following interface block is needed
24    ! for NAG f95 as it wrongly does not like
25    ! use-associated interfaces for PROCEDURE
26    ! (It is not needed for gfortran)
27    interface
28      subroutine bar(a)
29        integer a(:)
30      end subroutine
31    end interface
32    procedure(bar) :: f
33    call f([1,2,3]) ! Was failing before
34  end subroutine foo1
35  subroutine foo2(f)
36    interface
37      subroutine f(a)
38        integer a(:)
39      end subroutine
40    end interface
41    call f([1,2,3]) ! Works
42  end subroutine foo2
43end program test
44