This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add t/perf/, t/perf/opcount.t
[perl5.git] / 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 23;
13
14 use v5.10; # state
15 use B qw 'svref_2object OPpASSIGN_COMMON';
16
17
18 # aassign with no common vars
19 for ('my ($self) = @_',
20      'my @x; @y = $x[0]', # aelemfast_lex
21     )
22 {
23     my $sub = eval "sub { $_ }";
24     my $last_expr =
25       svref_2object($sub)->ROOT->first->last;
26     if ($last_expr->name ne 'aassign') {
27         die "Expected aassign but found ", $last_expr->name,
28             "; this test needs to be rewritten" 
29     }
30     is $last_expr->private & OPpASSIGN_COMMON, 0,
31       "no ASSIGN_COMMON for $_";
32 }    
33
34
35 # join -> stringify/const
36
37 for (['CONSTANT', sub {          join "foo", $_ }],
38      ['$var'    , sub {          join  $_  , $_ }],
39      ['$myvar'  , sub { my $var; join  $var, $_ }],
40 ) {
41     my($sep,$sub) = @$_;
42     my $last_expr = svref_2object($sub)->ROOT->first->last;
43     is $last_expr->name, 'stringify',
44       "join($sep, \$scalar) optimised to stringify";
45 }
46
47 for (['CONSTANT', sub {          join "foo", "bar"    }, 0, "bar"    ],
48      ['CONSTANT', sub {          join "foo", "bar", 3 }, 1, "barfoo3"],
49      ['$var'    , sub {          join  $_  , "bar"    }, 0, "bar"    ],
50      ['$myvar'  , sub { my $var; join  $var, "bar"    }, 0, "bar"    ],
51 ) {
52     my($sep,$sub,$is_list,$expect) = @$_;
53     my $last_expr = svref_2object($sub)->ROOT->first->last;
54     my $tn = "join($sep, " . ($is_list?'list of constants':'const') . ")";
55     is $last_expr->name, 'const', "$tn optimised to constant";
56     is $sub->(), $expect, "$tn folded correctly";
57 }
58
59
60 # list+pushmark in list context elided out of the execution chain
61 is svref_2object(sub { () = ($_, ($_, $_)) })
62     ->START # nextstate
63     ->next  # pushmark
64     ->next  # gvsv
65     ->next  # should be gvsv, not pushmark
66   ->name, 'gvsv',
67   "list+pushmark in list context where list's elder sibling is a null";
68
69
70 # nextstate multiple times becoming one nextstate
71
72 is svref_2object(sub { 0;0;0;0;0;0;time })->START->next->name, 'time',
73   'multiple nextstates become one';
74
75
76 # pad[ahs]v state declarations in void context 
77
78 is svref_2object(sub{state($foo,@fit,%far);state $bar;state($a,$b); time})
79     ->START->next->name, 'time',
80   'pad[ahs]v state declarations in void context';
81
82
83 # rv2[ahs]v in void context
84
85 is svref_2object(sub { our($foo,@fit,%far); our $bar; our($a,$b); time })
86     ->START->next->name, 'time',
87   'rv2[ahs]v in void context';
88
89
90 # split to array
91
92 for(['@pkgary'      , '@_'       ],
93     ['@lexary'      , 'my @a; @a'],
94     ['my(@array)'   , 'my(@a)'   ],
95     ['local(@array)', 'local(@_)'],
96     ['@{...}'       , '@{\@_}'   ],
97 ){
98     my($tn,$code) = @$_;
99     my $sub = eval "sub { $code = split }";
100     my $split = svref_2object($sub)->ROOT->first->last;
101     is $split->name, 'split', "$tn = split swallows up the assignment";
102 }
103
104
105 # stringify with join kid --> join
106 is svref_2object(sub { "@_" })->ROOT->first->last->name, 'join',
107   'qq"@_" optimised from stringify(join(...)) to join(...)';