URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [vector_subscript_2.f90] - Blame information for rev 708

Line No.	Rev	Author	Line
1	694	jeremybenn	`! Like vector_subscript_1.f90, but check subscripts in multi-dimensional`
2			`! arrays.`
3			`! { dg-do run }`
4			`program main`
5			`implicit none`
6			`integer, parameter :: n = 5`
7			`integer :: i1, i2, i3`
8			`integer, dimension (n, n, n) :: a, b`
9			`integer, dimension (n) :: idx, id`
10
11			`idx = (/ 3, 1, 5, 2, 4 /)`
12			`id = (/ (i1, i1 = 1, n) /)`
13			`forall (i1 = 1:n, i2 = 1:n, i3 = 1:n)`
14			`b (i1, i2, i3) = i1 + i2 * 10 + i3 * 100`
15			`end forall`
16
17			`i1 = 5`
18			`a (foo (i1), 1, :) = b (2, :, foo (i1))`
19			`do i1 = 1, 5`
20			`do i2 = 1, 5`
21			`if (a (idx (i1), 1, i2) .ne. b (2, i1, idx (i2))) call abort`
22			`end do`
23			`end do`
24			`a = 0`
25
26			`a (1, idx (1:4), 2:4) = b (2:5, idx (3:5), 2)`
27			`do i1 = 1, 4`
28			`do i2 = 1, 3`
29			`if (a (1, idx (i1), 1 + i2) .ne. b (1 + i1, idx (i2 + 2), 2)) call abort`
30			`end do`
31			`end do`
32			`a = 0`
33			`contains`
34			`function foo (n)`
35			`integer :: n`
36			`integer, dimension (n) :: foo`
37			`foo = idx (1:n)`
38			`end function foo`
39			`end program main`