This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
88976040bb2937f4efd76ea401bc51e45a84ae1f
[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 3;
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             );