|
111
|
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 !
|
|
|
11 program assumed_size_test_1
|
|
|
12 implicit none
|
|
|
13 real a(2, 4)
|
|
|
14
|
|
|
15 a = 1.0
|
|
|
16 call foo (a)
|
|
|
17
|
|
|
18 contains
|
|
|
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
|
|
|
64 end program assumed_size_test_1
|
