15 my ($class,@val) = @_;
16 return bless \@val,$class;
50 my ($ob,$id,$val) = @_;
91 my $off = @_ ? shift : 0;
92 my $len = @_ ? shift : @$ob-1;
93 return splice(@$ob,$off,$len,@_);
103 { my $ob = tie @ary,'Implement',3,2,1;
104 print "not " unless $ob;
105 print "ok ", $test++,"\n";
106 print "not " unless tied(@ary) == $ob;
107 print "ok ", $test++,"\n";
111 print "not " unless @ary == 3;
112 print "ok ", $test++,"\n";
114 print "not " unless $#ary == 2;
115 print "ok ", $test++,"\n";
117 print "not " unless join(':',@ary) eq '3:2:1';
118 print "ok ", $test++,"\n";
120 print "not " unless $seen{'FETCH'} >= 3;
121 print "ok ", $test++,"\n";
125 print "not " unless $seen{'STORE'} >= 3;
126 print "ok ", $test++,"\n";
128 print "not " unless join(':',@ary) eq '1:2:3';
129 print "ok ", $test++,"\n";
131 print "not " unless pop(@ary) == 3;
132 print "ok ", $test++,"\n";
133 print "not " unless $seen{'POP'} == 1;
134 print "ok ", $test++,"\n";
135 print "not " unless join(':',@ary) eq '1:2';
136 print "ok ", $test++,"\n";
139 print "not " unless $seen{'PUSH'} == 1;
140 print "ok ", $test++,"\n";
141 print "not " unless join(':',@ary) eq '1:2:4';
142 print "ok ", $test++,"\n";
144 my @x = splice(@ary,1,1,7);
147 print "not " unless $seen{'SPLICE'} == 1;
148 print "ok ", $test++,"\n";
150 print "not " unless @x == 1;
151 print "ok ", $test++,"\n";
152 print "not " unless $x[0] == 2;
153 print "ok ", $test++,"\n";
154 print "not " unless join(':',@ary) eq '1:7:4';
155 print "ok ", $test++,"\n";
159 print "not " unless shift(@ary) == 1;
160 print "ok ", $test++,"\n";
161 print "not " unless $seen{'SHIFT'} == 1;
162 print "ok ", $test++,"\n";
163 print "not " unless join(':',@ary) eq '7:4';
164 print "ok ", $test++,"\n";
168 print "not " unless $seen{'UNSHIFT'} == 1;
169 print "ok ", $test++,"\n";
170 print "not " unless join(':',@ary) eq '5:7:4';
171 print "ok ", $test++,"\n";
173 @ary = split(/:/,'1:2:3');
174 print "not " unless join(':',@ary) eq '1:2:3';
175 print "ok ", $test++,"\n";