t/op/array_base.t

   1 #!perl -w
   2 use strict;
   3
   4 require './test.pl';
   5
   6 plan (tests => 24);
   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 }
  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 }