OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [where_1.f90] - Blame information for rev 303

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 303 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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.