t/op/opt.t

   1 #!./perl
   2
   3 # Use B to test that optimisations are not inadvertently removed.
   4
   5 BEGIN {
   6     chdir 't';
   7     require './test.pl';
   8     skip_all_if_miniperl("No B under miniperl");
   9     @INC = '../lib';
  10 }
  11
  12 plan 20;
  13
  14 use B qw 'svref_2object OPpASSIGN_COMMON';
  15
  16
  17 # aassign with no common vars
  18 for ('my ($self) = @_',
  19      'my @x; @y = $x[0]', # aelemfast_lex
  20     )
  21 {
  22     my $sub = eval "sub { $_ }";
  23     my $last_expr =
  24       svref_2object($sub)->ROOT->first->last;
  25     if ($last_expr->name ne 'aassign') {
  26         die "Expected aassign but found ", $last_expr->name,
  27             "; this test needs to be rewritten"
  28     }
  29     is $last_expr->private & OPpASSIGN_COMMON, 0,
  30       "no ASSIGN_COMMON for $_";
  31 }
  32
  33
  34 # join -> stringify/const
  35
  36 for (['CONSTANT', sub {          join "foo", $_ }],
  37      ['$var'    , sub {          join  $_  , $_ }],
  38      ['$myvar'  , sub { my $var; join  $var, $_ }],
  39 ) {
  40     my($sep,$sub) = @$_;
  41     my $last_expr = svref_2object($sub)->ROOT->first->last;
  42     is $last_expr->name, 'stringify',
  43       "join($sep, \$scalar) optimised to stringify";
  44 }
  45
  46 for (['CONSTANT', sub {          join "foo", "bar"    }, 0, "bar"    ],
  47      ['CONSTANT', sub {          join "foo", "bar", 3 }, 1, "barfoo3"],
  48      ['$var'    , sub {          join  $_  , "bar"    }, 0, "bar"    ],
  49      ['$myvar'  , sub { my $var; join  $var, "bar"    }, 0, "bar"    ],
  50 ) {
  51     my($sep,$sub,$is_list,$expect) = @$_;
  52     my $last_expr = svref_2object($sub)->ROOT->first->last;
  53     my $tn = "join($sep, " . ($is_list?'list of constants':'const') . ")";
  54     is $last_expr->name, 'const', "$tn optimised to constant";
  55     is $sub->(), $expect, "$tn folded correctly";
  56 }
  57
  58
  59 # nextstate multiple times becoming one nextstate
  60
  61 is svref_2object(sub { 0;0;0;0;0;0;time })->START->next->name, 'time',
  62   'multiple nextstates become one';
  63
  64
  65 # split to array
  66
  67 for(['@pkgary'      , '@_'       ],
  68     ['@lexary'      , 'my @a; @a'],
  69     ['my(@array)'   , 'my(@a)'   ],
  70     ['local(@array)', 'local(@_)'],
  71     ['@{...}'       , '@{\@_}'   ],
  72 ){
  73     my($tn,$code) = @$_;
  74     my $sub = eval "sub { $code = split }";
  75     my $split = svref_2object($sub)->ROOT->first->last;
  76     is $split->name, 'split', "$tn = split swallows up the assignment";
  77 }
  78
  79
  80 # stringify with join kid --> join
  81 is svref_2object(sub { "@_" })->ROOT->first->last->name, 'join',
  82   'qq"@_" optimised from stringify(join(...)) to join(...)';