|
111
|
1 ! { dg-do run }
|
|
|
2 !
|
|
|
3 ! PR fortran/38669
|
|
|
4 ! Loop bounds temporaries used before being defined for elemental subroutines
|
|
|
5 !
|
|
|
6 ! Original testcase by Harald Anlauf <anlauf@gmx.de>
|
|
|
7
|
|
|
8 program gfcbu84_main
|
|
|
9 implicit none
|
|
|
10 integer :: jplev, k_lev
|
|
|
11 integer :: p(42)
|
|
|
12 real :: r(42)
|
|
|
13 integer, pointer :: q(:)
|
|
|
14 jplev = 42
|
|
|
15 k_lev = 1
|
|
|
16 call random_number (r)
|
|
|
17 p = 41 * r + 1
|
|
|
18 allocate (q(jplev))
|
|
|
19
|
|
|
20 q = 0
|
|
|
21 call tq_tvgh (q(k_lev:), p(k_lev:))
|
|
131
|
22 if (any (p /= q)) STOP 1
|
|
111
|
23
|
|
|
24 q = 0
|
|
|
25 call tq_tvgh (q(k_lev:), (p(k_lev:)))
|
|
131
|
26 if (any (p /= q)) STOP 2
|
|
111
|
27
|
|
|
28 q = 0
|
|
|
29 call tq_tvgh (q(k_lev:), (p(p(k_lev:))))
|
|
131
|
30 if (any (p(p) /= q)) STOP 3
|
|
111
|
31
|
|
|
32 deallocate (q)
|
|
|
33
|
|
|
34 contains
|
|
|
35 elemental subroutine tq_tvgh (t, p)
|
|
|
36 integer ,intent (out) :: t
|
|
|
37 integer ,intent (in) :: p
|
|
|
38 t=p
|
|
|
39 end subroutine tq_tvgh
|
|
|
40 end program gfcbu84_main
|
