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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [intrinsic_count.f90] - Diff between revs 149 and 154

Go to most recent revision | Only display areas with differences | Details | Blame | View Log

Rev 149 Rev 154
! Program to test the COUNT intrinsic
! Program to test the COUNT intrinsic
program intrinsic_count
program intrinsic_count
   implicit none
   implicit none
   logical(kind=4), dimension (3, 5) :: a
   logical(kind=4), dimension (3, 5) :: a
   integer(kind=4), dimension (3) :: b
   integer(kind=4), dimension (3) :: b
   integer i
   integer i
   character(len=10) line
   character(len=10) line
   a = .false.
   a = .false.
   if (count(a) .ne. 0) call abort
   if (count(a) .ne. 0) call abort
   a = .true.
   a = .true.
   if (count(a) .ne. 15) call abort
   if (count(a) .ne. 15) call abort
   a(1, 1) = .false.
   a(1, 1) = .false.
   a(2, 2) = .false.
   a(2, 2) = .false.
   a(2, 5) = .false.
   a(2, 5) = .false.
   if (count(a) .ne. 12) call abort
   if (count(a) .ne. 12) call abort
   write (line, 9000) count(a)
   write (line, 9000) count(a)
   read (line, 9000) i
   read (line, 9000) i
   if (i .ne. 12) call abort
   if (i .ne. 12) call abort
   b(1:3) = count(a, 2);
   b(1:3) = count(a, 2);
   if (b(1) .ne. 4) call abort
   if (b(1) .ne. 4) call abort
   if (b(2) .ne. 3) call abort
   if (b(2) .ne. 3) call abort
   if (b(3) .ne. 5) call abort
   if (b(3) .ne. 5) call abort
   b = 0
   b = 0
   write (line, 9000) count(a,2)
   write (line, 9000) count(a,2)
   read (line, 9000) b
   read (line, 9000) b
   if (b(1) .ne. 4) call abort
   if (b(1) .ne. 4) call abort
   if (b(2) .ne. 3) call abort
   if (b(2) .ne. 3) call abort
   if (b(3) .ne. 5) call abort
   if (b(3) .ne. 5) call abort
9000 format(3I3)
9000 format(3I3)
end program
end program
 
 

powered by: WebSVN 2.1.0

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