Commit | Line | Data |
---|---|---|
a687059c LW |
1 | #!./perl |
2 | ||
6b42d12b DM |
3 | BEGIN { |
4 | chdir 't' if -d 't'; | |
404a4710 | 5 | @INC = ('.', '../lib'); |
1ae3d757 | 6 | require './test.pl'; |
6b42d12b DM |
7 | } |
8 | ||
a5f48505 | 9 | plan (173); |
a687059c | 10 | |
05fc92f1 GS |
11 | # |
12 | # @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them | |
13 | # | |
14 | ||
a687059c | 15 | @ary = (1,2,3,4,5); |
0dd3f902 | 16 | is(join('',@ary), '12345'); |
a687059c LW |
17 | |
18 | $tmp = $ary[$#ary]; --$#ary; | |
0dd3f902 NC |
19 | is($tmp, 5); |
20 | is($#ary, 3); | |
21 | is(join('',@ary), '1234'); | |
a687059c | 22 | |
a687059c LW |
23 | @foo = (); |
24 | $r = join(',', $#foo, @foo); | |
0dd3f902 | 25 | is($r, "-1"); |
a687059c LW |
26 | $foo[0] = '0'; |
27 | $r = join(',', $#foo, @foo); | |
0dd3f902 | 28 | is($r, "0,0"); |
a687059c LW |
29 | $foo[2] = '2'; |
30 | $r = join(',', $#foo, @foo); | |
0dd3f902 | 31 | is($r, "2,0,,2"); |
a687059c LW |
32 | @bar = (); |
33 | $bar[0] = '0'; | |
34 | $bar[1] = '1'; | |
35 | $r = join(',', $#bar, @bar); | |
0dd3f902 | 36 | is($r, "1,0,1"); |
a687059c LW |
37 | @bar = (); |
38 | $r = join(',', $#bar, @bar); | |
0dd3f902 | 39 | is($r, "-1"); |
a687059c LW |
40 | $bar[0] = '0'; |
41 | $r = join(',', $#bar, @bar); | |
0dd3f902 | 42 | is($r, "0,0"); |
a687059c LW |
43 | $bar[2] = '2'; |
44 | $r = join(',', $#bar, @bar); | |
0dd3f902 | 45 | is($r, "2,0,,2"); |
14ce8c55 | 46 | reset 'b' if $^O ne 'VMS'; |
a687059c LW |
47 | @bar = (); |
48 | $bar[0] = '0'; | |
49 | $r = join(',', $#bar, @bar); | |
0dd3f902 | 50 | is($r, "0,0"); |
a687059c LW |
51 | $bar[2] = '2'; |
52 | $r = join(',', $#bar, @bar); | |
0dd3f902 | 53 | is($r, "2,0,,2"); |
a687059c LW |
54 | |
55 | $foo = 'now is the time'; | |
0dd3f902 NC |
56 | ok(scalar (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/))); |
57 | is($F1, 'now'); | |
58 | is($F2, 'is'); | |
59 | is($Etc, 'the time'); | |
a687059c LW |
60 | |
61 | $foo = 'lskjdf'; | |
0dd3f902 NC |
62 | ok(!($cnt = (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/)))) |
63 | or diag("$cnt $F1:$F2:$Etc"); | |
a687059c LW |
64 | |
65 | %foo = ('blurfl','dyick','foo','bar','etc.','etc.'); | |
66 | %bar = %foo; | |
0dd3f902 | 67 | is($bar{'foo'}, 'bar'); |
a687059c | 68 | %bar = (); |
0dd3f902 | 69 | is($bar{'foo'}, undef); |
a687059c | 70 | (%bar,$a,$b) = (%foo,'how','now'); |
0dd3f902 NC |
71 | is($bar{'foo'}, 'bar'); |
72 | is($bar{'how'}, 'now'); | |
a687059c | 73 | @bar{keys %foo} = values %foo; |
0dd3f902 NC |
74 | is($bar{'foo'}, 'bar'); |
75 | is($bar{'how'}, 'now'); | |
a687059c LW |
76 | |
77 | @foo = grep(/e/,split(' ','now is the time for all good men to come to')); | |
0dd3f902 | 78 | is(join(' ',@foo), 'the time men come'); |
a687059c LW |
79 | |
80 | @foo = grep(!/e/,split(' ','now is the time for all good men to come to')); | |
0dd3f902 | 81 | is(join(' ',@foo), 'now is for all good to to'); |
79a0689e LW |
82 | |
83 | $foo = join('',('a','b','c','d','e','f')[0..5]); | |
0dd3f902 | 84 | is($foo, 'abcdef'); |
79a0689e LW |
85 | |
86 | $foo = join('',('a','b','c','d','e','f')[0..1]); | |
0dd3f902 | 87 | is($foo, 'ab'); |
79a0689e LW |
88 | |
89 | $foo = join('',('a','b','c','d','e','f')[6]); | |
0dd3f902 | 90 | is($foo, ''); |
79a0689e LW |
91 | |
92 | @foo = ('a','b','c','d','e','f')[0,2,4]; | |
93 | @bar = ('a','b','c','d','e','f')[1,3,5]; | |
94 | $foo = join('',(@foo,@bar)[0..5]); | |
0dd3f902 | 95 | is($foo, 'acebdf'); |
79a0689e LW |
96 | |
97 | $foo = ('a','b','c','d','e','f')[0,2,4]; | |
0dd3f902 | 98 | is($foo, 'e'); |
79a0689e LW |
99 | |
100 | $foo = ('a','b','c','d','e','f')[1]; | |
0dd3f902 | 101 | is($foo, 'b'); |
a0231f0e | 102 | |
b5adc3e5 | 103 | @foo = ( 'foo', 'bar', 'burbl', 'blah'); |
b3381831 GS |
104 | |
105 | # various AASSIGN_COMMON checks (see newASSIGNOP() in op.c) | |
106 | ||
b5adc3e5 | 107 | #curr_test(37); |
b3381831 GS |
108 | |
109 | @foo = @foo; | |
b5adc3e5 | 110 | is("@foo", "foo bar burbl blah"); # 37 |
b3381831 GS |
111 | |
112 | (undef,@foo) = @foo; | |
b5adc3e5 | 113 | is("@foo", "bar burbl blah"); # 38 |
b3381831 GS |
114 | |
115 | @foo = ('XXX',@foo, 'YYY'); | |
b5adc3e5 | 116 | is("@foo", "XXX bar burbl blah YYY"); # 39 |
b3381831 | 117 | |
3201ebbd | 118 | @foo = @foo = qw(foo b\a\r bu\\rbl blah); |
b5adc3e5 | 119 | is("@foo", 'foo b\a\r bu\\rbl blah'); # 40 |
b3381831 | 120 | |
b5adc3e5 | 121 | @bar = @foo = qw(foo bar); # 41 |
0dd3f902 | 122 | is("@foo", "foo bar"); |
b5adc3e5 | 123 | is("@bar", "foo bar"); # 42 |
b3381831 GS |
124 | |
125 | # try the same with local | |
05fc92f1 GS |
126 | # XXX tie-stdarray fails the tests involving local, so we use |
127 | # different variable names to escape the 'tie' | |
128 | ||
129 | @bee = ( 'foo', 'bar', 'burbl', 'blah'); | |
b3381831 GS |
130 | { |
131 | ||
05fc92f1 | 132 | local @bee = @bee; |
b5adc3e5 | 133 | is("@bee", "foo bar burbl blah"); # 43 |
b3381831 | 134 | { |
05fc92f1 | 135 | local (undef,@bee) = @bee; |
b5adc3e5 | 136 | is("@bee", "bar burbl blah"); # 44 |
b3381831 | 137 | { |
05fc92f1 | 138 | local @bee = ('XXX',@bee,'YYY'); |
b5adc3e5 | 139 | is("@bee", "XXX bar burbl blah YYY"); # 45 |
b3381831 | 140 | { |
05fc92f1 | 141 | local @bee = local(@bee) = qw(foo bar burbl blah); |
b5adc3e5 | 142 | is("@bee", "foo bar burbl blah"); # 46 |
b3381831 | 143 | { |
05fc92f1 | 144 | local (@bim) = local(@bee) = qw(foo bar); |
b5adc3e5 DIM |
145 | is("@bee", "foo bar"); # 47 |
146 | is("@bim", "foo bar"); # 48 | |
b3381831 | 147 | } |
b5adc3e5 | 148 | is("@bee", "foo bar burbl blah"); # 49 |
b3381831 | 149 | } |
b5adc3e5 | 150 | is("@bee", "XXX bar burbl blah YYY"); # 50 |
b3381831 | 151 | } |
b5adc3e5 | 152 | is("@bee", "bar burbl blah"); # 51 |
b3381831 | 153 | } |
b5adc3e5 | 154 | is("@bee", "foo bar burbl blah"); # 52 |
b3381831 GS |
155 | } |
156 | ||
157 | # try the same with my | |
158 | { | |
05fc92f1 | 159 | my @bee = @bee; |
b5adc3e5 | 160 | is("@bee", "foo bar burbl blah"); # 53 |
b3381831 | 161 | { |
05fc92f1 | 162 | my (undef,@bee) = @bee; |
b5adc3e5 | 163 | is("@bee", "bar burbl blah"); # 54 |
b3381831 | 164 | { |
05fc92f1 | 165 | my @bee = ('XXX',@bee,'YYY'); |
b5adc3e5 | 166 | is("@bee", "XXX bar burbl blah YYY"); # 55 |
b3381831 | 167 | { |
05fc92f1 | 168 | my @bee = my @bee = qw(foo bar burbl blah); |
b5adc3e5 | 169 | is("@bee", "foo bar burbl blah"); # 56 |
b3381831 | 170 | { |
05fc92f1 | 171 | my (@bim) = my(@bee) = qw(foo bar); |
b5adc3e5 DIM |
172 | is("@bee", "foo bar"); # 57 |
173 | is("@bim", "foo bar"); # 58 | |
b3381831 | 174 | } |
b5adc3e5 | 175 | is("@bee", "foo bar burbl blah"); # 59 |
b3381831 | 176 | } |
b5adc3e5 | 177 | is("@bee", "XXX bar burbl blah YYY"); # 60 |
b3381831 | 178 | } |
b5adc3e5 | 179 | is("@bee", "bar burbl blah"); # 61 |
b3381831 | 180 | } |
b5adc3e5 | 181 | is("@bee", "foo bar burbl blah"); # 62 |
b3381831 GS |
182 | } |
183 | ||
f17e6c41 RGS |
184 | # try the same with our (except that previous values aren't restored) |
185 | { | |
186 | our @bee = @bee; | |
187 | is("@bee", "foo bar burbl blah"); | |
188 | { | |
189 | our (undef,@bee) = @bee; | |
190 | is("@bee", "bar burbl blah"); | |
191 | { | |
192 | our @bee = ('XXX',@bee,'YYY'); | |
193 | is("@bee", "XXX bar burbl blah YYY"); | |
194 | { | |
195 | our @bee = our @bee = qw(foo bar burbl blah); | |
196 | is("@bee", "foo bar burbl blah"); | |
197 | { | |
198 | our (@bim) = our(@bee) = qw(foo bar); | |
199 | is("@bee", "foo bar"); | |
200 | is("@bim", "foo bar"); | |
201 | } | |
202 | } | |
203 | } | |
204 | } | |
205 | } | |
206 | ||
352edd90 | 207 | # make sure reification behaves |
0dd3f902 NC |
208 | my $t = curr_test(); |
209 | sub reify { $_[1] = $t++; print "@_\n"; } | |
352edd90 GS |
210 | reify('ok'); |
211 | reify('ok'); | |
9d001be8 | 212 | |
0dd3f902 | 213 | curr_test($t); |
7517970f | 214 | |
0dd3f902 NC |
215 | # qw() is no longer a runtime split, it's compiletime. |
216 | is (qw(foo bar snorfle)[2], 'snorfle'); | |
7517970f | 217 | |
0dd3f902 | 218 | @ary = (12,23,34,45,56); |
7517970f | 219 | |
0dd3f902 NC |
220 | is(shift(@ary), 12); |
221 | is(pop(@ary), 56); | |
222 | is(push(@ary,56), 4); | |
223 | is(unshift(@ary,12), 5); | |
4c8f17b9 BH |
224 | |
225 | sub foo { "a" } | |
226 | @foo=(foo())[0,0]; | |
0dd3f902 | 227 | is ($foo[1], "a"); |
b0840a2a | 228 | |
6b42d12b DM |
229 | # bugid #15439 - clearing an array calls destructors which may try |
230 | # to modify the array - caused 'Attempt to free unreferenced scalar' | |
231 | ||
232 | my $got = runperl ( | |
233 | prog => q{ | |
234 | sub X::DESTROY { @a = () } | |
3d7a9343 | 235 | @a = (bless {}, q{X}); |
6b42d12b DM |
236 | @a = (); |
237 | }, | |
238 | stderr => 1 | |
239 | ); | |
240 | ||
241 | $got =~ s/\n/ /g; | |
0dd3f902 | 242 | is ($got, ''); |
2b573ace JH |
243 | |
244 | # Test negative and funky indices. | |
245 | ||
0dd3f902 | 246 | |
2b573ace JH |
247 | { |
248 | my @a = 0..4; | |
0dd3f902 NC |
249 | is($a[-1], 4); |
250 | is($a[-2], 3); | |
251 | is($a[-5], 0); | |
252 | ok(!defined $a[-6]); | |
253 | ||
254 | is($a[2.1] , 2); | |
255 | is($a[2.9] , 2); | |
256 | is($a[undef], 0); | |
257 | is($a["3rd"], 3); | |
2b573ace JH |
258 | } |
259 | ||
2b573ace JH |
260 | |
261 | { | |
262 | my @a; | |
263 | eval '$a[-1] = 0'; | |
0dd3f902 | 264 | like($@, qr/Modification of non-creatable array value attempted, subscript -1/, "\$a[-1] = 0"); |
2b573ace | 265 | } |
0dd3f902 | 266 | |
1b20cd17 NC |
267 | sub test_arylen { |
268 | my $ref = shift; | |
83bf042f | 269 | local $^W = 1; |
1b20cd17 | 270 | is ($$ref, undef, "\$# on freed array is undef"); |
83bf042f NC |
271 | my @warn; |
272 | local $SIG{__WARN__} = sub {push @warn, "@_"}; | |
1b20cd17 | 273 | $$ref = 1000; |
83bf042f NC |
274 | is (scalar @warn, 1); |
275 | like ($warn[0], qr/^Attempt to set length of freed array/); | |
276 | } | |
1b20cd17 NC |
277 | |
278 | { | |
279 | my $a = \$#{[]}; | |
280 | # Need a new statement to make it go out of scope | |
281 | test_arylen ($a); | |
282 | test_arylen (do {my @a; \$#a}); | |
283 | } | |
404a4710 NC |
284 | |
285 | { | |
286 | use vars '@array'; | |
287 | ||
288 | my $outer = \$#array; | |
289 | is ($$outer, -1); | |
290 | is (scalar @array, 0); | |
291 | ||
292 | $$outer = 3; | |
293 | is ($$outer, 3); | |
294 | is (scalar @array, 4); | |
295 | ||
296 | my $ref = \@array; | |
297 | ||
404a4710 NC |
298 | my $inner; |
299 | { | |
300 | local @array; | |
301 | $inner = \$#array; | |
302 | ||
303 | is ($$inner, -1); | |
304 | is (scalar @array, 0); | |
305 | $$outer = 6; | |
306 | ||
307 | is (scalar @$ref, 7); | |
308 | ||
309 | is ($$inner, -1); | |
310 | is (scalar @array, 0); | |
311 | ||
312 | $$inner = 42; | |
313 | } | |
314 | ||
315 | is (scalar @array, 7); | |
316 | is ($$outer, 6); | |
317 | ||
2fc04a10 | 318 | is ($$inner, undef, "orphaned $#foo is always undef"); |
404a4710 NC |
319 | |
320 | is (scalar @array, 7); | |
321 | is ($$outer, 6); | |
322 | ||
323 | $$inner = 1; | |
324 | ||
325 | is (scalar @array, 7); | |
326 | is ($$outer, 6); | |
327 | ||
328 | $$inner = 503; # Bang! | |
329 | ||
330 | is (scalar @array, 7); | |
331 | is ($$outer, 6); | |
332 | } | |
333 | ||
334 | { | |
335 | # Bug #36211 | |
336 | use vars '@array'; | |
337 | for (1,2) { | |
338 | { | |
339 | local @a; | |
340 | is ($#a, -1); | |
341 | @a=(1..4) | |
342 | } | |
343 | } | |
344 | } | |
345 | ||
e4c5ccf3 RH |
346 | { |
347 | # Bug #37350 | |
348 | my @array = (1..4); | |
349 | $#{@array} = 7; | |
350 | is ($#{4}, 7); | |
351 | ||
352 | my $x; | |
353 | $#{$x} = 3; | |
354 | is(scalar @$x, 4); | |
355 | ||
356 | push @{@array}, 23; | |
357 | is ($4[8], 23); | |
358 | } | |
359 | { | |
360 | # Bug #37350 -- once more with a global | |
361 | use vars '@array'; | |
362 | @array = (1..4); | |
363 | $#{@array} = 7; | |
364 | is ($#{4}, 7); | |
365 | ||
366 | my $x; | |
367 | $#{$x} = 3; | |
368 | is(scalar @$x, 4); | |
369 | ||
370 | push @{@array}, 23; | |
371 | is ($4[8], 23); | |
372 | } | |
373 | ||
f17e6c41 RGS |
374 | # more tests for AASSIGN_COMMON |
375 | ||
376 | { | |
377 | our($x,$y,$z) = (1..3); | |
378 | our($y,$z) = ($x,$y); | |
379 | is("$x $y $z", "1 1 2"); | |
380 | } | |
381 | { | |
382 | our($x,$y,$z) = (1..3); | |
383 | (our $y, our $z) = ($x,$y); | |
384 | is("$x $y $z", "1 1 2"); | |
385 | } | |
8d38d4f3 | 386 | { |
3023b5f3 | 387 | # AASSIGN_COMMON detection with logical operators |
8d38d4f3 GG |
388 | my $true = 1; |
389 | our($x,$y,$z) = (1..3); | |
390 | (our $y, our $z) = $true && ($x,$y); | |
391 | is("$x $y $z", "1 1 2"); | |
392 | } | |
f17e6c41 | 393 | |
0f907b96 FC |
394 | # [perl #70171] |
395 | { | |
396 | my $x = get_x(); my %x = %$x; sub get_x { %x=(1..4); return \%x }; | |
397 | is( | |
398 | join(" ", map +($_,$x{$_}), sort keys %x), "1 2 3 4", | |
399 | 'bug 70171 (self-assignment via my %x = %$x)' | |
400 | ); | |
401 | my $y = get_y(); my @y = @$y; sub get_y { @y=(1..4); return \@y }; | |
402 | is( | |
403 | "@y", "1 2 3 4", | |
404 | 'bug 70171 (self-assignment via my @x = @$x)' | |
405 | ); | |
406 | } | |
407 | ||
ade1ceae DM |
408 | # [perl #70171], [perl #82110] |
409 | { | |
410 | my ($i, $ra, $rh); | |
411 | again: | |
412 | my @a = @$ra; # common assignment on 2nd attempt | |
413 | my %h = %$rh; # common assignment on 2nd attempt | |
414 | @a = qw(1 2 3 4); | |
415 | %h = qw(a 1 b 2 c 3 d 4); | |
416 | $ra = \@a; | |
417 | $rh = \%h; | |
418 | goto again unless $i++; | |
419 | ||
420 | is("@a", "1 2 3 4", | |
421 | 'bug 70171 (self-assignment via my @x = @$x) - goto variant' | |
422 | ); | |
423 | is( | |
424 | join(" ", map +($_,$h{$_}), sort keys %h), "a 1 b 2 c 3 d 4", | |
425 | 'bug 70171 (self-assignment via my %x = %$x) - goto variant' | |
426 | ); | |
427 | } | |
428 | ||
429 | ||
8f878375 FC |
430 | *trit = *scile; $trit[0]; |
431 | ok(1, 'aelem_fast on a nonexistent array does not crash'); | |
f17e6c41 | 432 | |
9f71cfe6 FC |
433 | # [perl #107440] |
434 | sub A::DESTROY { $::ra = 0 } | |
435 | $::ra = [ bless [], 'A' ]; | |
436 | undef @$::ra; | |
437 | pass 'no crash when freeing array that is being undeffed'; | |
438 | $::ra = [ bless [], 'A' ]; | |
439 | @$::ra = ('a'..'z'); | |
440 | pass 'no crash when freeing array that is being cleared'; | |
441 | ||
70ce9249 FC |
442 | # [perl #85670] Copying magic to elements |
443 | SKIP: { | |
444 | skip "no Scalar::Util::weaken on miniperl", 1, if is_miniperl; | |
445 | require Scalar::Util; | |
446 | package glelp { | |
447 | Scalar::Util::weaken ($a = \@ISA); | |
448 | @ISA = qw(Foo); | |
449 | Scalar::Util::weaken ($a = \$ISA[0]); | |
450 | ::is @ISA, 1, 'backref magic is not copied to elements'; | |
451 | } | |
452 | } | |
453 | package peen { | |
454 | $#ISA = -1; | |
455 | @ISA = qw(Foo); | |
456 | $ISA[0] = qw(Sphare); | |
457 | ||
458 | sub Sphare::pling { 'pling' } | |
459 | ||
460 | ::is eval { pling peen }, 'pling', | |
461 | 'arylen_p magic does not stop isa magic from being copied'; | |
462 | } | |
463 | ||
97568419 FC |
464 | # Test that &PL_sv_undef is not special in arrays |
465 | sub { | |
466 | ok exists $_[0], | |
467 | 'exists returns true for &PL_sv_undef elem [perl #7508]'; | |
468 | is \$_[0], \undef, 'undef preserves identity in array [perl #109726]'; | |
469 | }->(undef); | |
428ccf1e FC |
470 | # and that padav also knows how to handle the resulting NULLs |
471 | @_ = sub { my @a; $a[1]=1; @a }->(); | |
472 | is join (" ", map $_//"undef", @_), "undef 1", | |
473 | 'returning my @a with nonexistent elements'; | |
97568419 | 474 | |
bbfdc870 FC |
475 | # [perl #118691] |
476 | @plink=@plunk=(); | |
477 | $plink[3] = 1; | |
478 | sub { | |
479 | $_[0] = 2; | |
480 | is $plink[0], 2, '@_ alias to nonexistent elem within array'; | |
481 | $_[1] = 3; | |
482 | is $plink[1], 3, '@_ alias to nonexistent neg index within array'; | |
483 | is $_[2], undef, 'reading alias to negative index past beginning'; | |
484 | eval { $_[2] = 42 }; | |
485 | like $@, qr/Modification of non-creatable array value attempted, (?x: | |
486 | )subscript -5/, | |
487 | 'error when setting alias to negative index past beginning'; | |
488 | is $_[3], undef, 'reading alias to -1 elem of empty array'; | |
489 | eval { $_[3] = 42 }; | |
490 | like $@, qr/Modification of non-creatable array value attempted, (?x: | |
491 | )subscript -1/, | |
492 | 'error when setting alias to -1 elem of empty array'; | |
493 | }->($plink[0], $plink[-2], $plink[-5], $plunk[-1]); | |
494 | ||
d4a823b3 FC |
495 | $_ = \$#{[]}; |
496 | $$_ = \1; | |
497 | "$$_"; | |
498 | pass "no assertion failure after assigning ref to arylen when ary is gone"; | |
70ce9249 | 499 | |
b024352e DM |
500 | |
501 | { | |
502 | # Test aelemfast for both +ve and -ve indices, both lex and package vars. | |
503 | # Make especially careful that we don't have any edge cases around | |
504 | # fitting an I8 into a U8. | |
505 | my @a = (0..299); | |
506 | is($a[-256], 300-256, 'lex -256'); | |
507 | is($a[-255], 300-255, 'lex -255'); | |
508 | is($a[-254], 300-254, 'lex -254'); | |
509 | is($a[-129], 300-129, 'lex -129'); | |
510 | is($a[-128], 300-128, 'lex -128'); | |
511 | is($a[-127], 300-127, 'lex -127'); | |
512 | is($a[-126], 300-126, 'lex -126'); | |
513 | is($a[ -1], 300- 1, 'lex -1'); | |
514 | is($a[ 0], 0, 'lex 0'); | |
515 | is($a[ 1], 1, 'lex 1'); | |
516 | is($a[ 126], 126, 'lex 126'); | |
517 | is($a[ 127], 127, 'lex 127'); | |
518 | is($a[ 128], 128, 'lex 128'); | |
519 | is($a[ 129], 129, 'lex 129'); | |
520 | is($a[ 254], 254, 'lex 254'); | |
521 | is($a[ 255], 255, 'lex 255'); | |
522 | is($a[ 256], 256, 'lex 256'); | |
523 | @aelem =(0..299); | |
524 | is($aelem[-256], 300-256, 'pkg -256'); | |
525 | is($aelem[-255], 300-255, 'pkg -255'); | |
526 | is($aelem[-254], 300-254, 'pkg -254'); | |
527 | is($aelem[-129], 300-129, 'pkg -129'); | |
528 | is($aelem[-128], 300-128, 'pkg -128'); | |
529 | is($aelem[-127], 300-127, 'pkg -127'); | |
530 | is($aelem[-126], 300-126, 'pkg -126'); | |
531 | is($aelem[ -1], 300- 1, 'pkg -1'); | |
532 | is($aelem[ 0], 0, 'pkg 0'); | |
533 | is($aelem[ 1], 1, 'pkg 1'); | |
534 | is($aelem[ 126], 126, 'pkg 126'); | |
535 | is($aelem[ 127], 127, 'pkg 127'); | |
536 | is($aelem[ 128], 128, 'pkg 128'); | |
537 | is($aelem[ 129], 129, 'pkg 129'); | |
538 | is($aelem[ 254], 254, 'pkg 254'); | |
539 | is($aelem[ 255], 255, 'pkg 255'); | |
540 | is($aelem[ 256], 256, 'pkg 256'); | |
541 | } | |
542 | ||
689d8423 FC |
543 | # Test aelemfast in list assignment |
544 | @ary = ('a','b'); | |
545 | ($ary[0],$ary[1]) = ($ary[1],$ary[0]); | |
546 | is "@ary", 'b a', | |
547 | 'aelemfast with the same array on both sides of list assignment'; | |
548 | ||
569ddb4a FC |
549 | for(scalar $#foo) { $_ = 3 } |
550 | is $#foo, 3, 'assigning to arylen aliased in foreach(scalar $#arylen)'; | |
551 | ||
a5f48505 DM |
552 | { |
553 | my @a = qw(a b c); | |
554 | @a = @a; | |
555 | is "@a", 'a b c', 'assigning to itself'; | |
556 | } | |
557 | ||
94f9945d FC |
558 | sub { undef *_; shift }->(); # This would crash; no ok() necessary. |
559 | sub { undef *_; pop }->(); | |
560 | ||
404a4710 | 561 | "We're included by lib/Tie/Array/std.t so we need to return something true"; |