← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:20 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Test/Deep.pm
StatementsExecuted 281 statements in 2.42ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111359µs905µsTest::Deep::::BEGIN@7Test::Deep::BEGIN@7
111355µs900µsTest::Deep::::BEGIN@8Test::Deep::BEGIN@8
11196µs126µsTest::Deep::::BEGIN@9Test::Deep::BEGIN@9
11117µs22µsmain::::BEGIN@1.33 main::BEGIN@1.33
1119µs47µsTest::Deep::::BEGIN@5Test::Deep::BEGIN@5
1118µs23µsTest::Deep::::BEGIN@12Test::Deep::BEGIN@12
1117µs26µsmain::::BEGIN@2 main::BEGIN@2
1117µs16µsTest::Deep::::BEGIN@82Test::Deep::BEGIN@82
0000s0sTest::Deep::::__ANON__[:80]Test::Deep::__ANON__[:80]
0000s0sTest::Deep::::bagTest::Deep::bag
0000s0sTest::Deep::::builderTest::Deep::builder
0000s0sTest::Deep::::class_baseTest::Deep::class_base
0000s0sTest::Deep::::cmp_bagTest::Deep::cmp_bag
0000s0sTest::Deep::::cmp_deeplyTest::Deep::cmp_deeply
0000s0sTest::Deep::::cmp_detailsTest::Deep::cmp_details
0000s0sTest::Deep::::cmp_methodsTest::Deep::cmp_methods
0000s0sTest::Deep::::cmp_setTest::Deep::cmp_set
0000s0sTest::Deep::::deep_diagTest::Deep::deep_diag
0000s0sTest::Deep::::descendTest::Deep::descend
0000s0sTest::Deep::::eq_deeplyTest::Deep::eq_deeply
0000s0sTest::Deep::::eq_deeply_cacheTest::Deep::eq_deeply_cache
0000s0sTest::Deep::::isaTest::Deep::isa
0000s0sTest::Deep::::noclassTest::Deep::noclass
0000s0sTest::Deep::::render_stackTest::Deep::render_stack
0000s0sTest::Deep::::render_valTest::Deep::render_val
0000s0sTest::Deep::::requireclassTest::Deep::requireclass
0000s0sTest::Deep::::setTest::Deep::set
0000s0sTest::Deep::::subbagofTest::Deep::subbagof
0000s0sTest::Deep::::subhashofTest::Deep::subhashof
0000s0sTest::Deep::::subsetofTest::Deep::subsetof
0000s0sTest::Deep::::superbagofTest::Deep::superbagof
0000s0sTest::Deep::::superhashofTest::Deep::superhashof
0000s0sTest::Deep::::supersetofTest::Deep::supersetof
0000s0sTest::Deep::::wrapTest::Deep::wrap
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1320µs226µs
# spent 22µs (17+4) within main::BEGIN@1.33 which was called: # once (17µs+4µs) by main::BEGIN@22 at line 1
use strict;
# spent 22µs making 1 call to main::BEGIN@1.33 # spent 4µs making 1 call to strict::import
2330µs244µs
# spent 26µs (7+18) within main::BEGIN@2 which was called: # once (7µs+18µs) by main::BEGIN@22 at line 2
use warnings;
# spent 26µs making 1 call to main::BEGIN@2 # spent 18µs making 1 call to warnings::import
3
4package Test::Deep;
5322µs285µs
# spent 47µs (9+38) within Test::Deep::BEGIN@5 which was called: # once (9µs+38µs) by main::BEGIN@22 at line 5
use Carp qw( confess );
# spent 47µs making 1 call to Test::Deep::BEGIN@5 # spent 38µs making 1 call to Exporter::import
6
7371µs1905µs
# spent 905µs (359+546) within Test::Deep::BEGIN@7 which was called: # once (359µs+546µs) by main::BEGIN@22 at line 7
use Test::Deep::Cache;
# spent 905µs making 1 call to Test::Deep::BEGIN@7
8372µs1900µs
# spent 900µs (355+545) within Test::Deep::BEGIN@8 which was called: # once (355µs+545µs) by main::BEGIN@22 at line 8
use Test::Deep::Stack;
# spent 900µs making 1 call to Test::Deep::BEGIN@8
9376µs1126µs
# spent 126µs (96+31) within Test::Deep::BEGIN@9 which was called: # once (96µs+31µs) by main::BEGIN@22 at line 9
use Test::Deep::RegexpVersion;
# spent 126µs making 1 call to Test::Deep::BEGIN@9
10
1111µsrequire overload;
123254µs237µs
# spent 23µs (8+15) within Test::Deep::BEGIN@12 which was called: # once (8µs+15µs) by main::BEGIN@22 at line 12
use Scalar::Util;
# spent 23µs making 1 call to Test::Deep::BEGIN@12 # spent 14µs making 1 call to Exporter::import
13
141100nsmy $Test;
1536µsunless (defined $Test::Deep::NoTest::NoTest)
16{
17# for people who want eq_deeply but not Test::Builder
18 require Test::Builder;
1916µs $Test = Test::Builder->new;
# spent 6µs making 1 call to Test::Builder::new
20}
21
221500nsour ($Stack, %Compared, $CompareCache, %WrapCache, $Shallow);
23
241400nsour $VERSION = '0.109';
25120µs$VERSION = eval $VERSION;
# spent 2µs executing statements in string eval
26
271700nsrequire Exporter;
28111µsour @ISA = qw( Exporter );
29
301300nsour $Snobby = 1; # should we compare classes?
311200nsour $Expects = 0; # are we comparing got vs expect or expect vs expect
32
331300nsour $DNE = \"";
3417µs12µsour $DNE_ADDR = Scalar::Util::refaddr($DNE);
# spent 2µs making 1 call to Scalar::Util::refaddr
35
36# if no sub name is supplied then we use the package name in lower case
37124µsmy %constructors = (
38 All => "",
39 Any => "",
40 Array => "",
41 ArrayEach => "array_each",
42 ArrayElementsOnly => "",
43 ArrayLength => "",
44 ArrayLengthOnly => "",
45 Blessed => "",
46 Boolean => "bool",
47 Code => "",
48 Hash => "",
49 HashEach => "hash_each",
50 HashKeys => "",
51 HashKeysOnly => "",
52 Ignore => "",
53 Isa => "Isa",
54 ListMethods => "",
55 Methods => "",
56 Number => "num",
57 RefType => "",
58 Regexp => "re",
59 RegexpMatches => "",
60 RegexpOnly => "",
61 RegexpRef => "",
62 RegexpRefOnly => "",
63 ScalarRef => "scalref",
64 ScalarRefOnly => "",
65 Shallow => "",
66 String => "str",
67);
68
691300nsour @CONSTRUCTORS_FROM_CLASSES;
70
71204247µswhile (my ($pkg, $name) = each %constructors)
72{
73 $name = lc($pkg) unless $name;
74 my $full_pkg = "Test::Deep::$pkg";
75 my $file = "$full_pkg.pm";
762945µs $file =~ s#::#/#g;
# spent 45µs making 29 calls to Test::Deep::CORE:subst, avg 2µs/call
77 my $sub = sub {
78 require $file;
79 return $full_pkg->new(@_);
80 };
81 {
8231.44ms225µs
# spent 16µs (7+9) within Test::Deep::BEGIN@82 which was called: # once (7µs+9µs) by main::BEGIN@22 at line 82
no strict 'refs';
# spent 16µs making 1 call to Test::Deep::BEGIN@82 # spent 9µs making 1 call to strict::unimport
832942µs *{$name} = $sub;
84 }
85
86 push @CONSTRUCTORS_FROM_CLASSES, $name;
87}
88
89{
90648µs our @EXPORT_OK = qw( descend render_stack class_base cmp_details deep_diag );
91
92 our %EXPORT_TAGS;
93 $EXPORT_TAGS{v0} = [
94 qw(
95 Isa
96
97 all any array array_each arrayelementsonly arraylength arraylengthonly
98 bag blessed bool cmp_bag cmp_deeply cmp_methods cmp_set code eq_deeply
99 hash hash_each hashkeys hashkeysonly ignore isa listmethods methods
100 noclass num re reftype regexpmatches regexponly regexpref regexprefonly
101 scalarrefonly scalref set shallow str subbagof subhashof subsetof
102 superbagof superhashof supersetof useclass
103 )
104 ];
105
106 our @EXPORT = @{ $EXPORT_TAGS{ v0 } };
107
108 $EXPORT_TAGS{all} = [ @EXPORT, @EXPORT_OK ];
109}
110
111# this is ugly, I should never have exported a sub called isa now I
112# have to try figure out if the recipient wanted my isa or if a class
113# imported us and UNIVERSAL::isa is being called on that class.
114# Luckily our isa always expects 1 argument and U::isa always expects
115# 2, so we can figure out (assuming the caller is not buggy).
116sub isa
117{
118 if (@_ == 1)
119 {
120 goto &Isa;
121 }
122 else
123 {
124 goto &UNIVERSAL::isa;
125 }
126}
127
128sub cmp_deeply
129{
130 my ($d1, $d2, $name) = @_;
131
132 my ($ok, $stack) = cmp_details($d1, $d2);
133
134 if (not $Test->ok($ok, $name))
135 {
136 my $diag = deep_diag($stack);
137 $Test->diag($diag);
138 }
139
140 return $ok;
141}
142
143sub cmp_details
144{
145 my ($d1, $d2) = @_;
146
147 local $Stack = Test::Deep::Stack->new;
148 local $CompareCache = Test::Deep::Cache->new;
149 local %WrapCache;
150
151 my $ok = descend($d1, $d2);
152
153 return ($ok, $Stack);
154}
155
156sub eq_deeply
157{
158 my ($d1, $d2) = @_;
159
160 my ($ok) = cmp_details($d1, $d2);
161
162 return $ok
163}
164
165sub eq_deeply_cache
166{
167 # this is like cross between eq_deeply and descend(). It doesn't start
168 # with a new $CompareCache but if the comparison fails it will leave
169 # $CompareCache as if nothing happened. However, if the comparison
170 # succeeds then $CompareCache retains all the new information
171
172 # this allows Set and Bag to handle circular refs
173
174 my ($d1, $d2, $name) = @_;
175
176 local $Stack = Test::Deep::Stack->new;
177 $CompareCache->local;
178
179 my $ok = descend($d1, $d2);
180
181 $CompareCache->finish($ok);
182
183 return $ok;
184}
185
186sub deep_diag
187{
188 my $stack = shift;
189 # ick! incArrow and other things expect the stack has to be visible
190 # in a well known place . TODO clean this up
191 local $Stack = $stack;
192
193 my $where = render_stack('$data', $stack);
194
195 confess "No stack to diagnose" unless $stack;
196 my $last = $stack->getLast;
197
198 my $diag;
199 my $message;
200 my $got;
201 my $expected;
202
203 my $exp = $last->{exp};
204 if (Scalar::Util::blessed($exp))
205 {
206 if ($exp->can("diagnostics"))
207 {
208 $diag = $exp->diagnostics($where, $last);
209 $diag =~ s/\n+$/\n/;
210 }
211 else
212 {
213 if ($exp->can("diag_message"))
214 {
215 $message = $exp->diag_message($where);
216 }
217 }
218 }
219
220 if (not defined $diag)
221 {
222 $got = $exp->renderGot($last->{got}) unless defined $got;
223 $expected = $exp->renderExp unless defined $expected;
224 $message = "Compared $where" unless defined $message;
225
226 $diag = <<EOM
227$message
228 got : $got
229expect : $expected
230EOM
231 }
232
233 return $diag;
234}
235
236sub render_val
237{
238 my $val = shift;
239
240 my $rendered;
241 if (defined $val)
242 {
243 $rendered = ref($val) ?
244 (Scalar::Util::refaddr($val) eq $DNE_ADDR ?
245 "Does not exist" :
246 overload::StrVal($val)
247 ) :
248 qq('$val');
249 }
250 else
251 {
252 $rendered = "undef";
253 }
254
255 return $rendered;
256}
257
258sub descend
259{
260 my ($d1, $d2) = @_;
261
262 if (!ref $d1 and !ref $d2)
263 {
264 # Shortcut comparison for the non-reference case.
265 if (defined $d1)
266 {
267 return 1 if defined $d2 and $d1 eq $d2;
268 }
269 else
270 {
271 return 1 if !defined $d2;
272 }
273 }
274
275 if (! $Expects and Scalar::Util::blessed($d1) and $d1->isa("Test::Deep::Cmp"))
276 {
277 my $where = $Stack->render('$data');
278 confess "Found a special comparison in $where\nYou can only the specials in the expects structure";
279 }
280
281 if (ref $d1 and ref $d2)
282 {
283 # this check is only done when we're comparing 2 expecteds against each
284 # other
285
286 if ($Expects and Scalar::Util::blessed($d1) and $d1->isa("Test::Deep::Cmp"))
287 {
288 # check they are the same class
289 return 0 unless Test::Deep::blessed(Scalar::Util::blessed($d2))->descend($d1);
290 if ($d1->can("compare"))
291 {
292 return $d1->compare($d2);
293 }
294 }
295
296 my $s1 = Scalar::Util::refaddr($d1);
297 my $s2 = Scalar::Util::refaddr($d2);
298
299 if ($s1 eq $s2)
300 {
301 return 1;
302 }
303 if ($CompareCache->cmp($d1, $d2))
304 {
305 # we've tried comparing these already so either they turned out to
306 # be the same or we must be in a loop and we have to assume they're
307 # the same
308
309 return 1;
310 }
311 else
312 {
313 $CompareCache->add($d1, $d2)
314 }
315 }
316
317 $d2 = wrap($d2);
318
319 $Stack->push({exp => $d2, got => $d1});
320
321 if (ref($d1) and (Scalar::Util::refaddr($d1) == $DNE_ADDR))
322 {
323 # whatever it was suposed to be, it didn't exist and so it's an
324 # automatic fail
325 return 0;
326 }
327
328 if ($d2->descend($d1))
329 {
330# print "d1 = $d1, d2 = $d2\nok\n";
331 $Stack->pop;
332
333 return 1;
334 }
335 else
336 {
337# print "d1 = $d1, d2 = $d2\nnot ok\n";
338 return 0;
339 }
340}
341
342sub wrap
343{
344 my $data = shift;
345
346 return $data if Scalar::Util::blessed($data) and $data->isa("Test::Deep::Cmp");
347
348 my ($class, $base) = class_base($data);
349
350 my $cmp;
351
352 if($base eq '')
353 {
354 $cmp = shallow($data);
355 }
356 else
357 {
358 my $addr = Scalar::Util::refaddr($data);
359
360 return $WrapCache{$addr} if $WrapCache{$addr};
361
362 if($base eq 'ARRAY')
363 {
364 $cmp = array($data);
365 }
366 elsif($base eq 'HASH')
367 {
368 $cmp = hash($data);
369 }
370 elsif($base eq 'SCALAR' or $base eq 'REF')
371 {
372 $cmp = scalref($data);
373 }
374 elsif(($base eq 'Regexp') or ($base eq 'REGEXP'))
375 {
376 $cmp = regexpref($data);
377 }
378 else
379 {
380 $cmp = shallow($data);
381 }
382
383 $WrapCache{$addr} = $cmp;
384 }
385 return $cmp;
386}
387
388sub class_base
389{
390 my $val = shift;
391
392 if (ref $val)
393 {
394 my $blessed = Scalar::Util::blessed($val);
395 $blessed = defined($blessed) ? $blessed : "";
396 my $reftype = Scalar::Util::reftype($val);
397
398
399 if ($Test::Deep::RegexpVersion::OldStyle) {
400 if ($blessed eq "Regexp" and $reftype eq "SCALAR")
401 {
402 $reftype = "Regexp"
403 }
404 }
405 return ($blessed, $reftype);
406 }
407 else
408 {
409 return ("", "");
410 }
411}
412
413sub render_stack
414{
415 my ($var, $stack) = @_;
416
417 return $stack->render($var);
418}
419
420sub cmp_methods
421{
422 local $Test::Builder::Level = $Test::Builder::Level + 1;
423 return cmp_deeply(shift, methods(@{shift()}), shift);
424}
425
426sub requireclass
427{
428 require Test::Deep::Class;
429
430 my $val = shift;
431
432 return Test::Deep::Class->new(1, $val);
433}
434
435# docs and export say this is call useclass, doh!
436
43711µs*useclass = \&requireclass;
438
439sub noclass
440{
441 require Test::Deep::Class;
442
443 my $val = shift;
444
445 return Test::Deep::Class->new(0, $val);
446}
447
448sub set
449{
450 require Test::Deep::Set;
451
452 return Test::Deep::Set->new(1, "", @_);
453}
454
455sub supersetof
456{
457 require Test::Deep::Set;
458
459 return Test::Deep::Set->new(1, "sup", @_);
460}
461
462sub subsetof
463{
464 require Test::Deep::Set;
465
466 return Test::Deep::Set->new(1, "sub", @_);
467}
468
469sub cmp_set
470{
471 local $Test::Builder::Level = $Test::Builder::Level + 1;
472 return cmp_deeply(shift, set(@{shift()}), shift);
473}
474
475sub bag
476{
477 require Test::Deep::Set;
478
479 return Test::Deep::Set->new(0, "", @_);
480}
481
482sub superbagof
483{
484 require Test::Deep::Set;
485
486 return Test::Deep::Set->new(0, "sup", @_);
487}
488
489sub subbagof
490{
491 require Test::Deep::Set;
492
493 return Test::Deep::Set->new(0, "sub", @_);
494}
495
496sub cmp_bag
497{
498 local $Test::Builder::Level = $Test::Builder::Level + 1;
499 my $ref = ref($_[1]) || "";
500 confess "Argument 2 to cmp_bag is not an ARRAY ref (".render_val($_[1]).")"
501 unless $ref eq "ARRAY";
502 return cmp_deeply(shift, bag(@{shift()}), shift);
503}
504
505sub superhashof
506{
507 require Test::Deep::Hash;
508
509 my $val = shift;
510
511 return Test::Deep::SuperHash->new($val);
512}
513
514sub subhashof
515{
516 require Test::Deep::Hash;
517
518 my $val = shift;
519
520 return Test::Deep::SubHash->new($val);
521}
522
523sub builder
524{
525 if (@_)
526 {
527 $Test = shift;
528 }
529 return $Test;
530}
531
532131µs1;
533
534__END__