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

Subversion Repositories openrisc

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

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 695 jeremybenn 
! Program to test the FORALL construct
2 
program testforall
3 
   implicit none
4 
   integer, dimension (3, 3) :: a
5 
   integer, dimension (3) :: b
6 
   logical, dimension (3, 3) :: m, tr
7 
   integer i
8 
   character(len=9) line
9 
 
10 
   a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/));
11 
 
12 
   tr = .true.
13 
 
14 
   if (sum(a) .ne. 45) call abort
15 
   write (line, 9000) sum(a)
16 
   if (line .ne. ' 45      ') call abort
17 
   b = sum (a, 1)
18 
   if (b(1) .ne. 6) call abort
19 
   if (b(2) .ne. 15) call abort
20 
   if (b(3) .ne. 24) call abort
21 
   write (line, 9000) sum (a, 1)
22 
   if (line .ne. '  6 15 24') call abort
23 
 
24 
   m = .true.
25 
   m(1, 1) = .false.
26 
   m(2, 1) = .false.
27 
 
28 
   if (sum (a, mask=m) .ne. 42) call abort
29 
   if (sum (a, mask=m .and. tr) .ne. 42) call abort
30 
 
31 
   write(line, 9000) sum (a, mask=m)
32 
   if (line .ne. ' 42      ') call abort
33 
 
34 
   b = sum (a, 2, m)
35 
   if (b(1) .ne. 11) call abort
36 
   if (b(2) .ne. 13) call abort
37 
   if (b(3) .ne. 18) call abort
38 
 
39 
   b = sum (a, 2, m .and. tr)
40 
   if (b(1) .ne. 11) call abort
41 
   if (b(2) .ne. 13) call abort
42 
   if (b(3) .ne. 18) call abort
43 
   write (line, 9000) sum (a, 2, m)
44 
   if (line .ne. ' 11 13 18') call abort
45 
 
46 
9000 format(3I3)
47 
end program

powered by: WebSVN 2.1.0

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