|
111
|
1 ! Like array_constructor_6.f90, but check constructors in which the length
|
|
|
2 ! of each subarray can only be determined at run time.
|
|
|
3 ! { dg-do run }
|
|
|
4 program main
|
|
|
5 implicit none
|
|
|
6 call build (9)
|
|
|
7 contains
|
|
|
8 function gen (order)
|
|
|
9 real, dimension (:, :), pointer :: gen
|
|
|
10 integer :: order, i, j
|
|
|
11
|
|
|
12 allocate (gen (order, order + 1))
|
|
|
13 forall (i = 1 : order, j = 1 : order + 1) gen (i, j) = i * i + j
|
|
|
14 end function gen
|
|
|
15
|
|
|
16 ! Deliberately leaky!
|
|
|
17 subroutine build (order)
|
|
|
18 integer :: order, i
|
|
|
19
|
|
|
20 call test (order, 0, (/ (gen (i), i = 1, order) /))
|
|
|
21 call test (3, 2, (/ ((/ 1.5, 1.5, gen (i) /), i = 1, 3) /))
|
|
|
22 end subroutine build
|
|
|
23
|
|
|
24 subroutine test (order, prefix, values)
|
|
|
25 real, dimension (:) :: values
|
|
|
26 integer :: order, prefix, last, i, j, k
|
|
|
27
|
|
|
28 last = 0
|
|
|
29 do i = 1, order
|
|
|
30 do j = 1, prefix
|
|
|
31 last = last + 1
|
|
|
32 if (values (last) .ne. 1.5) call abort
|
|
|
33 end do
|
|
|
34 do j = 1, i + 1
|
|
|
35 do k = 1, i
|
|
|
36 last = last + 1
|
|
|
37 if (values (last) .ne. j + k * k) call abort
|
|
|
38 end do
|
|
|
39 end do
|
|
|
40 end do
|
|
|
41 if (size (values, dim = 1) .ne. last) call abort
|
|
|
42 end subroutine test
|
|
|
43 end program main
|
