16 my ($class,@val) = @_;
17 return bless \@val,$class;
24 return $#{$ob} = $sz-1;
37 return scalar(@{$_[0]});
50 my ($ob,$id,$val) = @_;
97 my $off = @_ ? shift : 0;
98 my $len = @_ ? shift : @$ob-1;
99 return splice(@$ob,$off,$len,@_);
109 { my $ob = tie @ary,'Implement',3,2,1;
110 print "not " unless $ob;
111 print "ok ", $test++,"\n";
112 print "not " unless tied(@ary) == $ob;
113 print "ok ", $test++,"\n";
117 print "not " unless @ary == 3;
118 print "ok ", $test++,"\n";
120 print "not " unless $#ary == 2;
121 print "ok ", $test++,"\n";
123 print "not " unless join(':',@ary) eq '3:2:1';
124 print "ok ", $test++,"\n";
126 print "not " unless $seen{'FETCH'} >= 3;
127 print "ok ", $test++,"\n";
131 print "not " unless $seen{'STORE'} >= 3;
132 print "ok ", $test++,"\n";
133 print "not " unless join(':',@ary) eq '1:2:3';
134 print "ok ", $test++,"\n";
137 print "not " unless join(':',@thing) eq '1:2:3';
138 print "ok ", $test++,"\n";
140 tie @thing,'Implement';
142 print "not " unless join(':',@thing) eq '1:2:3';
143 print "ok ", $test++,"\n";
146 print "not " unless pop(@ary) == 3;
147 print "ok ", $test++,"\n";
148 print "not " unless $seen{'POP'} == 1;
149 print "ok ", $test++,"\n";
150 print "not " unless join(':',@ary) eq '1:2';
151 print "ok ", $test++,"\n";
154 print "not " unless $seen{'PUSH'} == 1;
155 print "ok ", $test++,"\n";
156 print "not " unless join(':',@ary) eq '1:2:4';
157 print "ok ", $test++,"\n";
159 my @x = splice(@ary,1,1,7);
162 print "not " unless $seen{'SPLICE'} == 1;
163 print "ok ", $test++,"\n";
165 print "not " unless @x == 1;
166 print "ok ", $test++,"\n";
167 print "not " unless $x[0] == 2;
168 print "ok ", $test++,"\n";
169 print "not " unless join(':',@ary) eq '1:7:4';
170 print "ok ", $test++,"\n";
172 print "not " unless shift(@ary) == 1;
173 print "ok ", $test++,"\n";
174 print "not " unless $seen{'SHIFT'} == 1;
175 print "ok ", $test++,"\n";
176 print "not " unless join(':',@ary) eq '7:4';
177 print "ok ", $test++,"\n";
179 my $n = unshift(@ary,5,6);
180 print "not " unless $seen{'UNSHIFT'} == 1;
181 print "ok ", $test++,"\n";
182 print "not " unless $n == 4;
183 print "ok ", $test++,"\n";
184 print "not " unless join(':',@ary) eq '5:6:7:4';
185 print "ok ", $test++,"\n";
187 @ary = split(/:/,'1:2:3');
188 print "not " unless join(':',@ary) eq '1:2:3';
189 print "ok ", $test++,"\n";
195 print "not " unless $n == ++$t;
196 print "ok ", $test++,"\n";
199 # (30-33) 20020303 mjd-perl-patch+@plover.com
202 pop @ary; # this didn't used to call POP at all
203 print "not " unless $seen{POP} == 1;
204 print "ok ", $test++,"\n";
206 shift @ary; # this didn't used to call SHIFT at all
207 print "not " unless $seen{SHIFT} == 1;
208 print "ok ", $test++,"\n";
210 push @ary; # this didn't used to call PUSH at all
211 print "not " unless $seen{PUSH} == 1;
212 print "ok ", $test++,"\n";
214 unshift @ary; # this didn't used to call UNSHIFT at all
215 print "not " unless $seen{UNSHIFT} == 1;
216 print "ok ", $test++,"\n";
219 print "not " unless join(':',@ary) eq '3:2:1';
220 print "ok ", $test++,"\n";
226 # 20020401 mjd-perl-patch+@plover.com
227 # Thanks to Dave Mitchell for the small test case
231 sub X::TIEARRAY { bless {}, 'X' }
240 # If we survived this far.
241 print "ok ", $test++, "\n";
244 print "not " unless $seen{'DESTROY'} == 2;
245 print "ok ", $test++,"\n";