This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
opt.t: Test split-to-array optimisation
[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 17;
13
14 use B qw 'svref_2object OPpASSIGN_COMMON';
15
16
17 # aassign with no common vars
18 {
19     my $last_expr =
20       svref_2object(sub { my($self) = @_ })->ROOT->first->last;
21     if ($last_expr->name ne 'aassign') {
22         die "Expected aassign but found ", $last_expr->name,
23             "; this test needs to be rewritten" 
24     }
25     is $last_expr->private & OPpASSIGN_COMMON, 0,
26       'no ASSIGN_COMMON for my($self) = @_';
27 }    
28
29
30 # join -> stringify/const
31
32 for (['CONSTANT', sub {          join "foo", $_ }],
33      ['$var'    , sub {          join  $_  , $_ }],
34      ['$myvar'  , sub { my $var; join  $var, $_ }],
35 ) {
36     my($sep,$sub) = @$_;
37     my $last_expr = svref_2object($sub)->ROOT->first->last;
38     is $last_expr->name, 'stringify',
39       "join($sep, \$scalar) optimised to stringify";
40 }
41
42 for (['CONSTANT', sub {          join "foo", "bar"    }, 0, "bar"    ],
43      ['CONSTANT', sub {          join "foo", "bar", 3 }, 1, "barfoo3"],
44      ['$var'    , sub {          join  $_  , "bar"    }, 0, "bar"    ],
45      ['$myvar'  , sub { my $var; join  $var, "bar"    }, 0, "bar"    ],
46 ) {
47     my($sep,$sub,$is_list,$expect) = @$_;
48     my $last_expr = svref_2object($sub)->ROOT->first->last;
49     my $tn = "join($sep, " . ($is_list?'list of constants':'const') . ")";
50     is $last_expr->name, 'const', "$tn optimised to constant";
51     is $sub->(), $expect, "$tn folded correctly";
52 }
53
54
55 # split to array
56
57 for(['@pkgary'      , '@_'       ],
58     ['@lexary'      , 'my @a; @a'],
59     ['my(@array)'   , 'my(@a)'   ],
60     ['local(@array)', 'local(@_)'],
61     ['@{...}'       , '@{\@_}'   ],
62 ){
63     my($tn,$code) = @$_;
64     my $sub = eval "sub { $code = split }";
65     my $split = svref_2object($sub)->ROOT->first->last;
66     is $split->name, 'split', "$tn = split swallows up the assignment";
67 }