Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/gfortran.dg/array_constructor_9.f90 @ 111:04ced10e8804
gcc 7
| author | kono |
|---|---|
| date | Fri, 27 Oct 2017 22:46:09 +0900 (2017-10-27) |
| parents | |
| children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
| 68:561a7518be6b | 111:04ced10e8804 |
|---|---|
| 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 |