Commit | Line | Data |
---|---|---|
24d0fc42 NC |
1 | #!perl -w |
2 | use strict; | |
3 | ||
4 | require './test.pl'; | |
5 | ||
a026e652 | 6 | plan (tests => 24); |
24d0fc42 NC |
7 | no warnings 'deprecated'; |
8 | ||
9 | # Bug #27024 | |
10 | { | |
11 | # this used to segfault (because $[=1 is optimized away to a null block) | |
12 | my $x; | |
13 | $[ = 1 while $x; | |
14 | pass('#27204'); | |
15 | $[ = 0; # restore the original value for less side-effects | |
16 | } | |
17 | ||
18 | # [perl #36313] perl -e "1for$[=0" crash | |
19 | { | |
20 | my $x; | |
21 | $x = 1 for ($[) = 0; | |
22 | pass('optimized assignment to $[ used to segfault in list context'); | |
23 | if ($[ = 0) { $x = 1 } | |
24 | pass('optimized assignment to $[ used to segfault in scalar context'); | |
25 | $x = ($[=2.4); | |
26 | is($x, 2, 'scalar assignment to $[ behaves like other variables'); | |
27 | $x = (($[) = 0); | |
28 | is($x, 1, 'list assignment to $[ behaves like other variables'); | |
29 | $x = eval q{ ($[, $x) = (0) }; | |
30 | like($@, qr/That use of \$\[ is unsupported/, | |
31 | 'cannot assign to $[ in a list'); | |
32 | eval q{ ($[) = (0, 1) }; | |
33 | like($@, qr/That use of \$\[ is unsupported/, | |
34 | 'cannot assign list of >1 elements to $['); | |
35 | eval q{ ($[) = () }; | |
36 | like($@, qr/That use of \$\[ is unsupported/, | |
37 | 'cannot assign list of <1 elements to $['); | |
38 | } | |
a026e652 NC |
39 | |
40 | ||
41 | { | |
42 | $[ = 11; | |
43 | cmp_ok($[ + 0, '==', 11, 'setting $[ affects $['); | |
44 | our $t11; BEGIN { $t11 = $^H{'$['} } | |
45 | cmp_ok($t11, '==', 11, 'setting $[ affects $^H{\'$[\'}'); | |
46 | ||
47 | BEGIN { $^H{'$['} = 22 } | |
48 | cmp_ok($[ + 0, '==', 22, 'setting $^H{\'$\'} affects $['); | |
49 | our $t22; BEGIN { $t22 = $^H{'$['} } | |
50 | cmp_ok($t22, '==', 22, 'setting $^H{\'$[\'} affects $^H{\'$[\'}'); | |
51 | ||
52 | BEGIN { %^H = () } | |
53 | my $val = do { | |
54 | no warnings 'uninitialized'; | |
55 | $[; | |
56 | }; | |
57 | cmp_ok($val, '==', 0, 'clearing %^H affects $['); | |
58 | our $t0; BEGIN { $t0 = $^H{'$['} } | |
59 | cmp_ok($t0, '==', 0, 'clearing %^H affects $^H{\'$[\'}'); | |
60 | } | |
61 | ||
62 | { | |
63 | $[ = 13; | |
64 | BEGIN { $^H |= 0x04000000; $^H{foo} = "z"; } | |
65 | ||
66 | our($ri0, $rf0); BEGIN { $ri0 = $^H; $rf0 = $^H{foo}; } | |
67 | cmp_ok($[ + 0, '==', 13, '$[ correct before require'); | |
68 | ok($ri0 & 0x04000000, '$^H correct before require'); | |
69 | is($rf0, "z", '$^H{foo} correct before require'); | |
70 | ||
71 | our($ra1, $ri1, $rf1, $rfe1); | |
72 | BEGIN { require "op/array_base.aux"; } | |
73 | cmp_ok($ra1, '==', 0, '$[ cleared for require'); | |
74 | ok(!($ri1 & 0x04000000), '$^H cleared for require'); | |
75 | is($rf1, undef, '$^H{foo} cleared for require'); | |
76 | ok(!$rfe1, '$^H{foo} cleared for require'); | |
77 | ||
78 | our($ri2, $rf2); BEGIN { $ri2 = $^H; $rf2 = $^H{foo}; } | |
79 | cmp_ok($[ + 0, '==', 13, '$[ correct after require'); | |
80 | ok($ri2 & 0x04000000, '$^H correct after require'); | |
81 | is($rf2, "z", '$^H{foo} correct after require'); | |
82 | } |