Commit | Line | Data |
---|---|---|
987c9691 FC |
1 | #!./perl |
2 | ||
009e0f19 DM |
3 | # Use B to test that optimisations are not inadvertently removed, |
4 | # by examining particular nodes in the optree. | |
987c9691 FC |
5 | |
6 | BEGIN { | |
7 | chdir 't'; | |
8 | require './test.pl'; | |
9 | skip_all_if_miniperl("No B under miniperl"); | |
10 | @INC = '../lib'; | |
11 | } | |
12 | ||
6aa68307 | 13 | plan 23; |
987c9691 | 14 | |
412989c2 | 15 | use v5.10; # state |
2251d43b FC |
16 | use B qw 'svref_2object OPpASSIGN_COMMON'; |
17 | ||
18 | ||
19 | # aassign with no common vars | |
78fdc7f3 FC |
20 | for ('my ($self) = @_', |
21 | 'my @x; @y = $x[0]', # aelemfast_lex | |
22 | ) | |
2251d43b | 23 | { |
78fdc7f3 | 24 | my $sub = eval "sub { $_ }"; |
2251d43b | 25 | my $last_expr = |
78fdc7f3 | 26 | svref_2object($sub)->ROOT->first->last; |
2251d43b FC |
27 | if ($last_expr->name ne 'aassign') { |
28 | die "Expected aassign but found ", $last_expr->name, | |
29 | "; this test needs to be rewritten" | |
30 | } | |
31 | is $last_expr->private & OPpASSIGN_COMMON, 0, | |
78fdc7f3 | 32 | "no ASSIGN_COMMON for $_"; |
2251d43b FC |
33 | } |
34 | ||
35 | ||
36 | # join -> stringify/const | |
987c9691 FC |
37 | |
38 | for (['CONSTANT', sub { join "foo", $_ }], | |
39 | ['$var' , sub { join $_ , $_ }], | |
40 | ['$myvar' , sub { my $var; join $var, $_ }], | |
41 | ) { | |
42 | my($sep,$sub) = @$_; | |
43 | my $last_expr = svref_2object($sub)->ROOT->first->last; | |
44 | is $last_expr->name, 'stringify', | |
45 | "join($sep, \$scalar) optimised to stringify"; | |
46 | } | |
47 | ||
48 | for (['CONSTANT', sub { join "foo", "bar" }, 0, "bar" ], | |
49 | ['CONSTANT', sub { join "foo", "bar", 3 }, 1, "barfoo3"], | |
50 | ['$var' , sub { join $_ , "bar" }, 0, "bar" ], | |
51 | ['$myvar' , sub { my $var; join $var, "bar" }, 0, "bar" ], | |
52 | ) { | |
53 | my($sep,$sub,$is_list,$expect) = @$_; | |
54 | my $last_expr = svref_2object($sub)->ROOT->first->last; | |
55 | my $tn = "join($sep, " . ($is_list?'list of constants':'const') . ")"; | |
56 | is $last_expr->name, 'const', "$tn optimised to constant"; | |
57 | is $sub->(), $expect, "$tn folded correctly"; | |
58 | } | |
45742705 FC |
59 | |
60 | ||
6aa68307 FC |
61 | # list+pushmark in list context elided out of the execution chain |
62 | is svref_2object(sub { () = ($_, ($_, $_)) }) | |
63 | ->START # nextstate | |
64 | ->next # pushmark | |
65 | ->next # gvsv | |
66 | ->next # should be gvsv, not pushmark | |
67 | ->name, 'gvsv', | |
68 | "list+pushmark in list context where list's elder sibling is a null"; | |
69 | ||
70 | ||
f5b5c2a3 FC |
71 | # nextstate multiple times becoming one nextstate |
72 | ||
73 | is svref_2object(sub { 0;0;0;0;0;0;time })->START->next->name, 'time', | |
74 | 'multiple nextstates become one'; | |
75 | ||
76 | ||
412989c2 FC |
77 | # pad[ahs]v state declarations in void context |
78 | ||
79 | is svref_2object(sub{state($foo,@fit,%far);state $bar;state($a,$b); time}) | |
80 | ->START->next->name, 'time', | |
81 | 'pad[ahs]v state declarations in void context'; | |
82 | ||
83 | ||
0298c760 FC |
84 | # rv2[ahs]v in void context |
85 | ||
86 | is svref_2object(sub { our($foo,@fit,%far); our $bar; our($a,$b); time }) | |
87 | ->START->next->name, 'time', | |
88 | 'rv2[ahs]v in void context'; | |
89 | ||
90 | ||
45742705 FC |
91 | # split to array |
92 | ||
93 | for(['@pkgary' , '@_' ], | |
94 | ['@lexary' , 'my @a; @a'], | |
95 | ['my(@array)' , 'my(@a)' ], | |
96 | ['local(@array)', 'local(@_)'], | |
97 | ['@{...}' , '@{\@_}' ], | |
98 | ){ | |
99 | my($tn,$code) = @$_; | |
100 | my $sub = eval "sub { $code = split }"; | |
101 | my $split = svref_2object($sub)->ROOT->first->last; | |
102 | is $split->name, 'split', "$tn = split swallows up the assignment"; | |
103 | } | |
73f4c4fe FC |
104 | |
105 | ||
106 | # stringify with join kid --> join | |
107 | is svref_2object(sub { "@_" })->ROOT->first->last->name, 'join', | |
108 | 'qq"@_" optimised from stringify(join(...)) to join(...)'; |