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/] [where_7.f90] - Blame information for rev 154

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

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