This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
rename t/op/opt.t -> t/perf/optree.t
[perl5.git] / t / perf / optree.t
CommitLineData
987c9691
FC
1#!./perl
2
3# Use B to test that optimisations are not inadvertently removed.
4
5BEGIN {
6 chdir 't';
7 require './test.pl';
8 skip_all_if_miniperl("No B under miniperl");
9 @INC = '../lib';
10}
11
6aa68307 12plan 23;
987c9691 13
412989c2 14use v5.10; # state
2251d43b
FC
15use B qw 'svref_2object OPpASSIGN_COMMON';
16
17
18# aassign with no common vars
78fdc7f3
FC
19for ('my ($self) = @_',
20 'my @x; @y = $x[0]', # aelemfast_lex
21 )
2251d43b 22{
78fdc7f3 23 my $sub = eval "sub { $_ }";
2251d43b 24 my $last_expr =
78fdc7f3 25 svref_2object($sub)->ROOT->first->last;
2251d43b
FC
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,
78fdc7f3 31 "no ASSIGN_COMMON for $_";
2251d43b
FC
32}
33
34
35# join -> stringify/const
987c9691
FC
36
37for (['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
47for (['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}
45742705
FC
58
59
6aa68307
FC
60# list+pushmark in list context elided out of the execution chain
61is 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
f5b5c2a3
FC
70# nextstate multiple times becoming one nextstate
71
72is svref_2object(sub { 0;0;0;0;0;0;time })->START->next->name, 'time',
73 'multiple nextstates become one';
74
75
412989c2
FC
76# pad[ahs]v state declarations in void context
77
78is 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
0298c760
FC
83# rv2[ahs]v in void context
84
85is 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
45742705
FC
90# split to array
91
92for(['@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}
73f4c4fe
FC
103
104
105# stringify with join kid --> join
106is svref_2object(sub { "@_" })->ROOT->first->last->name, 'join',
107 'qq"@_" optimised from stringify(join(...)) to join(...)';