1! { dg-do run }
2! Tests the fix for PRs 19358, 19477, 21211 and 21622.
3!
4! Note that this tests only the valid cases with explicit interfaces.
5!
6! Contributed by Paul Thomas  <pault@gcc.gnu.org>
7!
8module global
9contains
10  SUBROUTINE goo (x, i)
11    REAL, DIMENSION(i:)     :: x
12    integer                 :: i
13    x (3) = 99.0
14  END SUBROUTINE goo
15end module global
16
17SUBROUTINE foo (x, i)
18  REAL, DIMENSION(i:)       :: x
19  integer                   :: i
20  x (4) = 42.0
21END SUBROUTINE foo
22
23program test
24  use global
25  real, dimension(3)        :: y = 0
26  integer                   :: j = 2
27
28interface
29  SUBROUTINE foo (x, i)
30    REAL, DIMENSION(i:)     :: x
31    integer                 :: i
32  END SUBROUTINE foo
33end interface
34  call foo (y, j)
35  call goo (y, j)
36  call roo (y, j)
37  if (any(y.ne.(/21.0, 99.0, 42.0/))) STOP 1
38contains
39  SUBROUTINE roo (x, i)
40    REAL, DIMENSION(i:)     :: x
41    integer                 :: i
42    x (2) = 21.0
43  END SUBROUTINE roo
44end program test
45