1! { dg-do run }
2! Transformational functions for zero-sized array and array sections
3! Contributed by Francois-Xavier Coudert  <coudert@clipper.ens.fr>
4
5subroutine 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)
19end
20
21subroutine 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)
51end
52
53subroutine 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)
71end
72
73subroutine 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)
121end
122
123subroutine 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)
145end
146
147subroutine 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)
163end
164
165subroutine 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)
177end
178
179program 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
187end
188