This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add Porting/bench.pl
[perl5.git] / t / perf / opcount.t
1 #!./perl
2 #
3 # opcount.t
4 #
5 # Test whether various constructs have the right numbers of particular op
6 # types. This is chiefly to test that various optimisations are not
7 # inadvertently removed.
8 #
9 # For example the array access in sub { $a[0] } should get optimised from
10 # aelem into aelemfast. So we want to test that there are 1 aelemfast, 0
11 # aelem and 1 ex-aelem ops in the optree for that sub.
12
13 BEGIN {
14     chdir 't';
15     require './test.pl';
16     skip_all_if_miniperl("No B under miniperl");
17     @INC = '../lib';
18 }
19
20 plan 28;
21
22 use B ();
23
24
25 {
26     my %counts;
27
28     # for a given op, increment $count{opname}. Treat null ops
29     # as "ex-foo" where possible
30
31     sub B::OP::test_opcount_callback {
32         my ($op) = @_;
33         my $name = $op->name;
34         if ($name eq 'null') {
35             my $targ = $op->targ;
36             if ($targ) {
37                 $name = "ex-" . substr(B::ppname($targ), 3);
38             }
39         }
40         $counts{$name}++;
41     }
42
43     # Given a code ref and a hash ref of expected op counts, check that
44     # for each opname => count pair, whether that op appears that many
45     # times in the op tree for that sub. If $debug is 1, display all the
46     # op counts for the sub.
47
48     sub test_opcount {
49         my ($debug, $desc, $coderef, $expected_counts) = @_;
50
51         %counts = ();
52         B::walkoptree(B::svref_2object($coderef)->ROOT,
53                         'test_opcount_callback');
54
55         if ($debug) {
56             note(sprintf "%3d %s", $counts{$_}, $_) for sort keys %counts;
57         }
58
59         for (sort keys %$expected_counts) {
60             is ($counts{$_}//0, $expected_counts->{$_}, "$desc: $_");
61         }
62     }    
63 }
64
65 # aelem => aelemfast: a basic test that this test file works
66
67 test_opcount(0, "basic aelemfast",
68                 sub { $a[0] = 1 }, 
69                 {
70                     aelem      => 0,
71                     aelemfast  => 1,
72                     'ex-aelem' => 1,
73                 }
74             );
75
76 # Porting/bench.pl tries to create an empty and active loop, with the
77 # ops executed being exactly the same apart from the additional ops
78 # in the active loop. Check that this remains true.
79
80 {
81     test_opcount(0, "bench.pl empty loop",
82                 sub { for my $x (1..$ARGV[0]) { 1; } },
83                 {
84                      aelemfast => 1,
85                      and       => 1,
86                      const     => 1,
87                      enteriter => 1,
88                      iter      => 1,
89                      leaveloop => 1,
90                      leavesub  => 1,
91                      lineseq   => 2,
92                      nextstate => 2,
93                      null      => 1,
94                      pushmark  => 1,
95                      unstack   => 1,
96                 }
97             );
98
99     test_opcount(0, "bench.pl active loop",
100                 sub { for my $x (1..$ARGV[0]) { $x; } },
101                 {
102                      aelemfast => 1,
103                      and       => 1,
104                      const     => 1,
105                      enteriter => 1,
106                      iter      => 1,
107                      leaveloop => 1,
108                      leavesub  => 1,
109                      lineseq   => 2,
110                      nextstate => 2,
111                      null      => 1,
112                      padsv     => 1, # this is the additional active op
113                      pushmark  => 1,
114                      unstack   => 1,
115                 }
116             );
117 }