← Index
NYTProf Performance Profile   « line view »
For t/optimization.t
  Run on Thu Jan 8 22:47:42 2015
Reported on Thu Jan 8 22:48:06 2015

Filename/home/ss5/perl5/perlbrew/perls/tapper-perl/lib/site_perl/5.16.3/Test/Deep/Set.pm
StatementsExecuted 91 statements in 963µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111644µs835µsTest::Deep::Set::::BEGIN@6Test::Deep::Set::BEGIN@6
21170µs17.3msTest::Deep::Set::::descendTest::Deep::Set::descend
21133µs36µsTest::Deep::Set::::addTest::Deep::Set::add
21119µs55µsTest::Deep::Set::::initTest::Deep::Set::init
11116µs34µsTest::Deep::::BEGIN@1.10 Test::Deep::BEGIN@1.10
11111µs17µsTest::Deep::::BEGIN@2.11 Test::Deep::BEGIN@2.11
0000s0sTest::Deep::Set::::compareTest::Deep::Set::compare
0000s0sTest::Deep::Set::::diagnosticsTest::Deep::Set::diagnostics
0000s0sTest::Deep::Set::::nice_listTest::Deep::Set::nice_list
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1230µs252µs
# spent 34µs (16+18) within Test::Deep::BEGIN@1.10 which was called: # once (16µs+18µs) by Test::Deep::bag at line 1
use strict;
# spent 34µs making 1 call to Test::Deep::BEGIN@1.10 # spent 18µs making 1 call to strict::import
2233µs223µs
# spent 17µs (11+6) within Test::Deep::BEGIN@2.11 which was called: # once (11µs+6µs) by Test::Deep::bag at line 2
use warnings;
# spent 17µs making 1 call to Test::Deep::BEGIN@2.11 # spent 6µs making 1 call to warnings::import
3
4package Test::Deep::Set;
5
62773µs2857µs
# spent 835µs (644+191) within Test::Deep::Set::BEGIN@6 which was called: # once (644µs+191µs) by Test::Deep::bag at line 6
use Test::Deep::Cmp;
# spent 835µs making 1 call to Test::Deep::Set::BEGIN@6 # spent 22µs making 1 call to Test::Deep::Cmp::import
7
8sub init
9
# spent 55µs (19+36) within Test::Deep::Set::init which was called 2 times, avg 28µs/call: # 2 times (19µs+36µs) by Test::Deep::Cmp::new at line 33 of Test/Deep/Cmp.pm, avg 28µs/call
{
1021µs my $self = shift;
11
1224µs $self->{IgnoreDupes} = shift;
1322µs $self->{SubSup} = shift;
14
1522µs $self->{val} = [];
16
17210µs236µs $self->add(@_);
# spent 36µs making 2 calls to Test::Deep::Set::add, avg 18µs/call
18}
19
20sub descend
21
# spent 17.3ms (70µs+17.2) within Test::Deep::Set::descend which was called 2 times, avg 8.65ms/call: # 2 times (70µs+17.2ms) by Test::Deep::descend at line 344 of Test/Deep.pm, avg 8.65ms/call
{
222800ns my $self = shift;
232600ns my $d1 = shift;
24
2522µs my $d2 = $self->{val};
26
2721µs my $IgnoreDupes = $self->{IgnoreDupes};
28
29211µs233µs my $data = $self->data;
# spent 33µs making 2 calls to Test::Deep::Cmp::data, avg 16µs/call
30
3122µs my $SubSup = $self->{SubSup};
32
3322µs my $type = $IgnoreDupes ? "Set" : "Bag";
34
352500ns my $diag;
36
3722µs if (ref $d1 ne 'ARRAY')
38 {
39 my $got = Test::Deep::render_val($d1);
40 $diag = <<EOM;
41got : $got
42expect : An array to use as a $type
43EOM
44 }
45
4622µs if (not $diag)
47 {
4824µs my @got = @$d1;
492600ns my @missing;
5023µs foreach my $expect (@$d2)
51 {
522700ns my $found = 0;
53
5424µs for (my $i = $#got; $i >= 0; $i--)
55 {
5627µs217.2ms if (Test::Deep::eq_deeply_cache($got[$i], $expect))
# spent 17.2ms making 2 calls to Test::Deep::eq_deeply_cache, avg 8.59ms/call
57 {
5821µs $found = 1;
5923µs splice(@got, $i, 1);
60
6123µs last unless $IgnoreDupes;
62 }
63 }
64
6522µs push(@missing, $expect) unless $found;
66 }
67
68
692800ns my @diags;
7021µs if (@missing and $SubSup ne "sub")
71 {
72 push(@diags, "Missing: ".nice_list(\@missing));
73 }
74
752500ns if (@got and $SubSup ne "sup")
76 {
77 my $got = __PACKAGE__->new($IgnoreDupes, "", @got);
78 push(@diags, "Extra: ".nice_list($got->{val}));
79 }
80
8124µs $diag = join("\n", @diags);
82 }
83
842900ns if ($diag)
85 {
86 $data->{diag} = $diag;
87
88 return 0;
89 }
90 else
91 {
9228µs return 1;
93 }
94}
95
96sub diagnostics
97{
98 my $self = shift;
99 my ($where, $last) = @_;
100
101 my $type = $self->{IgnoreDupes} ? "Set" : "Bag";
102 $type = "Sub$type" if $self->{SubSup} eq "sub";
103 $type = "Super$type" if $self->{SubSup} eq "sup";
104
105 my $error = $last->{diag};
106 my $diag = <<EOM;
107Comparing $where as a $type
108$error
109EOM
110
111 return $diag;
112}
113
114sub add
115
# spent 36µs (33+3) within Test::Deep::Set::add which was called 2 times, avg 18µs/call: # 2 times (33µs+3µs) by Test::Deep::Set::init at line 17, avg 18µs/call
{
116 # this takes an array.
117
118 # For each element A of the array, it looks for an element, B, already in
119 # the set which are deeply equal to A. If no matching B is found then A is
120 # added to the set. If a B is found and IgnoreDupes is true, then A will
121 # be discarded, if IgnoreDupes is false, then B will be added to the set
122 # again.
123
1242700ns my $self = shift;
125
12622µs my @array = @_;
127
12821µs my $IgnoreDupes = $self->{IgnoreDupes};
129
1302900ns my $already = $self->{val};
131
13221µs local $Test::Deep::Expects = 1;
13322µs foreach my $new_elem (@array)
134 {
1352500ns my $want_push = 1;
1362500ns my $push_this = $new_elem;
13722µs foreach my $old_elem (@$already)
138 {
139 if (Test::Deep::eq_deeply($new_elem, $old_elem))
140 {
141 $push_this = $old_elem;
142 $want_push = ! $IgnoreDupes;
143 last;
144 }
145 }
14623µs push(@$already, $push_this) if $want_push;
147 }
148
149 # so we can compare 2 Test::Deep::Set objects using array comparison
150
151224µs23µs @$already = sort {(defined $a ? $a : "") cmp (defined $b ? $b : "")} @$already;
# spent 3µs making 2 calls to Test::Deep::Set::CORE:sort, avg 1µs/call
152}
153
154sub nice_list
155{
156 my $list = shift;
157
158 my @scalars = grep ! ref $_, @$list;
159 my $refs = grep ref $_, @$list;
160
161 my @ref_string = "$refs reference" if $refs;
162 $ref_string[0] .= "s" if $refs > 1;
163
164 # sort them so we can predict the diagnostic output
165
166 return join(", ",
167 (map {Test::Deep::render_val($_)} sort {(defined $a ? $a : "") cmp (defined $b ? $b : "")} @scalars),
168 @ref_string
169 );
170}
171
172sub compare
173{
174 my $self = shift;
175
176 my $other = shift;
177
178 return 0 if $self->{IgnoreDupes} != $other->{IgnoreDupes};
179
180 # this works (kind of) because the arrays are sorted
181
182 return Test::Deep::descend($self->{val}, $other->{val});
183}
184
18513µs1;