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 694

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.