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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [zero_sized_1.f90] - Blame information for rev 801

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

Line No. Rev Author Line
1 694 jeremybenn 
! { dg-do run }
2 
! Transformational functions for zero-sized array and array sections
3 
! Contributed by Francois-Xavier Coudert
4 
 
5 
subroutine test_cshift
6 
  real :: tempn(1), tempm(1,2)
7 
  real,allocatable :: foo(:),bar(:,:),gee(:,:)
8 
  tempn = 2.0
9 
  tempm = 1.0
10 
  allocate(foo(0),bar(2,0),gee(0,7))
11 
  if (any(cshift(foo,dim=1,shift=1)/= 0)) call abort
12 
  if (any(cshift(tempn(2:1),dim=1,shift=1)/= 0)) call abort
13 
  if (any(cshift(bar,shift=(/1,-1/),dim=1)/= 0)) call abort
14 
  if (any(cshift(bar,shift=(/1,-1/),dim=2)/= 0)) call abort
15 
  if (any(cshift(gee,shift=(/1,-1/),dim=1)/= 0)) call abort
16 
  if (any(cshift(gee,shift=(/1,-1/),dim=2)/= 0)) call abort
17 
  if (any(cshift(tempm(5:4,:),shift=(/1,-1/),dim=1)/= 0)) call abort
18 
  deallocate(foo,bar,gee)
19 
end
20 
 
21 
subroutine test_eoshift
22 
  real :: tempn(1), tempm(1,2)
23 
  real,allocatable :: foo(:),bar(:,:),gee(:,:)
24 
  tempn = 2.0
25 
  tempm = 1.0
26 
  allocate(foo(0),bar(2,0),gee(0,7))
27 
  if (any(eoshift(foo,dim=1,shift=1)/= 0)) call abort
28 
  if (any(eoshift(tempn(2:1),dim=1,shift=1)/= 0)) call abort
29 
  if (any(eoshift(bar,shift=(/1,-1/),dim=1)/= 0)) call abort
30 
  if (any(eoshift(bar,shift=(/1,-1/),dim=2)/= 0)) call abort
31 
  if (any(eoshift(gee,shift=(/1,-1/),dim=1)/= 0)) call abort
32 
  if (any(eoshift(gee,shift=(/1,-1/),dim=2)/= 0)) call abort
33 
  if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=1)/= 0)) call abort
34 
 
35 
  if (any(eoshift(foo,dim=1,shift=1,boundary=42.0)/= 0)) call abort
36 
  if (any(eoshift(tempn(2:1),dim=1,shift=1,boundary=42.0)/= 0)) call abort
37 
  if (any(eoshift(bar,shift=(/1,-1/),dim=1,boundary=42.0)/= 0)) call abort
38 
  if (any(eoshift(bar,shift=(/1,-1/),dim=2,boundary=42.0)/= 0)) call abort
39 
  if (any(eoshift(gee,shift=(/1,-1/),dim=1,boundary=42.0)/= 0)) call abort
40 
  if (any(eoshift(gee,shift=(/1,-1/),dim=2,boundary=42.0)/= 0)) call abort
41 
  if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=1,boundary=42.0)/= 0)) call abort
42 
 
43 
  if (any(eoshift(foo,dim=1,shift=1,boundary=42.0)/= 0)) call abort
44 
  if (any(eoshift(tempn(2:1),dim=1,shift=1,boundary=-7.0)/= 0)) call abort
45 
  if (any(eoshift(bar,shift=(/1,-1/),dim=1,boundary=(/42.0,-7.0/))/= 0)) call abort
46 
  if (any(eoshift(bar,shift=(/1,-1/),dim=2,boundary=(/42.0,-7.0/))/= 0)) call abort
47 
  if (any(eoshift(gee,shift=(/1,-1/),dim=1,boundary=(/42.0,-7.0/))/= 0)) call abort
48 
  if (any(eoshift(gee,shift=(/1,-1/),dim=2,boundary=(/42.0,-7.0/))/= 0)) call abort
49 
  if (any(eoshift(tempm(5:4,:),shift=(/1,-1/),dim=1,boundary=(/42.0,-7.0/))/= 0)) call abort
50 
  deallocate(foo,bar,gee)
51 
end
52 
 
53 
subroutine test_transpose
54 
  character(len=1) :: tempn(1,2)
55 
  character(len=1),allocatable :: foo(:,:), bar(:,:)
56 
  integer :: tempm(1,2)
57 
  integer,allocatable :: x(:,:), y(:,:)
58 
  tempn = 'a'
59 
  allocate(foo(3,0),bar(-2:-4,7:9))
60 
  tempm = -42
61 
  allocate(x(3,0),y(-2:-4,7:9))
62 
  if (any(transpose(tempn(-7:-8,:)) /= 'b')) call abort
63 
  if (any(transpose(tempn(:,9:8)) /= 'b')) call abort
64 
  if (any(transpose(foo) /= 'b')) call abort
65 
  if (any(transpose(bar) /= 'b')) call abort
66 
  if (any(transpose(tempm(-7:-8,:)) /= 0)) call abort
67 
  if (any(transpose(tempm(:,9:8)) /= 0)) call abort
68 
  if (any(transpose(x) /= 0)) call abort
69 
  if (any(transpose(y) /= 0)) call abort
70 
  deallocate(foo,bar,x,y)
71 
end
72 
 
73 
subroutine test_reshape
74 
  character(len=1) :: tempn(1,2)
75 
  character(len=1),allocatable :: foo(:,:), bar(:,:)
76 
  integer :: tempm(1,2)
77 
  integer,allocatable :: x(:,:), y(:,:)
78 
  tempn = 'b'
79 
  tempm = -42
80 
  allocate(foo(3,0),bar(-2:-4,7:9),x(3,0),y(-2:-4,7:9))
81 
 
82 
  if (size(reshape(tempn(-7:-8,:),(/3,3/),pad=(/'a'/))) /= 9 .or. &
83 
      any(reshape(tempn(-7:-8,:),(/3,3/),pad=(/'a'/)) /= 'a')) call abort
84 
  if (size(reshape(tempn(-7:-8,:),(/3,3,3/),pad=(/'a'/))) /= 27 .or. &
85 
      any(reshape(tempn(-7:-8,:),(/3,3,3/),pad=(/'a'/)) /= 'a')) call abort
86 
  if (size(reshape(tempn(-7:-8,:),(/3,3,3,3,3,3,3/),pad=(/'a'/))) /= 2187 .or. &
87 
      any(reshape(tempn(-7:-8,:),(/3,3,3,3,3,3,3/),pad=(/'a'/)) /= 'a')) call abort
88 
  if (size(reshape(foo,(/3,3/),pad=(/'a'/))) /= 9 .or. &
89 
      any(reshape(foo,(/3,3/),pad=(/'a'/)) /= 'a')) call abort
90 
  if (size(reshape(foo,(/3,3,3/),pad=(/'a'/))) /= 27 .or. &
91 
      any(reshape(foo,(/3,3,3/),pad=(/'a'/)) /= 'a')) call abort
92 
  if (size(reshape(foo,(/3,3,3,3,3,3,3/),pad=(/'a'/))) /= 2187 .or. &
93 
      any(reshape(foo,(/3,3,3,3,3,3,3/),pad=(/'a'/)) /= 'a')) call abort
94 
  if (size(reshape(bar,(/3,3/),pad=(/'a'/))) /= 9 .or. &
95 
      any(reshape(bar,(/3,3/),pad=(/'a'/)) /= 'a')) call abort
96 
  if (size(reshape(bar,(/3,3,3/),pad=(/'a'/))) /= 27 .or. &
97 
      any(reshape(bar,(/3,3,3/),pad=(/'a'/)) /= 'a')) call abort
98 
  if (size(reshape(bar,(/3,3,3,3,3,3,3/),pad=(/'a'/))) /= 2187 .or. &
99 
      any(reshape(bar,(/3,3,3,3,3,3,3/),pad=(/'a'/)) /= 'a')) call abort
100 
 
101 
  if (size(reshape(tempm(-7:-8,:),(/3,3/),pad=(/7/))) /= 9 .or. &
102 
      any(reshape(tempm(-7:-8,:),(/3,3/),pad=(/7/)) /= 7)) call abort
103 
  if (size(reshape(tempm(-7:-8,:),(/3,3,3/),pad=(/7/))) /= 27 .or. &
104 
      any(reshape(tempm(-7:-8,:),(/3,3,3/),pad=(/7/)) /= 7)) call abort
105 
  if (size(reshape(tempm(-7:-8,:),(/3,3,3,3,3,3,3/),pad=(/7/))) /= 2187 .or. &
106 
      any(reshape(tempm(-7:-8,:),(/3,3,3,3,3,3,3/),pad=(/7/)) /= 7)) call abort
107 
  if (size(reshape(x,(/3,3/),pad=(/7/))) /= 9 .or. &
108 
      any(reshape(x,(/3,3/),pad=(/7/)) /= 7)) call abort
109 
  if (size(reshape(x,(/3,3,3/),pad=(/7/))) /= 27 .or. &
110 
      any(reshape(x,(/3,3,3/),pad=(/7/)) /= 7)) call abort
111 
  if (size(reshape(x,(/3,3,3,3,3,3,3/),pad=(/7/))) /= 2187 .or. &
112 
      any(reshape(x,(/3,3,3,3,3,3,3/),pad=(/7/)) /= 7)) call abort
113 
  if (size(reshape(y,(/3,3/),pad=(/7/))) /= 9 .or. &
114 
      any(reshape(y,(/3,3/),pad=(/7/)) /= 7)) call abort
115 
  if (size(reshape(y,(/3,3,3/),pad=(/7/))) /= 27 .or. &
116 
      any(reshape(y,(/3,3,3/),pad=(/7/)) /= 7)) call abort
117 
  if (size(reshape(y,(/3,3,3,3,3,3,3/),pad=(/7/))) /= 2187 .or. &
118 
      any(reshape(y,(/3,3,3,3,3,3,3/),pad=(/7/)) /= 7)) call abort
119 
 
120 
  deallocate(foo,bar,x,y)
121 
end
122 
 
123 
subroutine test_pack
124 
  integer :: tempn(1,5)
125 
  integer,allocatable :: foo(:,:)
126 
  tempn = 2
127 
  allocate(foo(0,1:7))
128 
  if (size(pack(foo,foo/=0)) /= 0 .or. any(pack(foo,foo/=0) /= -42)) call abort
129 
  if (size(pack(foo,foo/=0,(/1,3,4,5,1,0,7,9/))) /= 8 .or. &
130 
      sum(pack(foo,foo/=0,(/1,3,4,5,1,0,7,9/))) /= 30) call abort
131 
  if (size(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0)) /= 0 .or. &
132 
      any(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0) /= -42)) call abort
133 
  if (size(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0,(/1,3,4,5,1,0,7,9/))) /= 8 .or. &
134 
      sum(pack(tempn(:,-4:-5),tempn(:,-4:-5)/=0,(/1,3,4,5,1,0,7,9/))) /= 30) &
135 
    call abort
136 
  if (size(pack(foo,.true.)) /= 0 .or. any(pack(foo,.true.) /= -42)) &
137 
    call abort
138 
  if (size(pack(foo,.true.,(/1,3,4,5,1,0,7,9/))) /= 8 .or. &
139 
      sum(pack(foo,.true.,(/1,3,4,5,1,0,7,9/))) /= 30) call abort
140 
  if (size(pack(tempn(:,-4:-5),.true.)) /= 0 .or. &
141 
      any(pack(foo,.true.) /= -42)) call abort
142 
  if (size(pack(tempn(:,-4:-5),.true.,(/1,3,4,5,1,0,7,9/))) /= 8 .or. &
143 
      sum(pack(tempn(:,-4:-5),.true.,(/1,3,4,5,1,0,7,9/))) /= 30) call abort
144 
  deallocate(foo)
145 
end
146 
 
147 
subroutine test_unpack
148 
  integer :: tempn(1,5), tempv(5)
149 
  integer,allocatable :: foo(:,:), bar(:)
150 
  integer :: zero
151 
  tempn = 2
152 
  tempv = 5
153 
  zero = 0
154 
  allocate(foo(0,1:7),bar(0:-1))
155 
  if (any(unpack(tempv,tempv/=0,tempv) /= 5) .or. &
156 
      size(unpack(tempv,tempv/=0,tempv)) /= 5) call abort
157 
  if (any(unpack(tempv(1:0),tempv/=0,tempv) /= 5) .or. &
158 
      size(unpack(tempv(1:0),tempv/=0,tempv)) /= 5) call abort
159 
  if (any(unpack(tempv,tempv(1:zero)/=0,tempv) /= -47)) call abort
160 
  if (any(unpack(tempv(5:4),tempv(1:zero)/=0,tempv) /= -47)) call abort
161 
  if (any(unpack(bar,foo==foo,foo) /= -47)) call abort
162 
  deallocate(foo,bar)
163 
end
164 
 
165 
subroutine test_spread
166 
  real :: tempn(1)
167 
  real,allocatable :: foo(:)
168 
  tempn = 2.0
169 
  allocate(foo(0))
170 
  if (any(spread(1,dim=1,ncopies=0) /= -17.0) .or. &
171 
      size(spread(1,dim=1,ncopies=0)) /= 0) call abort
172 
  if (any(spread(foo,dim=1,ncopies=1) /= -17.0) .or. &
173 
      size(spread(foo,dim=1,ncopies=1)) /= 0) call abort
174 
  if (any(spread(tempn(2:1),dim=1,ncopies=1) /= -17.0) .or. &
175 
      size(spread(tempn(2:1),dim=1,ncopies=1)) /= 0) call abort
176 
  deallocate(foo)
177 
end
178 
 
179 
program test
180 
  call test_cshift
181 
  call test_eoshift
182 
  call test_transpose
183 
  call test_unpack
184 
  call test_spread
185 
  call test_pack
186 
  call test_reshape
187 
end

powered by: WebSVN 2.1.0

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