← 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:24:08 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/Test/Builder.pm
StatementsExecuted 1402 statements in 10.8ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
522632µs3.46msTest::Builder::::okTest::Builder::ok
2231626µs920µsTest::Builder::::_tryTest::Builder::_try
411557µs3.58msTest::Builder::::cmp_okTest::Builder::cmp_ok
1921548µs621µsTest::Builder::::callerTest::Builder::caller
1011294µs1.10msTest::Builder::::_unoverloadTest::Builder::_unoverload
611252µs528µsTest::Builder::::_print_to_fhTest::Builder::_print_to_fh
1521207µs660µsTest::Builder::::find_TODOTest::Builder::find_TODO
611203µs203µsTest::Builder::::CORE:printTest::Builder::CORE:print (opcode)
211175µs220µsTest::Builder::::__ANON__[:1906]Test::Builder::__ANON__[:1906]
1011143µs452µsTest::Builder::::_is_objectTest::Builder::_is_object
1021135µs1.24msTest::Builder::::_unoverload_strTest::Builder::_unoverload_str
1021109µs532µsTest::Builder::::in_todoTest::Builder::in_todo
11196µs117µsTest::Builder::::_endingTest::Builder::_ending
62195µs653µsTest::Builder::::_printTest::Builder::_print
51176µs313µsTest::Builder::::todoTest::Builder::todo
191174µs74µsTest::Builder::::levelTest::Builder::level
22171µs71µsTest::Builder::::CORE:openTest::Builder::CORE:open (opcode)
51163µs91µsTest::Builder::::_check_is_passing_planTest::Builder::_check_is_passing_plan
41160µs3.64msTest::Builder::::is_eqTest::Builder::is_eq
11158µs205µsTest::Builder::::done_testingTest::Builder::done_testing
93351µs580µsTest::Builder::::newTest::Builder::new
112141µs41µsTest::Builder::::CORE:matchTest::Builder::CORE:match (opcode)
101140µs40µsTest::Builder::::__ANON__[:871]Test::Builder::__ANON__[:871]
11140µs515µsTest::Builder::::resetTest::Builder::reset
72138µs48µsTest::Builder::::outputTest::Builder::output
112135µs35µsTest::Builder::::CORE:substTest::Builder::CORE:subst (opcode)
101133µs33µsTest::Builder::::__ANON__[:887]Test::Builder::__ANON__[:887]
61132µs32µsTest::Builder::::_indentTest::Builder::_indent
51128µs28µsTest::Builder::::has_planTest::Builder::has_plan
51127µs27µsTest::Builder::::use_numbersTest::Builder::use_numbers
84126µs26µsTest::Builder::::__ANON__[:66]Test::Builder::__ANON__[:66]
44125µs32µsTest::Builder::::_autoflushTest::Builder::_autoflush
11124µs118µsTest::Builder::::_output_planTest::Builder::_output_plan
21122µs31µsTest::Builder::::_apply_layersTest::Builder::_apply_layers
11122µs365µsTest::Builder::::_open_testhandlesTest::Builder::_open_testhandles
11121µs21µsTest::Builder::::BEGIN@3Test::Builder::BEGIN@3
62120µs20µsTest::Builder::::__ANON__[:67]Test::Builder::__ANON__[:67]
11119µs24µsTest::Builder::::BEGIN@18Test::Builder::BEGIN@18
11119µs469µsTest::Builder::::_dup_stdhandlesTest::Builder::_dup_stdhandles
22118µs272µsTest::Builder::::_copy_io_layersTest::Builder::_copy_io_layers
11117µs20µsTest::Builder::::current_testTest::Builder::current_test
11117µs40µsTest::Builder::::BEGIN@916Test::Builder::BEGIN@916
11116µs132µsTest::Builder::::ENDTest::Builder::END
11114µs529µsTest::Builder::::createTest::Builder::create
33113µs21µsTest::Builder::::_new_fhTest::Builder::_new_fh
11113µs52µsTest::Builder::::reset_outputsTest::Builder::reset_outputs
11112µs26µsTest::Builder::::BEGIN@19Test::Builder::BEGIN@19
11110µs27µsTest::Builder::::BEGIN@1600Test::Builder::BEGIN@1600
1119µs9µsTest::Builder::::__ANON__[:1598]Test::Builder::__ANON__[:1598]
2119µs9µsTest::Builder::::CORE:binmodeTest::Builder::CORE:binmode (opcode)
1118µs18µsTest::Builder::::BEGIN@1221Test::Builder::BEGIN@1221
1118µs8µsTest::Builder::::expected_testsTest::Builder::expected_tests
1117µs19µsTest::Builder::::BEGIN@2181Test::Builder::BEGIN@2181
8217µs7µsTest::Builder::::CORE:selectTest::Builder::CORE:select (opcode)
3117µs7µsTest::Builder::::is_fhTest::Builder::is_fh
1117µs15µsTest::Builder::::BEGIN@5Test::Builder::BEGIN@5
1116µs6µsTest::Builder::::_my_exitTest::Builder::_my_exit
1116µs11µsTest::Builder::::failure_outputTest::Builder::failure_output
1116µs8µsTest::Builder::::BEGIN@4Test::Builder::BEGIN@4
1116µs11µsTest::Builder::::todo_outputTest::Builder::todo_output
1115µs5µsTest::Builder::::exported_toTest::Builder::exported_to
1114µs4µsTest::Builder::::BEGIN@10Test::Builder::BEGIN@10
1113µs3µsTest::Builder::::planTest::Builder::plan
1112µs2µsTest::Builder::::is_passingTest::Builder::is_passing
0000s0sTest::Builder::::BAIL_OUTTest::Builder::BAIL_OUT
0000s0sTest::Builder::::DESTROYTest::Builder::DESTROY
0000s0sTest::Builder::::__ANON__[:1712]Test::Builder::__ANON__[:1712]
0000s0sTest::Builder::::__ANON__[:237]Test::Builder::__ANON__[:237]
0000s0sTest::Builder::::__ANON__[:61]Test::Builder::__ANON__[:61]
0000s0sTest::Builder::::_caller_contextTest::Builder::_caller_context
0000s0sTest::Builder::::_cmp_diagTest::Builder::_cmp_diag
0000s0sTest::Builder::::_diag_fhTest::Builder::_diag_fh
0000s0sTest::Builder::::_diag_fmtTest::Builder::_diag_fmt
0000s0sTest::Builder::::_is_diagTest::Builder::_is_diag
0000s0sTest::Builder::::_is_dualvarTest::Builder::_is_dualvar
0000s0sTest::Builder::::_is_qrTest::Builder::_is_qr
0000s0sTest::Builder::::_isnt_diagTest::Builder::_isnt_diag
0000s0sTest::Builder::::_message_at_callerTest::Builder::_message_at_caller
0000s0sTest::Builder::::_plan_handledTest::Builder::_plan_handled
0000s0sTest::Builder::::_plan_testsTest::Builder::_plan_tests
0000s0sTest::Builder::::_print_commentTest::Builder::_print_comment
0000s0sTest::Builder::::_regex_okTest::Builder::_regex_ok
0000s0sTest::Builder::::_sanity_checkTest::Builder::_sanity_check
0000s0sTest::Builder::::_unoverload_numTest::Builder::_unoverload_num
0000s0sTest::Builder::::_whoaTest::Builder::_whoa
0000s0sTest::Builder::::carpTest::Builder::carp
0000s0sTest::Builder::::childTest::Builder::child
0000s0sTest::Builder::::croakTest::Builder::croak
0000s0sTest::Builder::::detailsTest::Builder::details
0000s0sTest::Builder::::diagTest::Builder::diag
0000s0sTest::Builder::::explainTest::Builder::explain
0000s0sTest::Builder::::finalizeTest::Builder::finalize
0000s0sTest::Builder::::is_numTest::Builder::is_num
0000s0sTest::Builder::::isnt_eqTest::Builder::isnt_eq
0000s0sTest::Builder::::isnt_numTest::Builder::isnt_num
0000s0sTest::Builder::::likeTest::Builder::like
0000s0sTest::Builder::::maybe_regexTest::Builder::maybe_regex
0000s0sTest::Builder::::nameTest::Builder::name
0000s0sTest::Builder::::no_planTest::Builder::no_plan
0000s0sTest::Builder::::noteTest::Builder::note
0000s0sTest::Builder::::parentTest::Builder::parent
0000s0sTest::Builder::::skipTest::Builder::skip
0000s0sTest::Builder::::skip_allTest::Builder::skip_all
0000s0sTest::Builder::::subtestTest::Builder::subtest
0000s0sTest::Builder::::summaryTest::Builder::summary
0000s0sTest::Builder::::todo_endTest::Builder::todo_end
0000s0sTest::Builder::::todo_skipTest::Builder::todo_skip
0000s0sTest::Builder::::todo_startTest::Builder::todo_start
0000s0sTest::Builder::::unlikeTest::Builder::unlike
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Test::Builder;
2
3330µs121µs
# spent 21µs within Test::Builder::BEGIN@3 which was called: # once (21µs+0s) by Test::Builder::Module::BEGIN@5 at line 3
use 5.006;
# spent 21µs making 1 call to Test::Builder::BEGIN@3
4316µs210µs
# spent 8µs (6+2) within Test::Builder::BEGIN@4 which was called: # once (6µs+2µs) by Test::Builder::Module::BEGIN@5 at line 4
use strict;
# spent 8µs making 1 call to Test::Builder::BEGIN@4 # spent 2µs making 1 call to strict::import
5345µs223µs
# spent 15µs (7+8) within Test::Builder::BEGIN@5 which was called: # once (7µs+8µs) by Test::Builder::Module::BEGIN@5 at line 5
use warnings;
# spent 15µs making 1 call to Test::Builder::BEGIN@5 # spent 8µs making 1 call to warnings::import
6
71700nsour $VERSION = '0.98';
8117µs$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
# spent 3µs executing statements in string eval
9
10
# spent 4µs within Test::Builder::BEGIN@10 which was called: # once (4µs+0s) by Test::Builder::Module::BEGIN@5 at line 14
BEGIN {
1116µs if( $] < 5.008 ) {
12 require Test::Builder::IO::Scalar;
13 }
14118µs14µs}
# spent 4µs making 1 call to Test::Builder::BEGIN@10
15
16
17# Make Test::Builder thread-safe for ithreads.
18
# spent 24µs (19+4) within Test::Builder::BEGIN@18 which was called: # once (19µs+4µs) by Test::Builder::Module::BEGIN@5 at line 69
BEGIN {
193194µs241µs
# spent 26µs (12+15) within Test::Builder::BEGIN@19 which was called: # once (12µs+15µs) by Test::Builder::Module::BEGIN@5 at line 19
use Config;
# spent 26µs making 1 call to Test::Builder::BEGIN@19 # spent 14µs making 1 call to Config::import
20 # Load threads::shared when threads are turned on.
21 # 5.8.0's threads are so busted we no longer support them.
22111µs14µs if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'} ) {
# spent 4µs making 1 call to Config::FETCH
23 require threads::shared;
24
25 # Hack around YET ANOTHER threads::shared bug. It would
26 # occasionally forget the contents of the variable when sharing it.
27 # So we first copy the data, then share, then put our copy back.
28 *share = sub (\[$@%]) {
29 my $type = ref $_[0];
30 my $data;
31
32 if( $type eq 'HASH' ) {
33 %$data = %{ $_[0] };
34 }
35 elsif( $type eq 'ARRAY' ) {
36 @$data = @{ $_[0] };
37 }
38 elsif( $type eq 'SCALAR' ) {
39 $$data = ${ $_[0] };
40 }
41 else {
42 die( "Unknown type: " . $type );
43 }
44
45 $_[0] = &threads::shared::share( $_[0] );
46
47 if( $type eq 'HASH' ) {
48 %{ $_[0] } = %$data;
49 }
50 elsif( $type eq 'ARRAY' ) {
51 @{ $_[0] } = @$data;
52 }
53 elsif( $type eq 'SCALAR' ) {
54 ${ $_[0] } = $$data;
55 }
56 else {
57 die( "Unknown type: " . $type );
58 }
59
60 return $_[0];
61 };
62 }
63 # 5.8.0's threads::shared is busted when threads are off
64 # and earlier Perls just don't have that module at all.
65 else {
66951µs
# spent 26µs within Test::Builder::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/Test/Builder.pm:66] which was called 8 times, avg 3µs/call: # 5 times (18µs+0s) by Test::Builder::ok at line 795, avg 4µs/call # once (5µs+0s) by Test::Builder::_ending at line 2430 # once (3µs+0s) by Test::Builder::reset at line 418 # once (1µs+0s) by Test::Builder::reset at line 420
*share = sub { return $_[0] };
67752µs
# spent 20µs within Test::Builder::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/Test/Builder.pm:67] which was called 6 times, avg 3µs/call: # 5 times (17µs+0s) by Test::Builder::ok at line 775, avg 3µs/call # once (3µs+0s) by Test::Builder::current_test at line 1997
*lock = sub { 0 };
68 }
6911.87ms124µs}
# spent 24µs making 1 call to Test::Builder::BEGIN@18
70
71=head1 NAME
72
73Test::Builder - Backend for building test libraries
74
75=head1 SYNOPSIS
76
77 package My::Test::Module;
78 use base 'Test::Builder::Module';
79
80 my $CLASS = __PACKAGE__;
81
82 sub ok {
83 my($test, $name) = @_;
84 my $tb = $CLASS->builder;
85
86 $tb->ok($test, $name);
87 }
88
89
90=head1 DESCRIPTION
91
92Test::Simple and Test::More have proven to be popular testing modules,
93but they're not always flexible enough. Test::Builder provides a
94building block upon which to write your own test libraries I<which can
95work together>.
96
97=head2 Construction
98
99=over 4
100
101=item B<new>
102
103 my $Test = Test::Builder->new;
104
105Returns a Test::Builder object representing the current state of the
106test.
107
108Since you only run one test per program C<new> always returns the same
109Test::Builder object. No matter how many times you call C<new()>, you're
110getting the same object. This is called a singleton. This is done so that
111multiple modules share such global information as the test counter and
112where test output is going.
113
114If you want a completely new Test::Builder object different from the
115singleton, use C<create>.
116
117=cut
118
11914µs1539µsour $Test = Test::Builder->new;
# spent 539µs making 1 call to Test::Builder::new
120
121
# spent 580µs (51+529) within Test::Builder::new which was called 9 times, avg 64µs/call: # 7 times (35µs+0s) by Test::Builder::Module::builder at line 170 of Test/Builder/Module.pm, avg 5µs/call # once (10µs+529µs) by Test::Builder::Module::BEGIN@5 at line 119 # once (6µs+0s) by main::BEGIN@22 at line 19 of Test/Deep.pm
sub new {
122914µs my($class) = shift;
12399µs1529µs $Test ||= $class->create;
# spent 529µs making 1 call to Test::Builder::create
124954µs return $Test;
125}
126
127=item B<create>
128
129 my $Test = Test::Builder->create;
130
131Ok, so there can be more than one Test::Builder object and this is how
132you get it. You might use this instead of C<new()> if you're testing
133a Test::Builder based module, but otherwise you probably want C<new>.
134
135B<NOTE>: the implementation is not complete. C<level>, for example, is
136still shared amongst B<all> Test::Builder objects, even ones created using
137this method. Also, the method name may change in the future.
138
139=cut
140
141
# spent 529µs (14+515) within Test::Builder::create which was called: # once (14µs+515µs) by Test::Builder::new at line 123
sub create {
1421700ns my $class = shift;
143
14418µs my $self = bless {}, $class;
14512µs1515µs $self->reset;
# spent 515µs making 1 call to Test::Builder::reset
146
14715µs return $self;
148}
149
150=item B<child>
151
152 my $child = $builder->child($name_of_child);
153 $child->plan( tests => 4 );
154 $child->ok(some_code());
155 ...
156 $child->finalize;
157
158Returns a new instance of C<Test::Builder>. Any output from this child will
159be indented four spaces more than the parent's indentation. When done, the
160C<finalize> method I<must> be called explicitly.
161
162Trying to create a new child with a previous child still active (i.e.,
163C<finalize> not called) will C<croak>.
164
165Trying to run a test when you have an open child will also C<croak> and cause
166the test suite to fail.
167
168=cut
169
170sub child {
171 my( $self, $name ) = @_;
172
173 if( $self->{Child_Name} ) {
174 $self->croak("You already have a child named ($self->{Child_Name}) running");
175 }
176
177 my $parent_in_todo = $self->in_todo;
178
179 # Clear $TODO for the child.
180 my $orig_TODO = $self->find_TODO(undef, 1, undef);
181
182 my $child = bless {}, ref $self;
183 $child->reset;
184
185 # Add to our indentation
186 $child->_indent( $self->_indent . ' ' );
187
188 $child->{$_} = $self->{$_} foreach qw{Out_FH Todo_FH Fail_FH};
189 if ($parent_in_todo) {
190 $child->{Fail_FH} = $self->{Todo_FH};
191 }
192
193 # This will be reset in finalize. We do this here lest one child failure
194 # cause all children to fail.
195 $child->{Child_Error} = $?;
196 $? = 0;
197 $child->{Parent} = $self;
198 $child->{Parent_TODO} = $orig_TODO;
199 $child->{Name} = $name || "Child of " . $self->name;
200 $self->{Child_Name} = $child->name;
201 return $child;
202}
203
204
205=item B<subtest>
206
207 $builder->subtest($name, \&subtests);
208
209See documentation of C<subtest> in Test::More.
210
211=cut
212
213sub subtest {
214 my $self = shift;
215 my($name, $subtests) = @_;
216
217 if ('CODE' ne ref $subtests) {
218 $self->croak("subtest()'s second argument must be a code ref");
219 }
220
221 # Turn the child into the parent so anyone who has stored a copy of
222 # the Test::Builder singleton will get the child.
223 my($error, $child, %parent);
224 {
225 # child() calls reset() which sets $Level to 1, so we localize
226 # $Level first to limit the scope of the reset to the subtest.
227 local $Test::Builder::Level = $Test::Builder::Level + 1;
228
229 $child = $self->child($name);
230 %parent = %$self;
231 %$self = %$child;
232
233 my $run_the_subtests = sub {
234 $subtests->();
235 $self->done_testing unless $self->_plan_handled;
236 1;
237 };
238
239 if( !eval { $run_the_subtests->() } ) {
240 $error = $@;
241 }
242 }
243
244 # Restore the parent and the copied child.
245 %$child = %$self;
246 %$self = %parent;
247
248 # Restore the parent's $TODO
249 $self->find_TODO(undef, 1, $child->{Parent_TODO});
250
251 # Die *after* we restore the parent.
252 die $error if $error and !eval { $error->isa('Test::Builder::Exception') };
253
254 local $Test::Builder::Level = $Test::Builder::Level + 1;
255 return $child->finalize;
256}
257
258=begin _private
259
260=item B<_plan_handled>
261
262 if ( $Test->_plan_handled ) { ... }
263
264Returns true if the developer has explicitly handled the plan via:
265
266=over 4
267
268=item * Explicitly setting the number of tests
269
270=item * Setting 'no_plan'
271
272=item * Set 'skip_all'.
273
274=back
275
276This is currently used in subtests when we implicitly call C<< $Test->done_testing >>
277if the developer has not set a plan.
278
279=end _private
280
281=cut
282
283sub _plan_handled {
284 my $self = shift;
285 return $self->{Have_Plan} || $self->{No_Plan} || $self->{Skip_All};
286}
287
288
289=item B<finalize>
290
291 my $ok = $child->finalize;
292
293When your child is done running tests, you must call C<finalize> to clean up
294and tell the parent your pass/fail status.
295
296Calling finalize on a child with open children will C<croak>.
297
298If the child falls out of scope before C<finalize> is called, a failure
299diagnostic will be issued and the child is considered to have failed.
300
301No attempt to call methods on a child after C<finalize> is called is
302guaranteed to succeed.
303
304Calling this on the root builder is a no-op.
305
306=cut
307
308sub finalize {
309 my $self = shift;
310
311 return unless $self->parent;
312 if( $self->{Child_Name} ) {
313 $self->croak("Can't call finalize() with child ($self->{Child_Name}) active");
314 }
315
316 local $? = 0; # don't fail if $subtests happened to set $? nonzero
317 $self->_ending;
318
319 # XXX This will only be necessary for TAP envelopes (we think)
320 #$self->_print( $self->is_passing ? "PASS\n" : "FAIL\n" );
321
322 local $Test::Builder::Level = $Test::Builder::Level + 1;
323 my $ok = 1;
324 $self->parent->{Child_Name} = undef;
325 if ( $self->{Skip_All} ) {
326 $self->parent->skip($self->{Skip_All});
327 }
328 elsif ( not @{ $self->{Test_Results} } ) {
329 $self->parent->ok( 0, sprintf q[No tests run for subtest "%s"], $self->name );
330 }
331 else {
332 $self->parent->ok( $self->is_passing, $self->name );
333 }
334 $? = $self->{Child_Error};
335 delete $self->{Parent};
336
337 return $self->is_passing;
338}
339
340
# spent 32µs within Test::Builder::_indent which was called 6 times, avg 5µs/call: # 6 times (32µs+0s) by Test::Builder::_print_to_fh at line 1748, avg 5µs/call
sub _indent {
34165µs my $self = shift;
342
34364µs if( @_ ) {
344 $self->{Indent} = shift;
345 }
346
347643µs return $self->{Indent};
348}
349
350=item B<parent>
351
352 if ( my $parent = $builder->parent ) {
353 ...
354 }
355
356Returns the parent C<Test::Builder> instance, if any. Only used with child
357builders for nested TAP.
358
359=cut
360
361sub parent { shift->{Parent} }
362
363=item B<name>
364
365 diag $builder->name;
366
367Returns the name of the current builder. Top level builders default to C<$0>
368(the name of the executable). Child builders are named via the C<child>
369method. If no name is supplied, will be named "Child of $parent->name".
370
371=cut
372
373sub name { shift->{Name} }
374
375sub DESTROY {
376 my $self = shift;
377 if ( $self->parent and $$ == $self->{Original_Pid} ) {
378 my $name = $self->name;
379 $self->diag(<<"FAIL");
380Child ($name) exited without calling finalize()
381FAIL
382 $self->parent->{In_Destroy} = 1;
383 $self->parent->ok(0, $name);
384 }
385}
386
387=item B<reset>
388
389 $Test->reset;
390
391Reinitializes the Test::Builder singleton to its original state.
392Mostly useful for tests run in persistent environments where the same
393test might be run multiple times in the same process.
394
395=cut
396
3971100nsour $Level;
398
399
# spent 515µs (40+475) within Test::Builder::reset which was called: # once (40µs+475µs) by Test::Builder::create at line 145
sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
4001800ns my($self) = @_;
401
402 # We leave this a global because it has to be localized and localizing
403 # hash keys is just asking for pain. Also, it was documented.
4041400ns $Level = 1;
405
40612µs $self->{Name} = $0;
40711µs12µs $self->is_passing(1);
# spent 2µs making 1 call to Test::Builder::is_passing
4081600ns $self->{Ending} = 0;
4091700ns $self->{Have_Plan} = 0;
4101500ns $self->{No_Plan} = 0;
4111800ns $self->{Have_Output_Plan} = 0;
4121700ns $self->{Done_Testing} = 0;
413
4141700ns $self->{Original_Pid} = $$;
41512µs $self->{Child_Name} = undef;
41612µs $self->{Indent} ||= '';
417
41814µs13µs share( $self->{Curr_Test} );
# spent 3µs making 1 call to Test::Builder::__ANON__[Test/Builder.pm:66]
4191700ns $self->{Curr_Test} = 0;
42012µs11µs $self->{Test_Results} = &share( [] );
# spent 1µs making 1 call to Test::Builder::__ANON__[Test/Builder.pm:66]
421
4221700ns $self->{Exported_To} = undef;
4231700ns $self->{Expected_Tests} = 0;
424
4251600ns $self->{Skip_All} = 0;
426
4271800ns $self->{Use_Nums} = 1;
428
42911µs $self->{No_Header} = 0;
43011µs $self->{No_Ending} = 0;
431
4321600ns $self->{Todo} = undef;
4331900ns $self->{Todo_Stack} = [];
4341800ns $self->{Start_Todo} = 0;
4351500ns $self->{Opened_Testhandles} = 0;
436
43711µs1469µs $self->_dup_stdhandles;
# spent 469µs making 1 call to Test::Builder::_dup_stdhandles
438
43914µs return;
440}
441
442=back
443
444=head2 Setting up tests
445
446These methods are for setting up tests and declaring how many there
447are. You usually only want to call one of these methods.
448
449=over 4
450
451=item B<plan>
452
453 $Test->plan('no_plan');
454 $Test->plan( skip_all => $reason );
455 $Test->plan( tests => $num_tests );
456
457A convenient way to set up your tests. Call this and Test::Builder
458will print the appropriate headers and take the appropriate actions.
459
460If you call C<plan()>, don't call any of the other methods below.
461
462If a child calls "skip_all" in the plan, a C<Test::Builder::Exception> is
463thrown. Trap this error, call C<finalize()> and don't run any more tests on
464the child.
465
466 my $child = $Test->child('some child');
467 eval { $child->plan( $condition ? ( skip_all => $reason ) : ( tests => 3 ) ) };
468 if ( eval { $@->isa('Test::Builder::Exception') } ) {
469 $child->finalize;
470 return;
471 }
472 # run your tests
473
474=cut
475
47615µsmy %plan_cmds = (
477 no_plan => \&no_plan,
478 skip_all => \&skip_all,
479 tests => \&_plan_tests,
480);
481
482
# spent 3µs within Test::Builder::plan which was called: # once (3µs+0s) by Test::Builder::Module::import at line 91 of Test/Builder/Module.pm
sub plan {
4831900ns my( $self, $cmd, $arg ) = @_;
484
48514µs return unless $cmd;
486
487 local $Level = $Level + 1;
488
489 $self->croak("You tried to plan twice") if $self->{Have_Plan};
490
491 if( my $method = $plan_cmds{$cmd} ) {
492 local $Level = $Level + 1;
493 $self->$method($arg);
494 }
495 else {
496 my @args = grep { defined } ( $cmd, $arg );
497 $self->croak("plan() doesn't understand @args");
498 }
499
500 return 1;
501}
502
503
504sub _plan_tests {
505 my($self, $arg) = @_;
506
507 if($arg) {
508 local $Level = $Level + 1;
509 return $self->expected_tests($arg);
510 }
511 elsif( !defined $arg ) {
512 $self->croak("Got an undefined number of tests");
513 }
514 else {
515 $self->croak("You said to run 0 tests");
516 }
517
518 return;
519}
520
521=item B<expected_tests>
522
523 my $max = $Test->expected_tests;
524 $Test->expected_tests($max);
525
526Gets/sets the number of tests we expect this test to run and prints out
527the appropriate headers.
528
529=cut
530
531
# spent 8µs within Test::Builder::expected_tests which was called: # once (8µs+0s) by Test::Builder::done_testing at line 659
sub expected_tests {
53211µs my $self = shift;
53311µs my($max) = @_;
534
53511µs if(@_) {
536 $self->croak("Number of tests must be a positive integer. You gave it '$max'")
537 unless $max =~ /^\+?\d+$/;
538
539 $self->{Expected_Tests} = $max;
540 $self->{Have_Plan} = 1;
541
542 $self->_output_plan($max) unless $self->no_header;
543 }
544110µs return $self->{Expected_Tests};
545}
546
547=item B<no_plan>
548
549 $Test->no_plan;
550
551Declares that this test will run an indeterminate number of tests.
552
553=cut
554
555sub no_plan {
556 my($self, $arg) = @_;
557
558 $self->carp("no_plan takes no arguments") if $arg;
559
560 $self->{No_Plan} = 1;
561 $self->{Have_Plan} = 1;
562
563 return 1;
564}
565
566=begin private
567
568=item B<_output_plan>
569
570 $tb->_output_plan($max);
571 $tb->_output_plan($max, $directive);
572 $tb->_output_plan($max, $directive => $reason);
573
574Handles displaying the test plan.
575
576If a C<$directive> and/or C<$reason> are given they will be output with the
577plan. So here's what skipping all tests looks like:
578
579 $tb->_output_plan(0, "SKIP", "Because I said so");
580
581It sets C<< $tb->{Have_Output_Plan} >> and will croak if the plan was already
582output.
583
584=end private
585
586=cut
587
588
# spent 118µs (24+94) within Test::Builder::_output_plan which was called: # once (24µs+94µs) by Test::Builder::done_testing at line 667
sub _output_plan {
58913µs my($self, $max, $directive, $reason) = @_;
590
59111µs $self->carp("The plan was already output") if $self->{Have_Output_Plan};
592
59312µs my $plan = "1..$max";
5941600ns $plan .= " # $directive" if defined $directive;
5951700ns $plan .= " $reason" if defined $reason;
596
59715µs194µs $self->_print("$plan\n");
# spent 94µs making 1 call to Test::Builder::_print
598
59912µs $self->{Have_Output_Plan} = 1;
600
601110µs return;
602}
603
604
605=item B<done_testing>
606
607 $Test->done_testing();
608 $Test->done_testing($num_tests);
609
610Declares that you are done testing, no more tests will be run after this point.
611
612If a plan has not yet been output, it will do so.
613
614$num_tests is the number of tests you planned to run. If a numbered
615plan was already declared, and if this contradicts, a failing test
616will be run to reflect the planning mistake. If C<no_plan> was declared,
617this will override.
618
619If C<done_testing()> is called twice, the second call will issue a
620failing test.
621
622If C<$num_tests> is omitted, the number of tests run will be used, like
623no_plan.
624
625C<done_testing()> is, in effect, used when you'd want to use C<no_plan>, but
626safer. You'd use it like so:
627
628 $Test->ok($a == $b);
629 $Test->done_testing();
630
631Or to plan a variable number of tests:
632
633 for my $test (@tests) {
634 $Test->ok($test);
635 }
636 $Test->done_testing(@tests);
637
638=cut
639
640
# spent 205µs (58+146) within Test::Builder::done_testing which was called: # once (58µs+146µs) by Test::More::done_testing at line 221 of Test/More.pm
sub done_testing {
64112µs my($self, $num_tests) = @_;
642
643 # If done_testing() specified the number of tests, shut off no_plan.
64412µs if( defined $num_tests ) {
645 $self->{No_Plan} = 0;
646 }
647 else {
64816µs120µs $num_tests = $self->current_test;
# spent 20µs making 1 call to Test::Builder::current_test
649 }
650
65112µs if( $self->{Done_Testing} ) {
652 my($file, $line) = @{$self->{Done_Testing}}[1,2];
653 $self->ok(0, "done_testing() was already called at $file line $line");
654 return;
655 }
656
65717µs $self->{Done_Testing} = [caller];
658
65916µs18µs if( $self->expected_tests && $num_tests != $self->expected_tests ) {
# spent 8µs making 1 call to Test::Builder::expected_tests
660 $self->ok(0, "planned to run @{[ $self->expected_tests ]} ".
661 "but done_testing() expects $num_tests");
662 }
663 else {
66412µs $self->{Expected_Tests} = $num_tests;
665 }
666
66716µs1118µs $self->_output_plan($num_tests) unless $self->{Have_Output_Plan};
# spent 118µs making 1 call to Test::Builder::_output_plan
668
66912µs $self->{Have_Plan} = 1;
670
671 # The wrong number of tests were run
67213µs $self->is_passing(0) if $self->{Expected_Tests} != $self->{Curr_Test};
673
674 # No tests were run
67511µs $self->is_passing(0) if $self->{Curr_Test} == 0;
676
67719µs return 1;
678}
679
680
681=item B<has_plan>
682
683 $plan = $Test->has_plan
684
685Find out whether a plan has been defined. C<$plan> is either C<undef> (no plan
686has been set), C<no_plan> (indeterminate # of tests) or an integer (the number
687of expected tests).
688
689=cut
690
691
# spent 28µs within Test::Builder::has_plan which was called 5 times, avg 6µs/call: # 5 times (28µs+0s) by Test::Builder::_check_is_passing_plan at line 860, avg 6µs/call
sub has_plan {
69253µs my $self = shift;
693
69456µs return( $self->{Expected_Tests} ) if $self->{Expected_Tests};
69555µs return('no_plan') if $self->{No_Plan};
696532µs return(undef);
697}
698
699=item B<skip_all>
700
701 $Test->skip_all;
702 $Test->skip_all($reason);
703
704Skips all the tests, using the given C<$reason>. Exits immediately with 0.
705
706=cut
707
708sub skip_all {
709 my( $self, $reason ) = @_;
710
711 $self->{Skip_All} = $self->parent ? $reason : 1;
712
713 $self->_output_plan(0, "SKIP", $reason) unless $self->no_header;
714 if ( $self->parent ) {
715 die bless {} => 'Test::Builder::Exception';
716 }
717 exit(0);
718}
719
720=item B<exported_to>
721
722 my $pack = $Test->exported_to;
723 $Test->exported_to($pack);
724
725Tells Test::Builder what package you exported your functions to.
726
727This method isn't terribly useful since modules which share the same
728Test::Builder object might get exported to different packages and only
729the last one will be honored.
730
731=cut
732
733
# spent 5µs within Test::Builder::exported_to which was called: # once (5µs+0s) by Test::Builder::Module::import at line 86 of Test/Builder/Module.pm
sub exported_to {
73411µs my( $self, $pack ) = @_;
735
73612µs if( defined $pack ) {
737 $self->{Exported_To} = $pack;
738 }
73914µs return $self->{Exported_To};
740}
741
742=back
743
744=head2 Running tests
745
746These actually run the tests, analogous to the functions in Test::More.
747
748They all return true if the test passed, false if the test failed.
749
750C<$name> is always optional.
751
752=over 4
753
754=item B<ok>
755
756 $Test->ok($test, $name);
757
758Your basic test. Pass if C<$test> is true, fail if $test is false. Just
759like Test::Simple's C<ok()>.
760
761=cut
762
763
# spent 3.46ms (632µs+2.83) within Test::Builder::ok which was called 5 times, avg 693µs/call: # 4 times (535µs+2.32ms) by Test::Builder::cmp_ok at line 1129, avg 714µs/call # once (97µs+508µs) by Test::More::ok at line 295 of Test/More.pm
sub ok {
764511µs my( $self, $test, $name ) = @_;
765
76658µs if ( $self->{Child_Name} and not $self->{In_Destroy} ) {
767 $name = 'unnamed test' unless defined $name;
768 $self->is_passing(0);
769 $self->croak("Cannot run test ($name) with active children");
770 }
771 # $test might contain an object which we don't want to accidentally
772 # store, so we turn it into a boolean.
77354µs $test = $test ? 1 : 0;
774
775522µs517µs lock $self->{Curr_Test};
# spent 17µs making 5 calls to Test::Builder::__ANON__[Test/Builder.pm:67], avg 3µs/call
77655µs $self->{Curr_Test}++;
777
778 # In case $name is a string overloaded object, force it to stringify.
779562µs5679µs $self->_unoverload_str( \$name );
# spent 679µs making 5 calls to Test::Builder::_unoverload_str, avg 136µs/call
780
781559µs527µs $self->diag(<<"ERR") if defined $name and $name =~ /^[\d\s]+$/;
# spent 27µs making 5 calls to Test::Builder::CORE:match, avg 5µs/call
782 You named your test '$name'. You shouldn't use numbers for your test names.
783 Very confusing.
784ERR
785
786 # Capture the value of $TODO for the rest of this ok() call
787 # so it can more easily be found by other routines.
788524µs5313µs my $todo = $self->todo();
# spent 313µs making 5 calls to Test::Builder::todo, avg 63µs/call
789521µs5262µs my $in_todo = $self->in_todo;
# spent 262µs making 5 calls to Test::Builder::in_todo, avg 52µs/call
79052µs local $self->{Todo} = $todo if $in_todo;
791
792519µs5559µs $self->_unoverload_str( \$todo );
# spent 559µs making 5 calls to Test::Builder::_unoverload_str, avg 112µs/call
793
79452µs my $out;
795525µs518µs my $result = &share( {} );
# spent 18µs making 5 calls to Test::Builder::__ANON__[Test/Builder.pm:66], avg 4µs/call
796
797539µs unless($test) {
798 $out .= "not ";
799 @$result{ 'ok', 'actual_ok' } = ( ( $self->in_todo ? 1 : 0 ), 0 );
800 }
801 else {
802527µs @$result{ 'ok', 'actual_ok' } = ( 1, $test );
803 }
804
80555µs $out .= "ok";
806528µs527µs $out .= " $self->{Curr_Test}" if $self->use_numbers;
# spent 27µs making 5 calls to Test::Builder::use_numbers, avg 5µs/call
807
80856µs if( defined $name ) {
809540µs510µs $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
# spent 10µs making 5 calls to Test::Builder::CORE:subst, avg 2µs/call
81058µs $out .= " - $name";
811512µs $result->{name} = $name;
812 }
813 else {
814 $result->{name} = '';
815 }
816
817519µs5270µs if( $self->in_todo ) {
# spent 270µs making 5 calls to Test::Builder::in_todo, avg 54µs/call
818 $out .= " # TODO $todo";
819 $result->{reason} = $todo;
820 $result->{type} = 'todo';
821 }
822 else {
823511µs $result->{reason} = '';
82459µs $result->{type} = '';
825 }
826
827517µs $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = $result;
82854µs $out .= "\n";
829
830519µs5559µs $self->_print($out);
# spent 559µs making 5 calls to Test::Builder::_print, avg 112µs/call
831
83253µs unless($test) {
833 my $msg = $self->in_todo ? "Failed (TODO)" : "Failed";
834 $self->_print_to_fh( $self->_diag_fh, "\n" ) if $ENV{HARNESS_ACTIVE};
835
836 my( undef, $file, $line ) = $self->caller;
837 if( defined $name ) {
838 $self->diag(qq[ $msg test '$name'\n]);
839 $self->diag(qq[ at $file line $line.\n]);
840 }
841 else {
842 $self->diag(qq[ $msg test at $file line $line.\n]);
843 }
844 }
845
84653µs $self->is_passing(0) unless $test || $self->in_todo;
847
848 # Check that we haven't violated the plan
849524µs591µs $self->_check_is_passing_plan();
# spent 91µs making 5 calls to Test::Builder::_check_is_passing_plan, avg 18µs/call
850
851540µs return $test ? 1 : 0;
852}
853
854
855# Check that we haven't yet violated the plan and set
856# is_passing() accordingly
857
# spent 91µs (63+28) within Test::Builder::_check_is_passing_plan which was called 5 times, avg 18µs/call: # 5 times (63µs+28µs) by Test::Builder::ok at line 849, avg 18µs/call
sub _check_is_passing_plan {
85855µs my $self = shift;
859
860518µs528µs my $plan = $self->has_plan;
# spent 28µs making 5 calls to Test::Builder::has_plan, avg 6µs/call
861529µs return unless defined $plan; # no plan yet defined
862 return unless $plan !~ /\D/; # no numeric plan
863 $self->is_passing(0) if $plan < $self->{Curr_Test};
864}
865
866
867
# spent 1.10ms (294µs+809µs) within Test::Builder::_unoverload which was called 10 times, avg 110µs/call: # 10 times (294µs+809µs) by Test::Builder::_unoverload_str at line 893, avg 110µs/call
sub _unoverload {
868107µs my $self = shift;
869108µs my $type = shift;
870
87120177µs10357µs
# spent 40µs within Test::Builder::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/Test/Builder.pm:871] which was called 10 times, avg 4µs/call: # 10 times (40µs+0s) by Test::Builder::_try at line 1460, avg 4µs/call
$self->_try(sub { require overload; }, die_on_fail => 1);
# spent 357µs making 10 calls to Test::Builder::_try, avg 36µs/call
872
8731023µs foreach my $thing (@_) {
8741084µs10452µs if( $self->_is_object($$thing) ) {
# spent 452µs making 10 calls to Test::Builder::_is_object, avg 45µs/call
875 if( my $string_meth = overload::Method( $$thing, $type ) ) {
876 $$thing = $$thing->$string_meth();
877 }
878 }
879 }
880
8811054µs return;
882}
883
884
# spent 452µs (143+309) within Test::Builder::_is_object which was called 10 times, avg 45µs/call: # 10 times (143µs+309µs) by Test::Builder::_unoverload at line 874, avg 45µs/call
sub _is_object {
8851017µs my( $self, $thing ) = @_;
886
88720197µs10309µs
# spent 33µs within Test::Builder::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/Test/Builder.pm:887] which was called 10 times, avg 3µs/call: # 10 times (33µs+0s) by Test::Builder::_try at line 1460, avg 3µs/call
return $self->_try( sub { ref $thing && $thing->isa('UNIVERSAL') } ) ? 1 : 0;
# spent 309µs making 10 calls to Test::Builder::_try, avg 31µs/call
888}
889
890
# spent 1.24ms (135µs+1.10) within Test::Builder::_unoverload_str which was called 10 times, avg 124µs/call: # 5 times (93µs+586µs) by Test::Builder::ok at line 779, avg 136µs/call # 5 times (43µs+517µs) by Test::Builder::ok at line 792, avg 112µs/call
sub _unoverload_str {
891109µs my $self = shift;
892
8931083µs101.10ms return $self->_unoverload( q[""], @_ );
# spent 1.10ms making 10 calls to Test::Builder::_unoverload, avg 110µs/call
894}
895
896sub _unoverload_num {
897 my $self = shift;
898
899 $self->_unoverload( '0+', @_ );
900
901 for my $val (@_) {
902 next unless $self->_is_dualvar($$val);
903 $$val = $$val + 0;
904 }
905
906 return;
907}
908
909# This is a hack to detect a dualvar such as $!
910sub _is_dualvar {
911 my( $self, $val ) = @_;
912
913 # Objects are not dualvars.
914 return 0 if ref $val;
915
9163776µs263µs
# spent 40µs (17+23) within Test::Builder::BEGIN@916 which was called: # once (17µs+23µs) by Test::Builder::Module::BEGIN@5 at line 916
no warnings 'numeric';
# spent 40µs making 1 call to Test::Builder::BEGIN@916 # spent 23µs making 1 call to warnings::unimport
917 my $numval = $val + 0;
918 return $numval != 0 and $numval ne $val ? 1 : 0;
919}
920
921=item B<is_eq>
922
923 $Test->is_eq($got, $expected, $name);
924
925Like Test::More's C<is()>. Checks if C<$got eq $expected>. This is the
926string version.
927
928C<undef> only ever matches another C<undef>.
929
930=item B<is_num>
931
932 $Test->is_num($got, $expected, $name);
933
934Like Test::More's C<is()>. Checks if C<$got == $expected>. This is the
935numeric version.
936
937C<undef> only ever matches another C<undef>.
938
939=cut
940
941
# spent 3.64ms (60µs+3.58) within Test::Builder::is_eq which was called 4 times, avg 911µs/call: # 4 times (60µs+3.58ms) by Test::More::is at line 377 of Test/More.pm, avg 911µs/call
sub is_eq {
94249µs my( $self, $got, $expect, $name ) = @_;
94348µs local $Level = $Level + 1;
944
94544µs if( !defined $got || !defined $expect ) {
946 # undef only matches undef and nothing else
947 my $test = !defined $got && !defined $expect;
948
949 $self->ok( $test, $name );
950 $self->_is_diag( $got, 'eq', $expect ) unless $test;
951 return $test;
952 }
953
954439µs43.58ms return $self->cmp_ok( $got, 'eq', $expect, $name );
# spent 3.58ms making 4 calls to Test::Builder::cmp_ok, avg 896µs/call
955}
956
957sub is_num {
958 my( $self, $got, $expect, $name ) = @_;
959 local $Level = $Level + 1;
960
961 if( !defined $got || !defined $expect ) {
962 # undef only matches undef and nothing else
963 my $test = !defined $got && !defined $expect;
964
965 $self->ok( $test, $name );
966 $self->_is_diag( $got, '==', $expect ) unless $test;
967 return $test;
968 }
969
970 return $self->cmp_ok( $got, '==', $expect, $name );
971}
972
973sub _diag_fmt {
974 my( $self, $type, $val ) = @_;
975
976 if( defined $$val ) {
977 if( $type eq 'eq' or $type eq 'ne' ) {
978 # quote and force string context
979 $$val = "'$$val'";
980 }
981 else {
982 # force numeric context
983 $self->_unoverload_num($val);
984 }
985 }
986 else {
987 $$val = 'undef';
988 }
989
990 return;
991}
992
993sub _is_diag {
994 my( $self, $got, $type, $expect ) = @_;
995
996 $self->_diag_fmt( $type, $_ ) for \$got, \$expect;
997
998 local $Level = $Level + 1;
999 return $self->diag(<<"DIAGNOSTIC");
1000 got: $got
1001 expected: $expect
1002DIAGNOSTIC
1003
1004}
1005
1006sub _isnt_diag {
1007 my( $self, $got, $type ) = @_;
1008
1009 $self->_diag_fmt( $type, \$got );
1010
1011 local $Level = $Level + 1;
1012 return $self->diag(<<"DIAGNOSTIC");
1013 got: $got
1014 expected: anything else
1015DIAGNOSTIC
1016}
1017
1018=item B<isnt_eq>
1019
1020 $Test->isnt_eq($got, $dont_expect, $name);
1021
1022Like Test::More's C<isnt()>. Checks if C<$got ne $dont_expect>. This is
1023the string version.
1024
1025=item B<isnt_num>
1026
1027 $Test->isnt_num($got, $dont_expect, $name);
1028
1029Like Test::More's C<isnt()>. Checks if C<$got ne $dont_expect>. This is
1030the numeric version.
1031
1032=cut
1033
1034sub isnt_eq {
1035 my( $self, $got, $dont_expect, $name ) = @_;
1036 local $Level = $Level + 1;
1037
1038 if( !defined $got || !defined $dont_expect ) {
1039 # undef only matches undef and nothing else
1040 my $test = defined $got || defined $dont_expect;
1041
1042 $self->ok( $test, $name );
1043 $self->_isnt_diag( $got, 'ne' ) unless $test;
1044 return $test;
1045 }
1046
1047 return $self->cmp_ok( $got, 'ne', $dont_expect, $name );
1048}
1049
1050sub isnt_num {
1051 my( $self, $got, $dont_expect, $name ) = @_;
1052 local $Level = $Level + 1;
1053
1054 if( !defined $got || !defined $dont_expect ) {
1055 # undef only matches undef and nothing else
1056 my $test = defined $got || defined $dont_expect;
1057
1058 $self->ok( $test, $name );
1059 $self->_isnt_diag( $got, '!=' ) unless $test;
1060 return $test;
1061 }
1062
1063 return $self->cmp_ok( $got, '!=', $dont_expect, $name );
1064}
1065
1066=item B<like>
1067
1068 $Test->like($this, qr/$regex/, $name);
1069 $Test->like($this, '/$regex/', $name);
1070
1071Like Test::More's C<like()>. Checks if $this matches the given C<$regex>.
1072
1073=item B<unlike>
1074
1075 $Test->unlike($this, qr/$regex/, $name);
1076 $Test->unlike($this, '/$regex/', $name);
1077
1078Like Test::More's C<unlike()>. Checks if $this B<does not match> the
1079given C<$regex>.
1080
1081=cut
1082
1083sub like {
1084 my( $self, $this, $regex, $name ) = @_;
1085
1086 local $Level = $Level + 1;
1087 return $self->_regex_ok( $this, $regex, '=~', $name );
1088}
1089
1090sub unlike {
1091 my( $self, $this, $regex, $name ) = @_;
1092
1093 local $Level = $Level + 1;
1094 return $self->_regex_ok( $this, $regex, '!~', $name );
1095}
1096
1097=item B<cmp_ok>
1098
1099 $Test->cmp_ok($this, $type, $that, $name);
1100
1101Works just like Test::More's C<cmp_ok()>.
1102
1103 $Test->cmp_ok($big_num, '!=', $other_big_num);
1104
1105=cut
1106
110719µsmy %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" );
1108
1109
# spent 3.58ms (557µs+3.03) within Test::Builder::cmp_ok which was called 4 times, avg 896µs/call: # 4 times (557µs+3.03ms) by Test::Builder::is_eq at line 954, avg 896µs/call
sub cmp_ok {
1110410µs my( $self, $got, $type, $expect, $name ) = @_;
1111
111242µs my $test;
111342µs my $error;
1114 {
1115 ## no critic (BuiltinFunctions::ProhibitStringyEval)
1116
1117857µs local( $@, $!, $SIG{__DIE__} ); # isolate eval
1118
1119427µs4169µs my($pack, $file, $line) = $self->caller();
# spent 169µs making 4 calls to Test::Builder::caller, avg 42µs/call
1120
1121 # This is so that warnings come out at the caller's level
11224329µs $test = eval qq[
1123#line $line "(eval in cmp_ok) $file"
1124\$got $type \$expect;
1125];
1126422µs $error = $@;
1127 }
112846µs local $Level = $Level + 1;
1129421µs42.86ms my $ok = $self->ok( $test, $name );
# spent 2.86ms making 4 calls to Test::Builder::ok, avg 714µs/call
1130
1131 # Treat overloaded objects as numbers if we're asked to do a
1132 # numeric comparison.
113348µs my $unoverload
1134 = $numeric_cmps{$type}
1135 ? '_unoverload_num'
1136 : '_unoverload_str';
1137
113842µs $self->diag(<<"END") if $error;
1139An error occurred while using $type:
1140------------------------------------
1141$error
1142------------------------------------
1143END
1144
114541µs unless($ok) {
1146 $self->$unoverload( \$got, \$expect );
1147
1148 if( $type =~ /^(eq|==)$/ ) {
1149 $self->_is_diag( $got, $type, $expect );
1150 }
1151 elsif( $type =~ /^(ne|!=)$/ ) {
1152 $self->_isnt_diag( $got, $type );
1153 }
1154 else {
1155 $self->_cmp_diag( $got, $type, $expect );
1156 }
1157 }
1158424µs return $ok;
1159}
1160
1161sub _cmp_diag {
1162 my( $self, $got, $type, $expect ) = @_;
1163
1164 $got = defined $got ? "'$got'" : 'undef';
1165 $expect = defined $expect ? "'$expect'" : 'undef';
1166
1167 local $Level = $Level + 1;
1168 return $self->diag(<<"DIAGNOSTIC");
1169 $got
1170 $type
1171 $expect
1172DIAGNOSTIC
1173}
1174
1175sub _caller_context {
1176 my $self = shift;
1177
1178 my( $pack, $file, $line ) = $self->caller(1);
1179
1180 my $code = '';
1181 $code .= "#line $line $file\n" if defined $file and defined $line;
1182
1183 return $code;
1184}
1185
1186=back
1187
1188
1189=head2 Other Testing Methods
1190
1191These are methods which are used in the course of writing a test but are not themselves tests.
1192
1193=over 4
1194
1195=item B<BAIL_OUT>
1196
1197 $Test->BAIL_OUT($reason);
1198
1199Indicates to the Test::Harness that things are going so badly all
1200testing should terminate. This includes running any additional test
1201scripts.
1202
1203It will exit with 255.
1204
1205=cut
1206
1207sub BAIL_OUT {
1208 my( $self, $reason ) = @_;
1209
1210 $self->{Bailed_Out} = 1;
1211 $self->_print("Bail out! $reason");
1212 exit 255;
1213}
1214
1215=for deprecated
1216BAIL_OUT() used to be BAILOUT()
1217
1218=cut
1219
1220{
12214716µs228µs
# spent 18µs (8+10) within Test::Builder::BEGIN@1221 which was called: # once (8µs+10µs) by Test::Builder::Module::BEGIN@5 at line 1221
no warnings 'once';
# spent 18µs making 1 call to Test::Builder::BEGIN@1221 # spent 10µs making 1 call to warnings::unimport
122211µs *BAILOUT = \&BAIL_OUT;
1223}
1224
1225=item B<skip>
1226
1227 $Test->skip;
1228 $Test->skip($why);
1229
1230Skips the current test, reporting C<$why>.
1231
1232=cut
1233
1234sub skip {
1235 my( $self, $why ) = @_;
1236 $why ||= '';
1237 $self->_unoverload_str( \$why );
1238
1239 lock( $self->{Curr_Test} );
1240 $self->{Curr_Test}++;
1241
1242 $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share(
1243 {
1244 'ok' => 1,
1245 actual_ok => 1,
1246 name => '',
1247 type => 'skip',
1248 reason => $why,
1249 }
1250 );
1251
1252 my $out = "ok";
1253 $out .= " $self->{Curr_Test}" if $self->use_numbers;
1254 $out .= " # skip";
1255 $out .= " $why" if length $why;
1256 $out .= "\n";
1257
1258 $self->_print($out);
1259
1260 return 1;
1261}
1262
1263=item B<todo_skip>
1264
1265 $Test->todo_skip;
1266 $Test->todo_skip($why);
1267
1268Like C<skip()>, only it will declare the test as failing and TODO. Similar
1269to
1270
1271 print "not ok $tnum # TODO $why\n";
1272
1273=cut
1274
1275sub todo_skip {
1276 my( $self, $why ) = @_;
1277 $why ||= '';
1278
1279 lock( $self->{Curr_Test} );
1280 $self->{Curr_Test}++;
1281
1282 $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share(
1283 {
1284 'ok' => 1,
1285 actual_ok => 0,
1286 name => '',
1287 type => 'todo_skip',
1288 reason => $why,
1289 }
1290 );
1291
1292 my $out = "not ok";
1293 $out .= " $self->{Curr_Test}" if $self->use_numbers;
1294 $out .= " # TODO & SKIP $why\n";
1295
1296 $self->_print($out);
1297
1298 return 1;
1299}
1300
1301=begin _unimplemented
1302
1303=item B<skip_rest>
1304
1305 $Test->skip_rest;
1306 $Test->skip_rest($reason);
1307
1308Like C<skip()>, only it skips all the rest of the tests you plan to run
1309and terminates the test.
1310
1311If you're running under C<no_plan>, it skips once and terminates the
1312test.
1313
1314=end _unimplemented
1315
1316=back
1317
1318
1319=head2 Test building utility methods
1320
1321These methods are useful when writing your own test methods.
1322
1323=over 4
1324
1325=item B<maybe_regex>
1326
1327 $Test->maybe_regex(qr/$regex/);
1328 $Test->maybe_regex('/$regex/');
1329
1330This method used to be useful back when Test::Builder worked on Perls
1331before 5.6 which didn't have qr//. Now its pretty useless.
1332
1333Convenience method for building testing functions that take regular
1334expressions as arguments.
1335
1336Takes a quoted regular expression produced by C<qr//>, or a string
1337representing a regular expression.
1338
1339Returns a Perl value which may be used instead of the corresponding
1340regular expression, or C<undef> if its argument is not recognised.
1341
1342For example, a version of C<like()>, sans the useful diagnostic messages,
1343could be written as:
1344
1345 sub laconic_like {
1346 my ($self, $this, $regex, $name) = @_;
1347 my $usable_regex = $self->maybe_regex($regex);
1348 die "expecting regex, found '$regex'\n"
1349 unless $usable_regex;
1350 $self->ok($this =~ m/$usable_regex/, $name);
1351 }
1352
1353=cut
1354
1355sub maybe_regex {
1356 my( $self, $regex ) = @_;
1357 my $usable_regex = undef;
1358
1359 return $usable_regex unless defined $regex;
1360
1361 my( $re, $opts );
1362
1363 # Check for qr/foo/
1364 if( _is_qr($regex) ) {
1365 $usable_regex = $regex;
1366 }
1367 # Check for '/foo/' or 'm,foo,'
1368 elsif(( $re, $opts ) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or
1369 ( undef, $re, $opts ) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx
1370 )
1371 {
1372 $usable_regex = length $opts ? "(?$opts)$re" : $re;
1373 }
1374
1375 return $usable_regex;
1376}
1377
1378sub _is_qr {
1379 my $regex = shift;
1380
1381 # is_regexp() checks for regexes in a robust manner, say if they're
1382 # blessed.
1383 return re::is_regexp($regex) if defined &re::is_regexp;
1384 return ref $regex eq 'Regexp';
1385}
1386
1387sub _regex_ok {
1388 my( $self, $this, $regex, $cmp, $name ) = @_;
1389
1390 my $ok = 0;
1391 my $usable_regex = $self->maybe_regex($regex);
1392 unless( defined $usable_regex ) {
1393 local $Level = $Level + 1;
1394 $ok = $self->ok( 0, $name );
1395 $self->diag(" '$regex' doesn't look much like a regex to me.");
1396 return $ok;
1397 }
1398
1399 {
1400 ## no critic (BuiltinFunctions::ProhibitStringyEval)
1401
1402 my $test;
1403 my $context = $self->_caller_context;
1404
1405 local( $@, $!, $SIG{__DIE__} ); # isolate eval
1406
1407 $test = eval $context . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
1408
1409 $test = !$test if $cmp eq '!~';
1410
1411 local $Level = $Level + 1;
1412 $ok = $self->ok( $test, $name );
1413 }
1414
1415 unless($ok) {
1416 $this = defined $this ? "'$this'" : 'undef';
1417 my $match = $cmp eq '=~' ? "doesn't match" : "matches";
1418
1419 local $Level = $Level + 1;
1420 $self->diag( sprintf <<'DIAGNOSTIC', $this, $match, $regex );
1421 %s
1422 %13s '%s'
1423DIAGNOSTIC
1424
1425 }
1426
1427 return $ok;
1428}
1429
1430# I'm not ready to publish this. It doesn't deal with array return
1431# values from the code or context.
1432
1433=begin private
1434
1435=item B<_try>
1436
1437 my $return_from_code = $Test->try(sub { code });
1438 my($return_from_code, $error) = $Test->try(sub { code });
1439
1440Works like eval BLOCK except it ensures it has no effect on the rest
1441of the test (ie. C<$@> is not set) nor is effected by outside
1442interference (ie. C<$SIG{__DIE__}>) and works around some quirks in older
1443Perls.
1444
1445C<$error> is what would normally be in C<$@>.
1446
1447It is suggested you use this in place of eval BLOCK.
1448
1449=cut
1450
1451
# spent 920µs (626+293) within Test::Builder::_try which was called 22 times, avg 42µs/call: # 10 times (316µs+40µs) by Test::Builder::_unoverload at line 871, avg 36µs/call # 10 times (276µs+33µs) by Test::Builder::_is_object at line 887, avg 31µs/call # 2 times (34µs+220µs) by Test::Builder::_copy_io_layers at line 1907, avg 127µs/call
sub _try {
14522248µs my( $self, $code, %opts ) = @_;
1453
1454228µs my $error;
1455228µs my $return;
1456 {
145744123µs local $!; # eval can mess up $!
14582210µs local $@; # don't set $@ in the test
14592263µs local $SIG{__DIE__}; # don't trip an outside DIE handler.
146044110µs22293µs $return = eval { $code->() };
# spent 220µs making 2 calls to Test::Builder::__ANON__[Test/Builder.pm:1906], avg 110µs/call # spent 40µs making 10 calls to Test::Builder::__ANON__[Test/Builder.pm:871], avg 4µs/call # spent 33µs making 10 calls to Test::Builder::__ANON__[Test/Builder.pm:887], avg 3µs/call
14612270µs $error = $@;
1462 }
1463
14642210µs die $error if $error and $opts{die_on_fail};
1465
146622147µs return wantarray ? ( $return, $error ) : $return;
1467}
1468
1469=end private
1470
1471
1472=item B<is_fh>
1473
1474 my $is_fh = $Test->is_fh($thing);
1475
1476Determines if the given C<$thing> can be used as a filehandle.
1477
1478=cut
1479
1480
# spent 7µs within Test::Builder::is_fh which was called 3 times, avg 2µs/call: # 3 times (7µs+0s) by Test::Builder::_new_fh at line 1827, avg 2µs/call
sub is_fh {
14813800ns my $self = shift;
14823800ns my $maybe_fh = shift;
14833800ns return 0 unless defined $maybe_fh;
1484
148539µs return 1 if ref $maybe_fh eq 'GLOB'; # its a glob ref
1486 return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob
1487
1488 return eval { $maybe_fh->isa("IO::Handle") } ||
1489 eval { tied($maybe_fh)->can('TIEHANDLE') };
1490}
1491
1492=back
1493
1494
1495=head2 Test style
1496
1497
1498=over 4
1499
1500=item B<level>
1501
1502 $Test->level($how_high);
1503
1504How far up the call stack should C<$Test> look when reporting where the
1505test failed.
1506
1507Defaults to 1.
1508
1509Setting L<$Test::Builder::Level> overrides. This is typically useful
1510localized:
1511
1512 sub my_ok {
1513 my $test = shift;
1514
1515 local $Test::Builder::Level = $Test::Builder::Level + 1;
1516 $TB->ok($test);
1517 }
1518
1519To be polite to other functions wrapping your own you usually want to increment C<$Level> rather than set it to a constant.
1520
1521=cut
1522
1523
# spent 74µs within Test::Builder::level which was called 19 times, avg 4µs/call: # 19 times (74µs+0s) by Test::Builder::caller at line 2304, avg 4µs/call
sub level {
15241917µs my( $self, $level ) = @_;
1525
1526199µs if( defined $level ) {
1527 $Level = $level;
1528 }
152919112µs return $Level;
1530}
1531
1532=item B<use_numbers>
1533
1534 $Test->use_numbers($on_or_off);
1535
1536Whether or not the test should output numbers. That is, this if true:
1537
1538 ok 1
1539 ok 2
1540 ok 3
1541
1542or this if false
1543
1544 ok
1545 ok
1546 ok
1547
1548Most useful when you can't depend on the test output order, such as
1549when threads or forking is involved.
1550
1551Defaults to on.
1552
1553=cut
1554
1555
# spent 27µs within Test::Builder::use_numbers which was called 5 times, avg 5µs/call: # 5 times (27µs+0s) by Test::Builder::ok at line 806, avg 5µs/call
sub use_numbers {
155656µs my( $self, $use_nums ) = @_;
1557
155853µs if( defined $use_nums ) {
1559 $self->{Use_Nums} = $use_nums;
1560 }
1561536µs return $self->{Use_Nums};
1562}
1563
1564=item B<no_diag>
1565
1566 $Test->no_diag($no_diag);
1567
1568If set true no diagnostics will be printed. This includes calls to
1569C<diag()>.
1570
1571=item B<no_ending>
1572
1573 $Test->no_ending($no_ending);
1574
1575Normally, Test::Builder does some extra diagnostics when the test
1576ends. It also changes the exit code as described below.
1577
1578If this is true, none of that will be done.
1579
1580=item B<no_header>
1581
1582 $Test->no_header($no_header);
1583
1584If set to true, no "1..N" header will be printed.
1585
1586=cut
1587
158812µsforeach my $attribute (qw(No_Header No_Ending No_Diag)) {
158932µs my $method = lc $attribute;
1590
1591
# spent 9µs within Test::Builder::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/Test/Builder.pm:1598] which was called: # once (9µs+0s) by Test::Builder::_ending at line 2390
my $code = sub {
159212µs my( $self, $no ) = @_;
1593
15941700ns if( defined $no ) {
1595 $self->{$attribute} = $no;
1596 }
1597113µs return $self->{$attribute};
159836µs };
1599
160031.18ms244µs
# spent 27µs (10+17) within Test::Builder::BEGIN@1600 which was called: # once (10µs+17µs) by Test::Builder::Module::BEGIN@5 at line 1600
no strict 'refs'; ## no critic
# spent 27µs making 1 call to Test::Builder::BEGIN@1600 # spent 17µs making 1 call to strict::unimport
160139µs *{ __PACKAGE__ . '::' . $method } = $code;
1602}
1603
1604=back
1605
1606=head2 Output
1607
1608Controlling where the test output goes.
1609
1610It's ok for your test to change where STDOUT and STDERR point to,
1611Test::Builder's default output settings will not be affected.
1612
1613=over 4
1614
1615=item B<diag>
1616
1617 $Test->diag(@msgs);
1618
1619Prints out the given C<@msgs>. Like C<print>, arguments are simply
1620appended together.
1621
1622Normally, it uses the C<failure_output()> handle, but if this is for a
1623TODO test, the C<todo_output()> handle is used.
1624
1625Output will be indented and marked with a # so as not to interfere
1626with test output. A newline will be put on the end if there isn't one
1627already.
1628
1629We encourage using this rather than calling print directly.
1630
1631Returns false. Why? Because C<diag()> is often used in conjunction with
1632a failing test (C<ok() || diag()>) it "passes through" the failure.
1633
1634 return ok(...) || diag(...);
1635
1636=for blame transfer
1637Mark Fowler <mark@twoshortplanks.com>
1638
1639=cut
1640
1641sub diag {
1642 my $self = shift;
1643
1644 $self->_print_comment( $self->_diag_fh, @_ );
1645}
1646
1647=item B<note>
1648
1649 $Test->note(@msgs);
1650
1651Like C<diag()>, but it prints to the C<output()> handle so it will not
1652normally be seen by the user except in verbose mode.
1653
1654=cut
1655
1656sub note {
1657 my $self = shift;
1658
1659 $self->_print_comment( $self->output, @_ );
1660}
1661
1662sub _diag_fh {
1663 my $self = shift;
1664
1665 local $Level = $Level + 1;
1666 return $self->in_todo ? $self->todo_output : $self->failure_output;
1667}
1668
1669sub _print_comment {
1670 my( $self, $fh, @msgs ) = @_;
1671
1672 return if $self->no_diag;
1673 return unless @msgs;
1674
1675 # Prevent printing headers when compiling (i.e. -c)
1676 return if $^C;
1677
1678 # Smash args together like print does.
1679 # Convert undef to 'undef' so its readable.
1680 my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs;
1681
1682 # Escape the beginning, _print will take care of the rest.
1683 $msg =~ s/^/# /;
1684
1685 local $Level = $Level + 1;
1686 $self->_print_to_fh( $fh, $msg );
1687
1688 return 0;
1689}
1690
1691=item B<explain>
1692
1693 my @dump = $Test->explain(@msgs);
1694
1695Will dump the contents of any references in a human readable format.
1696Handy for things like...
1697
1698 is_deeply($have, $want) || diag explain $have;
1699
1700or
1701
1702 is_deeply($have, $want) || note explain $have;
1703
1704=cut
1705
1706sub explain {
1707 my $self = shift;
1708
1709 return map {
1710 ref $_
1711 ? do {
1712 $self->_try(sub { require Data::Dumper }, die_on_fail => 1);
1713
1714 my $dumper = Data::Dumper->new( [$_] );
1715 $dumper->Indent(1)->Terse(1);
1716 $dumper->Sortkeys(1) if $dumper->can("Sortkeys");
1717 $dumper->Dump;
1718 }
1719 : $_
1720 } @_;
1721}
1722
1723=begin _private
1724
1725=item B<_print>
1726
1727 $Test->_print(@msgs);
1728
1729Prints to the C<output()> filehandle.
1730
1731=end _private
1732
1733=cut
1734
1735
# spent 653µs (95+558) within Test::Builder::_print which was called 6 times, avg 109µs/call: # 5 times (81µs+478µs) by Test::Builder::ok at line 830, avg 112µs/call # once (14µs+80µs) by Test::Builder::_output_plan at line 597
sub _print {
173665µs my $self = shift;
1737675µs12558µs return $self->_print_to_fh( $self->output, @_ );
# spent 528µs making 6 calls to Test::Builder::_print_to_fh, avg 88µs/call # spent 30µs making 6 calls to Test::Builder::output, avg 5µs/call
1738}
1739
1740
# spent 528µs (252+276) within Test::Builder::_print_to_fh which was called 6 times, avg 88µs/call: # 6 times (252µs+276µs) by Test::Builder::_print at line 1737, avg 88µs/call
sub _print_to_fh {
1741614µs my( $self, $fh, @msgs ) = @_;
1742
1743 # Prevent printing headers when only compiling. Mostly for when
1744 # tests are deparsed with B::Deparse
174568µs return if $^C;
1746
1747612µs my $msg = join '', @msgs;
1748623µs632µs my $indent = $self->_indent;
# spent 32µs making 6 calls to Test::Builder::_indent, avg 5µs/call
1749
1750630µs local( $\, $", $, ) = ( undef, ' ', '' );
1751
1752 # Escape each line after the first with a # so we don't
1753 # confuse Test::Harness.
1754663µs626µs $msg =~ s{\n(?!\z)}{\n$indent# }sg;
# spent 26µs making 6 calls to Test::Builder::CORE:subst, avg 4µs/call
1755
1756 # Stick a newline on the end if it needs it.
1757644µs615µs $msg .= "\n" unless $msg =~ /\n\z/;
# spent 15µs making 6 calls to Test::Builder::CORE:match, avg 2µs/call
1758
17596298µs6203µs return print $fh $indent, $msg;
# spent 203µs making 6 calls to Test::Builder::CORE:print, avg 34µs/call
1760}
1761
1762=item B<output>
1763
1764=item B<failure_output>
1765
1766=item B<todo_output>
1767
1768 my $filehandle = $Test->output;
1769 $Test->output($filehandle);
1770 $Test->output($filename);
1771 $Test->output(\$scalar);
1772
1773These methods control where Test::Builder will print its output.
1774They take either an open C<$filehandle>, a C<$filename> to open and write to
1775or a C<$scalar> reference to append to. It will always return a C<$filehandle>.
1776
1777B<output> is where normal "ok/not ok" test output goes.
1778
1779Defaults to STDOUT.
1780
1781B<failure_output> is where diagnostic output on test failures and
1782C<diag()> goes. It is normally not read by Test::Harness and instead is
1783displayed to the user.
1784
1785Defaults to STDERR.
1786
1787C<todo_output> is used instead of C<failure_output()> for the
1788diagnostics of a failing TODO test. These will not be seen by the
1789user.
1790
1791Defaults to STDOUT.
1792
1793=cut
1794
1795
# spent 48µs (38+11) within Test::Builder::output which was called 7 times, avg 7µs/call: # 6 times (30µs+0s) by Test::Builder::_print at line 1737, avg 5µs/call # once (7µs+11µs) by Test::Builder::reset_outputs at line 1931
sub output {
179678µs my( $self, $fh ) = @_;
1797
179876µs111µs if( defined $fh ) {
# spent 11µs making 1 call to Test::Builder::_new_fh
1799 $self->{Out_FH} = $self->_new_fh($fh);
1800 }
1801743µs return $self->{Out_FH};
1802}
1803
1804
# spent 11µs (6+5) within Test::Builder::failure_output which was called: # once (6µs+5µs) by Test::Builder::reset_outputs at line 1932
sub failure_output {
18051600ns my( $self, $fh ) = @_;
1806
180712µs15µs if( defined $fh ) {
# spent 5µs making 1 call to Test::Builder::_new_fh
1808 $self->{Fail_FH} = $self->_new_fh($fh);
1809 }
181014µs return $self->{Fail_FH};
1811}
1812
1813
# spent 11µs (6+5) within Test::Builder::todo_output which was called: # once (6µs+5µs) by Test::Builder::reset_outputs at line 1933
sub todo_output {
18141700ns my( $self, $fh ) = @_;
1815
181612µs15µs if( defined $fh ) {
# spent 5µs making 1 call to Test::Builder::_new_fh
1817 $self->{Todo_FH} = $self->_new_fh($fh);
1818 }
181913µs return $self->{Todo_FH};
1820}
1821
1822
# spent 21µs (13+7) within Test::Builder::_new_fh which was called 3 times, avg 7µs/call: # once (7µs+4µs) by Test::Builder::output at line 1798 # once (3µs+2µs) by Test::Builder::todo_output at line 1816 # once (3µs+1µs) by Test::Builder::failure_output at line 1807
sub _new_fh {
18233800ns my $self = shift;
182431µs my($file_or_fh) = shift;
1825
18263500ns my $fh;
182734µs37µs if( $self->is_fh($file_or_fh) ) {
# spent 7µs making 3 calls to Test::Builder::is_fh, avg 2µs/call
1828 $fh = $file_or_fh;
1829 }
1830 elsif( ref $file_or_fh eq 'SCALAR' ) {
1831 # Scalar refs as filehandles was added in 5.8.
1832 if( $] >= 5.008 ) {
1833 open $fh, ">>", $file_or_fh
1834 or $self->croak("Can't open scalar ref $file_or_fh: $!");
1835 }
1836 # Emulate scalar ref filehandles with a tie.
1837 else {
1838 $fh = Test::Builder::IO::Scalar->new($file_or_fh)
1839 or $self->croak("Can't tie scalar ref $file_or_fh");
1840 }
1841 }
1842 else {
1843 open $fh, ">", $file_or_fh
1844 or $self->croak("Can't open test output log $file_or_fh: $!");
1845 _autoflush($fh);
1846 }
1847
184838µs return $fh;
1849}
1850
1851
# spent 32µs (25+7) within Test::Builder::_autoflush which was called 4 times, avg 8µs/call: # once (12µs+4µs) by Test::Builder::_dup_stdhandles at line 1869 # once (5µs+1µs) by Test::Builder::_dup_stdhandles at line 1870 # once (4µs+900ns) by Test::Builder::_dup_stdhandles at line 1871 # once (4µs+800ns) by Test::Builder::_dup_stdhandles at line 1872
sub _autoflush {
185242µs my($fh) = shift;
1853414µs45µs my $old_fh = select $fh;
# spent 5µs making 4 calls to Test::Builder::CORE:select, avg 1µs/call
185442µs $| = 1;
1855410µs42µs select $old_fh;
# spent 2µs making 4 calls to Test::Builder::CORE:select, avg 600ns/call
1856
1857410µs return;
1858}
1859
18601400nsmy( $Testout, $Testerr );
1861
1862
# spent 469µs (19+450) within Test::Builder::_dup_stdhandles which was called: # once (19µs+450µs) by Test::Builder::reset at line 437
sub _dup_stdhandles {
18631300ns my $self = shift;
1864
186512µs1365µs $self->_open_testhandles;
# spent 365µs making 1 call to Test::Builder::_open_testhandles
1866
1867 # Set everything to unbuffered else plain prints to STDOUT will
1868 # come out in the wrong order from our own prints.
186912µs116µs _autoflush($Testout);
# spent 16µs making 1 call to Test::Builder::_autoflush
187011µs16µs _autoflush( \*STDOUT );
# spent 6µs making 1 call to Test::Builder::_autoflush
187111µs15µs _autoflush($Testerr);
# spent 5µs making 1 call to Test::Builder::_autoflush
187211µs15µs _autoflush( \*STDERR );
# spent 5µs making 1 call to Test::Builder::_autoflush
1873
187412µs152µs $self->reset_outputs;
# spent 52µs making 1 call to Test::Builder::reset_outputs
1875
187614µs return;
1877}
1878
1879
# spent 365µs (22+343) within Test::Builder::_open_testhandles which was called: # once (22µs+343µs) by Test::Builder::_dup_stdhandles at line 1865
sub _open_testhandles {
18801500ns my $self = shift;
1881
18821500ns return if $self->{Opened_Testhandles};
1883
1884 # We dup STDOUT and STDERR so people can change them in their
1885 # test suites while still getting normal test output.
1886174µs166µs open( $Testout, ">&STDOUT" ) or die "Can't dup STDOUT: $!";
# spent 66µs making 1 call to Test::Builder::CORE:open
188719µs15µs open( $Testerr, ">&STDERR" ) or die "Can't dup STDERR: $!";
# spent 5µs making 1 call to Test::Builder::CORE:open
1888
188913µs1238µs $self->_copy_io_layers( \*STDOUT, $Testout );
# spent 238µs making 1 call to Test::Builder::_copy_io_layers
189012µs134µs $self->_copy_io_layers( \*STDERR, $Testerr );
# spent 34µs making 1 call to Test::Builder::_copy_io_layers
1891
18921600ns $self->{Opened_Testhandles} = 1;
1893
189413µs return;
1895}
1896
1897
# spent 272µs (18+254) within Test::Builder::_copy_io_layers which was called 2 times, avg 136µs/call: # once (11µs+226µs) by Test::Builder::_open_testhandles at line 1889 # once (7µs+28µs) by Test::Builder::_open_testhandles at line 1890
sub _copy_io_layers {
189821µs my( $self, $src, $dst ) = @_;
1899
1900 $self->_try(
1901
# spent 220µs (175+45) within Test::Builder::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/Test/Builder.pm:1906] which was called 2 times, avg 110µs/call: # 2 times (175µs+45µs) by Test::Builder::_try at line 1460, avg 110µs/call
sub {
19022151µs require PerlIO;
1903225µs213µs my @src_layers = PerlIO::get_layers($src);
# spent 13µs making 2 calls to PerlIO::get_layers, avg 7µs/call
1904
190529µs231µs _apply_layers($dst, @src_layers) if @src_layers;
# spent 31µs making 2 calls to Test::Builder::_apply_layers, avg 16µs/call
1906 }
1907211µs2254µs );
# spent 254µs making 2 calls to Test::Builder::_try, avg 127µs/call
1908
190925µs return;
1910}
1911
1912
# spent 31µs (22+9) within Test::Builder::_apply_layers which was called 2 times, avg 16µs/call: # 2 times (22µs+9µs) by Test::Builder::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/5.12.3/Test/Builder.pm:1906] at line 1905, avg 16µs/call
sub _apply_layers {
191322µs my ($fh, @layers) = @_;
19142600ns my %seen;
191526µs my @unique = grep { $_ ne 'unix' and !$seen{$_}++ } @layers;
1916224µs29µs binmode($fh, join(":", "", "raw", @unique));
# spent 9µs making 2 calls to Test::Builder::CORE:binmode, avg 4µs/call
1917}
1918
1919
1920=item reset_outputs
1921
1922 $tb->reset_outputs;
1923
1924Resets all the output filehandles back to their defaults.
1925
1926=cut
1927
1928
# spent 52µs (13+39) within Test::Builder::reset_outputs which was called: # once (13µs+39µs) by Test::Builder::_dup_stdhandles at line 1874
sub reset_outputs {
19291500ns my $self = shift;
1930
193112µs118µs $self->output ($Testout);
# spent 18µs making 1 call to Test::Builder::output
193212µs111µs $self->failure_output($Testerr);
# spent 11µs making 1 call to Test::Builder::failure_output
193312µs111µs $self->todo_output ($Testout);
# spent 11µs making 1 call to Test::Builder::todo_output
1934
193513µs return;
1936}
1937
1938=item carp
1939
1940 $tb->carp(@message);
1941
1942Warns with C<@message> but the message will appear to come from the
1943point where the original test function was called (C<< $tb->caller >>).
1944
1945=item croak
1946
1947 $tb->croak(@message);
1948
1949Dies with C<@message> but the message will appear to come from the
1950point where the original test function was called (C<< $tb->caller >>).
1951
1952=cut
1953
1954sub _message_at_caller {
1955 my $self = shift;
1956
1957 local $Level = $Level + 1;
1958 my( $pack, $file, $line ) = $self->caller;
1959 return join( "", @_ ) . " at $file line $line.\n";
1960}
1961
1962sub carp {
1963 my $self = shift;
1964 return warn $self->_message_at_caller(@_);
1965}
1966
1967sub croak {
1968 my $self = shift;
1969 return die $self->_message_at_caller(@_);
1970}
1971
1972
1973=back
1974
1975
1976=head2 Test Status and Info
1977
1978=over 4
1979
1980=item B<current_test>
1981
1982 my $curr_test = $Test->current_test;
1983 $Test->current_test($num);
1984
1985Gets/sets the current test number we're on. You usually shouldn't
1986have to set this.
1987
1988If set forward, the details of the missing tests are filled in as 'unknown'.
1989if set backward, the details of the intervening tests are deleted. You
1990can erase history if you really want to.
1991
1992=cut
1993
1994
# spent 20µs (17+3) within Test::Builder::current_test which was called: # once (17µs+3µs) by Test::Builder::done_testing at line 648
sub current_test {
199512µs my( $self, $num ) = @_;
1996
199714µs13µs lock( $self->{Curr_Test} );
# spent 3µs making 1 call to Test::Builder::__ANON__[Test/Builder.pm:67]
19981600ns if( defined $num ) {
1999 $self->{Curr_Test} = $num;
2000
2001 # If the test counter is being pushed forward fill in the details.
2002 my $test_results = $self->{Test_Results};
2003 if( $num > @$test_results ) {
2004 my $start = @$test_results ? @$test_results : 0;
2005 for( $start .. $num - 1 ) {
2006 $test_results->[$_] = &share(
2007 {
2008 'ok' => 1,
2009 actual_ok => undef,
2010 reason => 'incrementing test number',
2011 type => 'unknown',
2012 name => undef
2013 }
2014 );
2015 }
2016 }
2017 # If backward, wipe history. Its their funeral.
2018 elsif( $num < @$test_results ) {
2019 $#{$test_results} = $num - 1;
2020 }
2021 }
2022111µs return $self->{Curr_Test};
2023}
2024
2025=item B<is_passing>
2026
2027 my $ok = $builder->is_passing;
2028
2029Indicates if the test suite is currently passing.
2030
2031More formally, it will be false if anything has happened which makes
2032it impossible for the test suite to pass. True otherwise.
2033
2034For example, if no tests have run C<is_passing()> will be true because
2035even though a suite with no tests is a failure you can add a passing
2036test to it and start passing.
2037
2038Don't think about it too much.
2039
2040=cut
2041
2042
# spent 2µs within Test::Builder::is_passing which was called: # once (2µs+0s) by Test::Builder::reset at line 407
sub is_passing {
20431300ns my $self = shift;
2044
20451600ns if( @_ ) {
2046 $self->{Is_Passing} = shift;
2047 }
2048
204915µs return $self->{Is_Passing};
2050}
2051
2052
2053=item B<summary>
2054
2055 my @tests = $Test->summary;
2056
2057A simple summary of the tests so far. True for pass, false for fail.
2058This is a logical pass/fail, so todos are passes.
2059
2060Of course, test #1 is $tests[0], etc...
2061
2062=cut
2063
2064sub summary {
2065 my($self) = shift;
2066
2067 return map { $_->{'ok'} } @{ $self->{Test_Results} };
2068}
2069
2070=item B<details>
2071
2072 my @tests = $Test->details;
2073
2074Like C<summary()>, but with a lot more detail.
2075
2076 $tests[$test_num - 1] =
2077 { 'ok' => is the test considered a pass?
2078 actual_ok => did it literally say 'ok'?
2079 name => name of the test (if any)
2080 type => type of test (if any, see below).
2081 reason => reason for the above (if any)
2082 };
2083
2084'ok' is true if Test::Harness will consider the test to be a pass.
2085
2086'actual_ok' is a reflection of whether or not the test literally
2087printed 'ok' or 'not ok'. This is for examining the result of 'todo'
2088tests.
2089
2090'name' is the name of the test.
2091
2092'type' indicates if it was a special test. Normal tests have a type
2093of ''. Type can be one of the following:
2094
2095 skip see skip()
2096 todo see todo()
2097 todo_skip see todo_skip()
2098 unknown see below
2099
2100Sometimes the Test::Builder test counter is incremented without it
2101printing any test output, for example, when C<current_test()> is changed.
2102In these cases, Test::Builder doesn't know the result of the test, so
2103its type is 'unknown'. These details for these tests are filled in.
2104They are considered ok, but the name and actual_ok is left C<undef>.
2105
2106For example "not ok 23 - hole count # TODO insufficient donuts" would
2107result in this structure:
2108
2109 $tests[22] = # 23 - 1, since arrays start from 0.
2110 { ok => 1, # logically, the test passed since its todo
2111 actual_ok => 0, # in absolute terms, it failed
2112 name => 'hole count',
2113 type => 'todo',
2114 reason => 'insufficient donuts'
2115 };
2116
2117=cut
2118
2119sub details {
2120 my $self = shift;
2121 return @{ $self->{Test_Results} };
2122}
2123
2124=item B<todo>
2125
2126 my $todo_reason = $Test->todo;
2127 my $todo_reason = $Test->todo($pack);
2128
2129If the current tests are considered "TODO" it will return the reason,
2130if any. This reason can come from a C<$TODO> variable or the last call
2131to C<todo_start()>.
2132
2133Since a TODO test does not need a reason, this function can return an
2134empty string even when inside a TODO block. Use C<< $Test->in_todo >>
2135to determine if you are currently inside a TODO block.
2136
2137C<todo()> is about finding the right package to look for C<$TODO> in. It's
2138pretty good at guessing the right package to look at. It first looks for
2139the caller based on C<$Level + 1>, since C<todo()> is usually called inside
2140a test function. As a last resort it will use C<exported_to()>.
2141
2142Sometimes there is some confusion about where todo() should be looking
2143for the C<$TODO> variable. If you want to be sure, tell it explicitly
2144what $pack to use.
2145
2146=cut
2147
2148
# spent 313µs (76+237) within Test::Builder::todo which was called 5 times, avg 63µs/call: # 5 times (76µs+237µs) by Test::Builder::ok at line 788, avg 63µs/call
sub todo {
214957µs my( $self, $pack ) = @_;
2150
215156µs return $self->{Todo} if defined $self->{Todo};
2152
215357µs local $Level = $Level + 1;
2154518µs5237µs my $todo = $self->find_TODO($pack);
# spent 237µs making 5 calls to Test::Builder::find_TODO, avg 47µs/call
215552µs return $todo if defined $todo;
2156
2157532µs return '';
2158}
2159
2160=item B<find_TODO>
2161
2162 my $todo_reason = $Test->find_TODO();
2163 my $todo_reason = $Test->find_TODO($pack);
2164
2165Like C<todo()> but only returns the value of C<$TODO> ignoring
2166C<todo_start()>.
2167
2168Can also be used to set C<$TODO> to a new value while returning the
2169old value:
2170
2171 my $old_reason = $Test->find_TODO($pack, 1, $new_reason);
2172
2173=cut
2174
2175
# spent 660µs (207+452) within Test::Builder::find_TODO which was called 15 times, avg 44µs/call: # 10 times (130µs+293µs) by Test::Builder::in_todo at line 2199, avg 42µs/call # 5 times (77µs+159µs) by Test::Builder::todo at line 2154, avg 47µs/call
sub find_TODO {
21761520µs my( $self, $pack, $set, $new_value ) = @_;
2177
21781555µs15452µs $pack = $pack || $self->caller(1) || $self->exported_to;
# spent 452µs making 15 calls to Test::Builder::caller, avg 30µs/call
2179156µs return unless $pack;
2180
21813726µs230µs
# spent 19µs (7+11) within Test::Builder::BEGIN@2181 which was called: # once (7µs+11µs) by Test::Builder::Module::BEGIN@5 at line 2181
no strict 'refs'; ## no critic
# spent 19µs making 1 call to Test::Builder::BEGIN@2181 # spent 11µs making 1 call to strict::unimport
21821538µs my $old_value = ${ $pack . '::TODO' };
2183156µs $set and ${ $pack . '::TODO' } = $new_value;
21841583µs return $old_value;
2185}
2186
2187=item B<in_todo>
2188
2189 my $in_todo = $Test->in_todo;
2190
2191Returns true if the test is currently inside a TODO block.
2192
2193=cut
2194
2195
# spent 532µs (109+423) within Test::Builder::in_todo which was called 10 times, avg 53µs/call: # 5 times (52µs+218µs) by Test::Builder::ok at line 817, avg 54µs/call # 5 times (57µs+205µs) by Test::Builder::ok at line 789, avg 52µs/call
sub in_todo {
2196108µs my $self = shift;
2197
21981011µs local $Level = $Level + 1;
21991087µs10423µs return( defined $self->{Todo} || $self->find_TODO ) ? 1 : 0;
# spent 423µs making 10 calls to Test::Builder::find_TODO, avg 42µs/call
2200}
2201
2202=item B<todo_start>
2203
2204 $Test->todo_start();
2205 $Test->todo_start($message);
2206
2207This method allows you declare all subsequent tests as TODO tests, up until
2208the C<todo_end> method has been called.
2209
2210The C<TODO:> and C<$TODO> syntax is generally pretty good about figuring out
2211whether or not we're in a TODO test. However, often we find that this is not
2212possible to determine (such as when we want to use C<$TODO> but
2213the tests are being executed in other packages which can't be inferred
2214beforehand).
2215
2216Note that you can use this to nest "todo" tests
2217
2218 $Test->todo_start('working on this');
2219 # lots of code
2220 $Test->todo_start('working on that');
2221 # more code
2222 $Test->todo_end;
2223 $Test->todo_end;
2224
2225This is generally not recommended, but large testing systems often have weird
2226internal needs.
2227
2228We've tried to make this also work with the TODO: syntax, but it's not
2229guaranteed and its use is also discouraged:
2230
2231 TODO: {
2232 local $TODO = 'We have work to do!';
2233 $Test->todo_start('working on this');
2234 # lots of code
2235 $Test->todo_start('working on that');
2236 # more code
2237 $Test->todo_end;
2238 $Test->todo_end;
2239 }
2240
2241Pick one style or another of "TODO" to be on the safe side.
2242
2243=cut
2244
2245sub todo_start {
2246 my $self = shift;
2247 my $message = @_ ? shift : '';
2248
2249 $self->{Start_Todo}++;
2250 if( $self->in_todo ) {
2251 push @{ $self->{Todo_Stack} } => $self->todo;
2252 }
2253 $self->{Todo} = $message;
2254
2255 return;
2256}
2257
2258=item C<todo_end>
2259
2260 $Test->todo_end;
2261
2262Stops running tests as "TODO" tests. This method is fatal if called without a
2263preceding C<todo_start> method call.
2264
2265=cut
2266
2267sub todo_end {
2268 my $self = shift;
2269
2270 if( !$self->{Start_Todo} ) {
2271 $self->croak('todo_end() called without todo_start()');
2272 }
2273
2274 $self->{Start_Todo}--;
2275
2276 if( $self->{Start_Todo} && @{ $self->{Todo_Stack} } ) {
2277 $self->{Todo} = pop @{ $self->{Todo_Stack} };
2278 }
2279 else {
2280 delete $self->{Todo};
2281 }
2282
2283 return;
2284}
2285
2286=item B<caller>
2287
2288 my $package = $Test->caller;
2289 my($pack, $file, $line) = $Test->caller;
2290 my($pack, $file, $line) = $Test->caller($height);
2291
2292Like the normal C<caller()>, except it reports according to your C<level()>.
2293
2294C<$height> will be added to the C<level()>.
2295
2296If C<caller()> winds up off the top of the stack it report the highest context.
2297
2298=cut
2299
2300
# spent 621µs (548+74) within Test::Builder::caller which was called 19 times, avg 33µs/call: # 15 times (397µs+55µs) by Test::Builder::find_TODO at line 2178, avg 30µs/call # 4 times (150µs+18µs) by Test::Builder::cmp_ok at line 1119, avg 42µs/call
sub caller { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
23011921µs my( $self, $height ) = @_;
23021910µs $height ||= 0;
2303
23041971µs1974µs my $level = $self->level + $height + 1;
# spent 74µs making 19 calls to Test::Builder::level, avg 4µs/call
2305199µs my @caller;
23061945µs do {
230719213µs @caller = CORE::caller( $level );
23081916µs $level--;
2309 } until @caller;
231019156µs return wantarray ? @caller : $caller[0];
2311}
2312
2313=back
2314
2315=cut
2316
2317=begin _private
2318
2319=over 4
2320
2321=item B<_sanity_check>
2322
2323 $self->_sanity_check();
2324
2325Runs a bunch of end of test sanity checks to make sure reality came
2326through ok. If anything is wrong it will die with a fairly friendly
2327error message.
2328
2329=cut
2330
2331#'#
2332sub _sanity_check {
2333 my $self = shift;
2334
2335 $self->_whoa( $self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!' );
2336 $self->_whoa( $self->{Curr_Test} != @{ $self->{Test_Results} },
2337 'Somehow you got a different number of results than tests ran!' );
2338
2339 return;
2340}
2341
2342=item B<_whoa>
2343
2344 $self->_whoa($check, $description);
2345
2346A sanity check, similar to C<assert()>. If the C<$check> is true, something
2347has gone horribly wrong. It will die with the given C<$description> and
2348a note to contact the author.
2349
2350=cut
2351
2352sub _whoa {
2353 my( $self, $check, $desc ) = @_;
2354 if($check) {
2355 local $Level = $Level + 1;
2356 $self->croak(<<"WHOA");
2357WHOA! $desc
2358This should never happen! Please contact the author immediately!
2359WHOA
2360 }
2361
2362 return;
2363}
2364
2365=item B<_my_exit>
2366
2367 _my_exit($exit_num);
2368
2369Perl seems to have some trouble with exiting inside an C<END> block.
23705.6.1 does some odd things. Instead, this function edits C<$?>
2371directly. It should B<only> be called from inside an C<END> block.
2372It doesn't actually exit, that's your job.
2373
2374=cut
2375
2376
# spent 6µs within Test::Builder::_my_exit which was called: # once (6µs+0s) by Test::Builder::_ending at line 2479
sub _my_exit {
237712µs $? = $_[0]; ## no critic (Variables::RequireLocalizedPunctuationVars)
2378
237919µs return 1;
2380}
2381
2382=back
2383
2384=end _private
2385
2386=cut
2387
2388
# spent 117µs (96+20) within Test::Builder::_ending which was called: # once (96µs+20µs) by Test::Builder::END at line 2502
sub _ending {
238911µs my $self = shift;
239017µs19µs return if $self->no_ending;
# spent 9µs making 1 call to Test::Builder::__ANON__[Test/Builder.pm:1598]
239113µs return if $self->{Ending}++;
2392
239312µs my $real_exit_code = $?;
2394
2395 # Don't bother with an ending if this is a forked copy. Only the parent
2396 # should do the ending.
239713µs if( $self->{Original_Pid} != $$ ) {
2398 return;
2399 }
2400
2401 # Ran tests but never declared a plan or hit done_testing
240212µs if( !$self->{Have_Plan} and $self->{Curr_Test} ) {
2403 $self->is_passing(0);
2404 $self->diag("Tests were run but no plan was declared and done_testing() was not seen.");
2405 }
2406
2407 # Exit if plan() was never called. This is so "require Test::Simple"
2408 # doesn't puke.
240911µs if( !$self->{Have_Plan} ) {
2410 return;
2411 }
2412
2413 # Don't do an ending if we bailed out.
241411µs if( $self->{Bailed_Out} ) {
2415 $self->is_passing(0);
2416 return;
2417 }
2418 # Figure out if we passed or failed and print helpful messages.
241912µs my $test_results = $self->{Test_Results};
242012µs if(@$test_results) {
2421 # The plan? We have no plan.
242212µs if( $self->{No_Plan} ) {
2423 $self->_output_plan($self->{Curr_Test}) unless $self->no_header;
2424 $self->{Expected_Tests} = $self->{Curr_Test};
2425 }
2426
2427 # Auto-extended arrays and elements which aren't explicitly
2428 # filled in with a shared reference will puke under 5.8.0
2429 # ithreads. So we have to fill them in by hand. :(
243017µs15µs my $empty_result = &share( {} );
# spent 5µs making 1 call to Test::Builder::__ANON__[Test/Builder.pm:66]
243118µs for my $idx ( 0 .. $self->{Expected_Tests} - 1 ) {
243258µs $test_results->[$idx] = $empty_result
2433 unless defined $test_results->[$idx];
2434 }
2435
2436114µs my $num_failed = grep !$_->{'ok'}, @{$test_results}[ 0 .. $self->{Curr_Test} - 1 ];
2437
243812µs my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests};
2439
24401900ns if( $num_extra != 0 ) {
2441 my $s = $self->{Expected_Tests} == 1 ? '' : 's';
2442 $self->diag(<<"FAIL");
2443Looks like you planned $self->{Expected_Tests} test$s but ran $self->{Curr_Test}.
2444FAIL
2445 $self->is_passing(0);
2446 }
2447
24481800ns if($num_failed) {
2449 my $num_tests = $self->{Curr_Test};
2450 my $s = $num_failed == 1 ? '' : 's';
2451
2452 my $qualifier = $num_extra == 0 ? '' : ' run';
2453
2454 $self->diag(<<"FAIL");
2455Looks like you failed $num_failed test$s of $num_tests$qualifier.
2456FAIL
2457 $self->is_passing(0);
2458 }
2459
24601600ns if($real_exit_code) {
2461 $self->diag(<<"FAIL");
2462Looks like your test exited with $real_exit_code just after $self->{Curr_Test}.
2463FAIL
2464 $self->is_passing(0);
2465 _my_exit($real_exit_code) && return;
2466 }
2467
246811µs my $exit_code;
246912µs if($num_failed) {
2470 $exit_code = $num_failed <= 254 ? $num_failed : 254;
2471 }
2472 elsif( $num_extra != 0 ) {
2473 $exit_code = 255;
2474 }
2475 else {
247611µs $exit_code = 0;
2477 }
2478
2479114µs16µs _my_exit($exit_code) && return;
# spent 6µs making 1 call to Test::Builder::_my_exit
2480 }
2481 elsif( $self->{Skip_All} ) {
2482 _my_exit(0) && return;
2483 }
2484 elsif($real_exit_code) {
2485 $self->diag(<<"FAIL");
2486Looks like your test exited with $real_exit_code before it could output anything.
2487FAIL
2488 $self->is_passing(0);
2489 _my_exit($real_exit_code) && return;
2490 }
2491 else {
2492 $self->diag("No tests run!\n");
2493 $self->is_passing(0);
2494 _my_exit(255) && return;
2495 }
2496
2497 $self->is_passing(0);
2498 $self->_whoa( 1, "We fell off the end of _ending()" );
2499}
2500
2501
# spent 132µs (16+117) within Test::Builder::END which was called: # once (16µs+117µs) by main::RUNTIME at line 0 of xt/tapper-mcp-scheduler-with-db-longrun.t
END {
2502114µs1117µs $Test->_ending if defined $Test;
# spent 117µs making 1 call to Test::Builder::_ending
2503}
2504
2505=head1 EXIT CODES
2506
2507If all your tests passed, Test::Builder will exit with zero (which is
2508normal). If anything failed it will exit with how many failed. If
2509you run less (or more) tests than you planned, the missing (or extras)
2510will be considered failures. If no tests were ever run Test::Builder
2511will throw a warning and exit with 255. If the test died, even after
2512having successfully completed all its tests, it will still be
2513considered a failure and will exit with 255.
2514
2515So the exit codes are...
2516
2517 0 all tests successful
2518 255 test died or all passed but wrong # of tests run
2519 any other number how many failed (including missing or extras)
2520
2521If you fail more than 254 tests, it will be reported as 254.
2522
2523=head1 THREADS
2524
2525In perl 5.8.1 and later, Test::Builder is thread-safe. The test
2526number is shared amongst all threads. This means if one thread sets
2527the test number using C<current_test()> they will all be effected.
2528
2529While versions earlier than 5.8.1 had threads they contain too many
2530bugs to support.
2531
2532Test::Builder is only thread-aware if threads.pm is loaded I<before>
2533Test::Builder.
2534
2535=head1 MEMORY
2536
2537An informative hash, accessible via C<<details()>>, is stored for each
2538test you perform. So memory usage will scale linearly with each test
2539run. Although this is not a problem for most test suites, it can
2540become an issue if you do large (hundred thousands to million)
2541combinatorics tests in the same run.
2542
2543In such cases, you are advised to either split the test file into smaller
2544ones, or use a reverse approach, doing "normal" (code) compares and
2545triggering fail() should anything go unexpected.
2546
2547Future versions of Test::Builder will have a way to turn history off.
2548
2549
2550=head1 EXAMPLES
2551
2552CPAN can provide the best examples. Test::Simple, Test::More,
2553Test::Exception and Test::Differences all use Test::Builder.
2554
2555=head1 SEE ALSO
2556
2557Test::Simple, Test::More, Test::Harness
2558
2559=head1 AUTHORS
2560
2561Original code by chromatic, maintained by Michael G Schwern
2562E<lt>schwern@pobox.comE<gt>
2563
2564=head1 COPYRIGHT
2565
2566Copyright 2002-2008 by chromatic E<lt>chromatic@wgz.orgE<gt> and
2567 Michael G Schwern E<lt>schwern@pobox.comE<gt>.
2568
2569This program is free software; you can redistribute it and/or
2570modify it under the same terms as Perl itself.
2571
2572See F<http://www.perl.com/perl/misc/Artistic.html>
2573
2574=cut
2575
2576112µs1;
2577
 
# spent 9µs within Test::Builder::CORE:binmode which was called 2 times, avg 4µs/call: # 2 times (9µs+0s) by Test::Builder::_apply_layers at line 1916, avg 4µs/call
sub Test::Builder::CORE:binmode; # opcode
# spent 41µs within Test::Builder::CORE:match which was called 11 times, avg 4µs/call: # 6 times (15µs+0s) by Test::Builder::_print_to_fh at line 1757, avg 2µs/call # 5 times (27µs+0s) by Test::Builder::ok at line 781, avg 5µs/call
sub Test::Builder::CORE:match; # opcode
# spent 71µs within Test::Builder::CORE:open which was called 2 times, avg 35µs/call: # once (66µs+0s) by Test::Builder::_open_testhandles at line 1886 # once (5µs+0s) by Test::Builder::_open_testhandles at line 1887
sub Test::Builder::CORE:open; # opcode
# spent 203µs within Test::Builder::CORE:print which was called 6 times, avg 34µs/call: # 6 times (203µs+0s) by Test::Builder::_print_to_fh at line 1759, avg 34µs/call
sub Test::Builder::CORE:print; # opcode
# spent 7µs within Test::Builder::CORE:select which was called 8 times, avg 888ns/call: # 4 times (5µs+0s) by Test::Builder::_autoflush at line 1853, avg 1µs/call # 4 times (2µs+0s) by Test::Builder::_autoflush at line 1855, avg 600ns/call
sub Test::Builder::CORE:select; # opcode
# spent 35µs within Test::Builder::CORE:subst which was called 11 times, avg 3µs/call: # 6 times (26µs+0s) by Test::Builder::_print_to_fh at line 1754, avg 4µs/call # 5 times (10µs+0s) by Test::Builder::ok at line 809, avg 2µs/call
sub Test::Builder::CORE:subst; # opcode