This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
3090e35cbd3743d28cb70b799988298000d686a5
[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 12;
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 }