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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [zero_sized_1.f90] - Blame information for rev 154

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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