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

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

Line No. Rev Author Line
1 149 jeremybenn
! PR fortran/15080
2
! Really test forall with temporary
3
program evil_forall
4
  implicit none
5
  type t
6
    logical valid
7
    integer :: s
8
    integer, dimension(:), pointer :: p
9
  end type
10
  type (t), dimension (5) :: v
11
  integer i
12
 
13
  allocate (v(1)%p(2))
14
  allocate (v(2)%p(8))
15
  v(3)%p => NULL()
16
  allocate (v(4)%p(8))
17
  allocate (v(5)%p(2))
18
 
19
  v(:)%valid = (/.true., .true., .false., .true., .true./)
20
  v(:)%s = (/1, 8, 999, 6, 2/)
21
  v(1)%p(:) = (/9, 10/)
22
  v(2)%p(:) = (/1, 2, 3, 4, 5, 6, 7, 8/)
23
  v(4)%p(:) = (/13, 14, 15, 16, 17, 18, 19, 20/)
24
  v(5)%p(:) = (/11, 12/)
25
 
26
 
27
  forall (i=1:5,v(i)%valid)
28
    v(i)%p(1:v(i)%s) = v(6-i)%p(1:v(i)%s)
29
  end forall
30
 
31
  if (any(v(1)%p(:) .ne. (/11, 10/))) call abort
32
  if (any(v(2)%p(:) .ne. (/13, 14, 15, 16, 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
  ! I should really free the memory I've allocated.
37
end program

powered by: WebSVN 2.1.0

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