1! { dg-do run }
2! Tests the fix for pr28660 in which the order of dependent declarations
3! would get scrambled in the compiled code.
4!
5! Contributed by Erik Edelmann  <erik.edelmann@iki.fi>
6!
7program bar
8    implicit none
9    real :: x(10)
10    call foo1 (x)
11    call foo2 (x)
12    call foo3 (x)
13contains
14    subroutine foo1 (xmin)
15        real, intent(inout) :: xmin(:)
16        real :: x(size(xmin)+1)           ! The declaration for r would be added
17        real :: r(size(x)-1)              ! to the function before that of x
18        xmin = r
19        if (size(r) .ne. 10) call abort ()
20        if (size(x) .ne. 11) call abort ()
21    end subroutine foo1
22    subroutine foo2 (xmin)                ! This version was OK because of the
23        real, intent(inout) :: xmin(:)    ! renaming of r which pushed it up
24        real :: x(size(xmin)+3)           ! the symtree.
25        real :: zr(size(x)-3)
26        xmin = zr
27        if (size(zr) .ne. 10) call abort ()
28        if (size(x) .ne. 13) call abort ()
29    end subroutine foo2
30    subroutine foo3 (xmin)
31        real, intent(inout) :: xmin(:)
32        character(size(x)+2) :: y         ! host associated x
33        character(len(y)+3) :: z          ! This did not work for any combination
34        real :: r(len(z)-5)              ! of names.
35        xmin = r
36        if (size(r) .ne. 10) call abort ()
37        if (len(z) .ne. 15) call abort ()
38    end subroutine foo3
39end program bar
40