1!==================assumed_size_refs_1.f90==================
2! { dg-do compile }
3! Test the fix for PR25029, PR21256 in which references to
4! assumed size arrays without an upper bound to the last
5! dimension were generating no error. The first version of
6! the patch failed in DHSEQR, as pointed out by Toon Moene
7! in http://gcc.gnu.org/ml/fortran/2005-12/msg00466.html
8!
9! Contributed by Paul Thomas  <pault@gcc.gnu.org>
10!
11program assumed_size_test_1
12  implicit none
13  real a(2, 4)
14
15  a = 1.0
16  call foo (a)
17
18contains
19  subroutine foo(m)
20    real, target :: m(1:2, *)
21    real x(2,2,2)
22    real, external :: bar
23    real, pointer :: p(:,:), q(:,:)
24    allocate (q(2,2))
25
26! PR25029
27    p => m                     ! { dg-error "upper bound in the last dimension" }
28    q = m                      ! { dg-error "upper bound in the last dimension" }
29
30! PR21256( and PR25060)
31    m = 1                      ! { dg-error "upper bound in the last dimension" }
32
33    m(1,1) = 2.0
34    x = bar (m)
35    x = fcn (m)                ! { dg-error "upper bound in the last dimension" }
36    m(:, 1:2) = fcn (q)
37    call sub (m, x)            ! { dg-error "upper bound in the last dimension" }
38    call sub (m(1:2, 1:2), x)  ! { dg-error "Incompatible ranks in elemental procedure" }
39    print *, p
40
41    call DHSEQR(x)
42
43  end subroutine foo
44
45  elemental function fcn (a) result (b)
46    real, intent(in) :: a
47    real :: b
48    b = 2.0 * a
49  end function fcn
50
51  elemental subroutine sub (a, b)
52    real, intent(inout) :: a, b
53    b = 2.0 * a
54  end subroutine sub
55
56  SUBROUTINE DHSEQR( WORK )
57    REAL WORK( * )
58    EXTERNAL           DLARFX
59    INTRINSIC          MIN
60    WORK( 1 ) = 1.0
61    CALL DLARFX( MIN( 1, 8 ), WORK )
62  END SUBROUTINE DHSEQR
63
64end program assumed_size_test_1
65