Profile of Test/Builder.pm

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

Filename | /home/ss5/perl5/perlbrew/perls/tapper-perl/lib/5.16.3/Test/Builder.pm
Statements | Executed 1340 statements in 10.7ms

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