Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/Test/Deep.pm |
Statements | Executed 281 statements in 2.42ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 359µs | 905µs | BEGIN@7 | Test::Deep::
1 | 1 | 1 | 355µs | 900µs | BEGIN@8 | Test::Deep::
1 | 1 | 1 | 96µs | 126µs | BEGIN@9 | Test::Deep::
1 | 1 | 1 | 17µs | 22µs | BEGIN@1.33 | main::
1 | 1 | 1 | 9µs | 47µs | BEGIN@5 | Test::Deep::
1 | 1 | 1 | 8µs | 23µs | BEGIN@12 | Test::Deep::
1 | 1 | 1 | 7µs | 26µs | BEGIN@2 | main::
1 | 1 | 1 | 7µs | 16µs | BEGIN@82 | Test::Deep::
0 | 0 | 0 | 0s | 0s | __ANON__[:80] | Test::Deep::
0 | 0 | 0 | 0s | 0s | bag | Test::Deep::
0 | 0 | 0 | 0s | 0s | builder | Test::Deep::
0 | 0 | 0 | 0s | 0s | class_base | Test::Deep::
0 | 0 | 0 | 0s | 0s | cmp_bag | Test::Deep::
0 | 0 | 0 | 0s | 0s | cmp_deeply | Test::Deep::
0 | 0 | 0 | 0s | 0s | cmp_details | Test::Deep::
0 | 0 | 0 | 0s | 0s | cmp_methods | Test::Deep::
0 | 0 | 0 | 0s | 0s | cmp_set | Test::Deep::
0 | 0 | 0 | 0s | 0s | deep_diag | Test::Deep::
0 | 0 | 0 | 0s | 0s | descend | Test::Deep::
0 | 0 | 0 | 0s | 0s | eq_deeply | Test::Deep::
0 | 0 | 0 | 0s | 0s | eq_deeply_cache | Test::Deep::
0 | 0 | 0 | 0s | 0s | isa | Test::Deep::
0 | 0 | 0 | 0s | 0s | noclass | Test::Deep::
0 | 0 | 0 | 0s | 0s | render_stack | Test::Deep::
0 | 0 | 0 | 0s | 0s | render_val | Test::Deep::
0 | 0 | 0 | 0s | 0s | requireclass | Test::Deep::
0 | 0 | 0 | 0s | 0s | set | Test::Deep::
0 | 0 | 0 | 0s | 0s | subbagof | Test::Deep::
0 | 0 | 0 | 0s | 0s | subhashof | Test::Deep::
0 | 0 | 0 | 0s | 0s | subsetof | Test::Deep::
0 | 0 | 0 | 0s | 0s | superbagof | Test::Deep::
0 | 0 | 0 | 0s | 0s | superhashof | Test::Deep::
0 | 0 | 0 | 0s | 0s | supersetof | Test::Deep::
0 | 0 | 0 | 0s | 0s | wrap | Test::Deep::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | 3 | 20µs | 2 | 26µ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 # spent 22µs making 1 call to main::BEGIN@1.33
# spent 4µs making 1 call to strict::import |
2 | 3 | 30µs | 2 | 44µ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 # spent 26µs making 1 call to main::BEGIN@2
# spent 18µs making 1 call to warnings::import |
3 | |||||
4 | package Test::Deep; | ||||
5 | 3 | 22µs | 2 | 85µ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 # spent 47µs making 1 call to Test::Deep::BEGIN@5
# spent 38µs making 1 call to Exporter::import |
6 | |||||
7 | 3 | 71µs | 1 | 905µ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 # spent 905µs making 1 call to Test::Deep::BEGIN@7 |
8 | 3 | 72µs | 1 | 900µ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 # spent 900µs making 1 call to Test::Deep::BEGIN@8 |
9 | 3 | 76µs | 1 | 126µ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 # spent 126µs making 1 call to Test::Deep::BEGIN@9 |
10 | |||||
11 | 1 | 1µs | require overload; | ||
12 | 3 | 254µs | 2 | 37µ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 # spent 23µs making 1 call to Test::Deep::BEGIN@12
# spent 14µs making 1 call to Exporter::import |
13 | |||||
14 | 1 | 100ns | my $Test; | ||
15 | 1 | 1µs | unless (defined $Test::Deep::NoTest::NoTest) | ||
16 | { | ||||
17 | # for people who want eq_deeply but not Test::Builder | ||||
18 | 1 | 600ns | require Test::Builder; | ||
19 | 1 | 5µs | 1 | 6µs | $Test = Test::Builder->new; # spent 6µs making 1 call to Test::Builder::new |
20 | } | ||||
21 | |||||
22 | 1 | 500ns | our ($Stack, %Compared, $CompareCache, %WrapCache, $Shallow); | ||
23 | |||||
24 | 1 | 400ns | our $VERSION = '0.109'; | ||
25 | 1 | 20µs | $VERSION = eval $VERSION; # spent 2µs executing statements in string eval | ||
26 | |||||
27 | 1 | 700ns | require Exporter; | ||
28 | 1 | 11µs | our @ISA = qw( Exporter ); | ||
29 | |||||
30 | 1 | 300ns | our $Snobby = 1; # should we compare classes? | ||
31 | 1 | 200ns | our $Expects = 0; # are we comparing got vs expect or expect vs expect | ||
32 | |||||
33 | 1 | 300ns | our $DNE = \""; | ||
34 | 1 | 7µs | 1 | 2µs | our $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 | ||||
37 | 1 | 24µs | my %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 | |||||
69 | 1 | 300ns | our @CONSTRUCTORS_FROM_CLASSES; | ||
70 | |||||
71 | 1 | 32µs | while (my ($pkg, $name) = each %constructors) | ||
72 | { | ||||
73 | 29 | 8µs | $name = lc($pkg) unless $name; | ||
74 | 29 | 13µs | my $full_pkg = "Test::Deep::$pkg"; | ||
75 | 29 | 13µs | my $file = "$full_pkg.pm"; | ||
76 | 29 | 91µs | 29 | 45µ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 | 29 | 59µs | }; | ||
81 | { | ||||
82 | 32 | 1.44ms | 2 | 25µ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 # spent 16µs making 1 call to Test::Deep::BEGIN@82
# spent 9µs making 1 call to strict::unimport |
83 | 29 | 42µs | *{$name} = $sub; | ||
84 | } | ||||
85 | |||||
86 | 29 | 25µs | push @CONSTRUCTORS_FROM_CLASSES, $name; | ||
87 | } | ||||
88 | |||||
89 | { | ||||
90 | 2 | 6µs | our @EXPORT_OK = qw( descend render_stack class_base cmp_details deep_diag ); | ||
91 | |||||
92 | 1 | 300ns | our %EXPORT_TAGS; | ||
93 | 1 | 13µs | $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 | 1 | 23µs | our @EXPORT = @{ $EXPORT_TAGS{ v0 } }; | ||
107 | |||||
108 | 1 | 6µs | $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). | ||||
116 | sub isa | ||||
117 | { | ||||
118 | if (@_ == 1) | ||||
119 | { | ||||
120 | goto &Isa; | ||||
121 | } | ||||
122 | else | ||||
123 | { | ||||
124 | goto &UNIVERSAL::isa; | ||||
125 | } | ||||
126 | } | ||||
127 | |||||
128 | sub 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 | |||||
143 | sub 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 | |||||
156 | sub eq_deeply | ||||
157 | { | ||||
158 | my ($d1, $d2) = @_; | ||||
159 | |||||
160 | my ($ok) = cmp_details($d1, $d2); | ||||
161 | |||||
162 | return $ok | ||||
163 | } | ||||
164 | |||||
165 | sub 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 | |||||
186 | sub 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 | ||||
229 | expect : $expected | ||||
230 | EOM | ||||
231 | } | ||||
232 | |||||
233 | return $diag; | ||||
234 | } | ||||
235 | |||||
236 | sub 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 | |||||
258 | sub 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 | |||||
342 | sub 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 | |||||
388 | sub 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 | |||||
413 | sub render_stack | ||||
414 | { | ||||
415 | my ($var, $stack) = @_; | ||||
416 | |||||
417 | return $stack->render($var); | ||||
418 | } | ||||
419 | |||||
420 | sub cmp_methods | ||||
421 | { | ||||
422 | local $Test::Builder::Level = $Test::Builder::Level + 1; | ||||
423 | return cmp_deeply(shift, methods(@{shift()}), shift); | ||||
424 | } | ||||
425 | |||||
426 | sub 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 | |||||
437 | 1 | 1µs | *useclass = \&requireclass; | ||
438 | |||||
439 | sub noclass | ||||
440 | { | ||||
441 | require Test::Deep::Class; | ||||
442 | |||||
443 | my $val = shift; | ||||
444 | |||||
445 | return Test::Deep::Class->new(0, $val); | ||||
446 | } | ||||
447 | |||||
448 | sub set | ||||
449 | { | ||||
450 | require Test::Deep::Set; | ||||
451 | |||||
452 | return Test::Deep::Set->new(1, "", @_); | ||||
453 | } | ||||
454 | |||||
455 | sub supersetof | ||||
456 | { | ||||
457 | require Test::Deep::Set; | ||||
458 | |||||
459 | return Test::Deep::Set->new(1, "sup", @_); | ||||
460 | } | ||||
461 | |||||
462 | sub subsetof | ||||
463 | { | ||||
464 | require Test::Deep::Set; | ||||
465 | |||||
466 | return Test::Deep::Set->new(1, "sub", @_); | ||||
467 | } | ||||
468 | |||||
469 | sub cmp_set | ||||
470 | { | ||||
471 | local $Test::Builder::Level = $Test::Builder::Level + 1; | ||||
472 | return cmp_deeply(shift, set(@{shift()}), shift); | ||||
473 | } | ||||
474 | |||||
475 | sub bag | ||||
476 | { | ||||
477 | require Test::Deep::Set; | ||||
478 | |||||
479 | return Test::Deep::Set->new(0, "", @_); | ||||
480 | } | ||||
481 | |||||
482 | sub superbagof | ||||
483 | { | ||||
484 | require Test::Deep::Set; | ||||
485 | |||||
486 | return Test::Deep::Set->new(0, "sup", @_); | ||||
487 | } | ||||
488 | |||||
489 | sub subbagof | ||||
490 | { | ||||
491 | require Test::Deep::Set; | ||||
492 | |||||
493 | return Test::Deep::Set->new(0, "sub", @_); | ||||
494 | } | ||||
495 | |||||
496 | sub 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 | |||||
505 | sub superhashof | ||||
506 | { | ||||
507 | require Test::Deep::Hash; | ||||
508 | |||||
509 | my $val = shift; | ||||
510 | |||||
511 | return Test::Deep::SuperHash->new($val); | ||||
512 | } | ||||
513 | |||||
514 | sub subhashof | ||||
515 | { | ||||
516 | require Test::Deep::Hash; | ||||
517 | |||||
518 | my $val = shift; | ||||
519 | |||||
520 | return Test::Deep::SubHash->new($val); | ||||
521 | } | ||||
522 | |||||
523 | sub builder | ||||
524 | { | ||||
525 | if (@_) | ||||
526 | { | ||||
527 | $Test = shift; | ||||
528 | } | ||||
529 | return $Test; | ||||
530 | } | ||||
531 | |||||
532 | 1 | 31µs | 1; | ||
533 | |||||
534 | __END__ |