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_7.f90] - Blame information for rev 303

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 303 jeremybenn 
! Really test where inside forall with temporary
2 
program evil_where
3 
  implicit none
4 
  type t
5 
    logical valid
6 
    integer :: s
7 
    integer, dimension(:), pointer :: p
8 
  end type
9 
  type (t), dimension (5) :: v
10 
  integer i
11 
 
12 
  allocate (v(1)%p(2))
13 
  allocate (v(2)%p(8))
14 
  v(3)%p => NULL()
15 
  allocate (v(4)%p(8))
16 
  allocate (v(5)%p(2))
17 
 
18 
  v(:)%valid = (/.true., .true., .false., .true., .true./)
19 
  v(:)%s = (/1, 8, 999, 6, 2/)
20 
  v(1)%p(:) = (/9, 10/)
21 
  v(2)%p(:) = (/1, 2, 3, 4, 5, 6, 7, 8/)
22 
  v(4)%p(:) = (/13, 14, 15, 16, 17, 18, 19, 20/)
23 
  v(5)%p(:) = (/11, 12/)
24 
 
25 
  forall (i=1:5,v(i)%valid)
26 
    where (v(i)%p(1:v(i)%s).gt.4)
27 
      v(i)%p(1:v(i)%s) = v(6-i)%p(1:v(i)%s)
28 
    end where
29 
  end forall
30 
 
31 
  if (any(v(1)%p(:) .ne. (/11, 10/))) call abort
32 
  if (any(v(2)%p(:) .ne. (/1, 2, 3, 4, 17, 18, 19, 20/))) call abort
33 
  if (any(v(4)%p(:) .ne. (/1, 2, 3, 4, 5, 6, 19, 20/))) call abort
34 
  if (any(v(5)%p(:) .ne. (/9, 10/))) call abort
35 
 
36 
  v(1)%p(:) = (/9, 10/)
37 
  v(2)%p(:) = (/1, 2, 3, 4, 5, 6, 7, 8/)
38 
  v(4)%p(:) = (/13, 14, 15, 16, 17, 18, 19, 20/)
39 
  v(5)%p(:) = (/11, 12/)
40 
 
41 
  forall (i=1:5,v(i)%valid)
42 
    where (v(i)%p(1:v(i)%s).le.4)
43 
      v(i)%p(1:v(i)%s) = v(6-i)%p(1:v(i)%s)
44 
    end where
45 
  end forall
46 
 
47 
  if (any(v(1)%p(:) .ne. (/9, 10/))) call abort
48 
  if (any(v(2)%p(:) .ne. (/13, 14, 15, 16, 5, 6, 7, 8/))) call abort
49 
  if (any(v(4)%p(:) .ne. (/13, 14, 15, 16, 17, 18, 19, 20/))) call abort
50 
  if (any(v(5)%p(:) .ne. (/11, 12/))) call abort
51 
 
52 
  ! I should really free the memory I've allocated.
53 
end program

powered by: WebSVN 2.1.0

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