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
CommitLineData
560a5958
DM
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
13BEGIN {
14 chdir 't';
15 require './test.pl';
16 skip_all_if_miniperl("No B under miniperl");
17 @INC = '../lib';
18}
19
9e7973fa 20plan 28;
560a5958
DM
21
22use 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
67test_opcount(0, "basic aelemfast",
68 sub { $a[0] = 1 },
69 {
70 aelem => 0,
71 aelemfast => 1,
72 'ex-aelem' => 1,
73 }
74 );
9e7973fa
DM
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}