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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [where_1.f90] - Blame information for rev 695

Line No.	Rev	Author	Line
1	695	jeremybenn	`! Program to test WHERE inside FORALL`
2			`program where_1`
3			`integer :: A(5,5)`
4
5			`A(1,:) = (/1,0,0,0,0/)`
6			`A(2,:) = (/2,1,1,1,0/)`
7			`A(3,:) = (/1,2,2,0,2/)`
8			`A(4,:) = (/2,1,0,2,3/)`
9			`A(5,:) = (/1,0,0,0,0/)`
10
11			`! Where inside FORALL.`
12			`! WHERE masks must be evaluated before executing the assignments`
13			`forall (I=1:5)`
14			`where (A(I,:) .EQ. 0)`
15			`A(:,I) = I`
16			`elsewhere (A(I,:) >2)`
17			`A(I,:) = 6`
18			`endwhere`
19			`end forall`
20
21			`if (any (A .ne. reshape ((/1, 1, 1, 1, 1, 0, 1, 2, 1, 2, 0, 1, 2, 3, 0, &`
22			`0, 1, 4, 2, 0, 0, 5, 6, 6, 5/), (/5, 5/)))) call abort`
23
24			`! Where inside DO`
25			`A(1,:) = (/1,0,0,0,0/)`
26			`A(2,:) = (/2,1,1,1,0/)`
27			`A(3,:) = (/1,2,2,0,2/)`
28			`A(4,:) = (/2,1,0,2,3/)`
29			`A(5,:) = (/1,0,0,0,0/)`
30
31			`do I=1,5`
32			`where (A(I,:) .EQ. 0)`
33			`A(:,I) = I`
34			`elsewhere (A(I,:) >2)`
35			`A(I,:) = 6`
36			`endwhere`
37			`enddo`
38
39			`if (any (A .ne. reshape ((/1, 1, 1, 1, 1, 0, 1, 2, 1, 2, 0, 1, 2, 6, 0, &`
40			`0, 1, 0, 2, 0, 0, 0, 5, 5, 5/), (/5, 5/)))) call abort`
41			`end`