Profile of Test/Builder.pm

← Index
NYTProf Performance Profile «line view»
For t/bug-md-11.t
Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:22 2024

Filename | /home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm
Statements | Executed 283 statements in 6.59ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 5.39ms | 27.5ms | Test::Builder::::BEGIN@18Test::Builder::BEGIN@18
1 | 1 | 1 | 1.33ms | 11.2ms | Test::Builder::::BEGIN@17Test::Builder::BEGIN@17
1 | 1 | 1 | 1.17ms | 1.48ms | Test::Builder::::BEGIN@15Test::Builder::BEGIN@15
1 | 1 | 1 | 343µs | 2.62ms | Test::Builder::::BEGIN@36Test::Builder::BEGIN@36
1 | 1 | 1 | 164µs | 202µs | Test::Builder::::BEGIN@37Test::Builder::BEGIN@37
1 | 1 | 1 | 47µs | 430µs | Test::Builder::::resetTest::Builder::reset
1 | 1 | 1 | 45µs | 353µs | Test::Builder::::done_testingTest::Builder::done_testing
1 | 1 | 1 | 40µs | 256µs | Test::Builder::::okTest::Builder::ok
1 | 1 | 1 | 29µs | 43µs | Test::Builder::::_endingTest::Builder::_ending
1 | 1 | 1 | 28µs | 59µs | Test::Builder::::reset_outputsTest::Builder::reset_outputs
8 | 8 | 1 | 20µs | 419µs | Test::Builder::::ctxTest::Builder::ctx
5 | 2 | 2 | 16µs | 53µs | Test::Builder::::newTest::Builder::new
1 | 1 | 1 | 16µs | 48µs | Test::Builder::::use_numbersTest::Builder::use_numbers
1 | 1 | 1 | 15µs | 58µs | Test::Builder::::__ANON__[:156]Test::Builder::__ANON__[:156]
3 | 1 | 1 | 14µs | 14µs | Test::Builder::::__ANON__[:88]Test::Builder::__ANON__[:88]
1 | 1 | 1 | 14µs | 14µs | Test::Builder::::BEGIN@3Test::Builder::BEGIN@3
1 | 1 | 1 | 12µs | 12µs | Test::Builder::::BEGIN@1232Test::Builder::BEGIN@1232
1 | 1 | 1 | 11µs | 29µs | Test::Builder::::expected_testsTest::Builder::expected_tests
1 | 1 | 1 | 11µs | 40µs | Test::Builder::::current_testTest::Builder::current_test
1 | 1 | 1 | 8µs | 9µs | Test::Builder::::BEGIN@33Test::Builder::BEGIN@33
1 | 1 | 1 | 8µs | 13µs | Test::Builder::::_add_ts_hooksTest::Builder::_add_ts_hooks
1 | 1 | 1 | 7µs | 13µs | Test::Builder::::createTest::Builder::create
1 | 1 | 1 | 7µs | 19µs | Test::Builder::::BEGIN@1519Test::Builder::BEGIN@1519
8 | 1 | 1 | 7µs | 7µs | Test::Builder::::__ANON__[:154]Test::Builder::__ANON__[:154]
1 | 1 | 1 | 6µs | 11µs | Test::Builder::::BEGIN@1518Test::Builder::BEGIN@1518
1 | 1 | 1 | 6µs | 10µs | Test::Builder::::BEGIN@1251Test::Builder::BEGIN@1251
1 | 1 | 1 | 6µs | 449µs | Test::Builder::::__ANON__[:148]Test::Builder::__ANON__[:148]
1 | 1 | 1 | 6µs | 6µs | Test::Builder::::BEGIN@34Test::Builder::BEGIN@34
1 | 1 | 1 | 6µs | 9µs | Test::Builder::::BEGIN@1556Test::Builder::BEGIN@1556
1 | 1 | 1 | 5µs | 21µs | Test::Builder::::BEGIN@684Test::Builder::BEGIN@684
1 | 1 | 1 | 5µs | 19µs | Test::Builder::::BEGIN@1057Test::Builder::BEGIN@1057
1 | 1 | 1 | 5µs | 9µs | Test::Builder::::BEGIN@1539Test::Builder::BEGIN@1539
1 | 1 | 1 | 5µs | 18µs | Test::Builder::::BEGIN@797Test::Builder::BEGIN@797
1 | 1 | 1 | 5µs | 9µs | Test::Builder::::BEGIN@102Test::Builder::BEGIN@102
1 | 1 | 1 | 5µs | 18µs | Test::Builder::::BEGIN@1167Test::Builder::BEGIN@1167
1 | 1 | 1 | 5µs | 8µs | Test::Builder::::BEGIN@116Test::Builder::BEGIN@116
1 | 1 | 1 | 5µs | 12µs | Test::Builder::::BEGIN@20Test::Builder::BEGIN@20
1 | 1 | 1 | 5µs | 9µs | Test::Builder::::BEGIN@61Test::Builder::BEGIN@61
1 | 1 | 1 | 4µs | 19µs | Test::Builder::::BEGIN@120Test::Builder::BEGIN@120
1 | 1 | 1 | 4µs | 14µs | Test::Builder::::BEGIN@131Test::Builder::BEGIN@131
1 | 1 | 1 | 4µs | 26µs | Test::Builder::::BEGIN@693Test::Builder::BEGIN@693
1 | 1 | 1 | 4µs | 5µs | Test::Builder::::BEGIN@4Test::Builder::BEGIN@4
1 | 1 | 1 | 4µs | 15µs | Test::Builder::::INITTest::Builder::INIT
1 | 1 | 1 | 4µs | 14µs | Test::Builder::::BEGIN@103Test::Builder::BEGIN@103
1 | 1 | 1 | 4µs | 14µs | Test::Builder::::BEGIN@1540Test::Builder::BEGIN@1540
1 | 1 | 1 | 4µs | 15µs | Test::Builder::::BEGIN@62Test::Builder::BEGIN@62
1 | 1 | 1 | 3µs | 13µs | Test::Builder::::BEGIN@1557Test::Builder::BEGIN@1557
1 | 1 | 1 | 3µs | 17µs | Test::Builder::::BEGIN@133Test::Builder::BEGIN@133
1 | 1 | 1 | 3µs | 23µs | Test::Builder::::BEGIN@5Test::Builder::BEGIN@5
1 | 1 | 1 | 3µs | 12µs | Test::Builder::::BEGIN@117Test::Builder::BEGIN@117
1 | 1 | 1 | 3µs | 10µs | Test::Builder::::BEGIN@121Test::Builder::BEGIN@121
2 | 2 | 2 | 2µs | 2µs | Test::Builder::::exported_toTest::Builder::exported_to
1 | 1 | 1 | 2µs | 2µs | Test::Builder::::BEGIN@9Test::Builder::BEGIN@9
3 | 3 | 1 | 1µs | 1µs | Test::Builder::::__ANON__Test::Builder::__ANON__ (xsub)
1 | 1 | 1 | 1µs | 1µs | Test::Builder::::planTest::Builder::plan
0 | 0 | 0 | 0s | 0s | Test::Builder::::BAIL_OUTTest::Builder::BAIL_OUT
0 | 0 | 0 | 0s | 0s | Test::Builder::::__ANON__[:111]Test::Builder::__ANON__[:111]
0 | 0 | 0 | 0s | 0s | Test::Builder::::__ANON__[:1249]Test::Builder::__ANON__[:1249]
0 | 0 | 0 | 0s | 0s | Test::Builder::::__ANON__[:125]Test::Builder::__ANON__[:125]
0 | 0 | 0 | 0s | 0s | Test::Builder::::__ANON__[:1591]Test::Builder::__ANON__[:1591]
0 | 0 | 0 | 0s | 0s | Test::Builder::::__ANON__[:245]Test::Builder::__ANON__[:245]
0 | 0 | 0 | 0s | 0s | Test::Builder::::__ANON__[:247]Test::Builder::__ANON__[:247]
0 | 0 | 0 | 0s | 0s | Test::Builder::::__ANON__[:764]Test::Builder::__ANON__[:764]
0 | 0 | 0 | 0s | 0s | Test::Builder::::_autoflushTest::Builder::_autoflush
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::::_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::::_new_fhTest::Builder::_new_fh
0 | 0 | 0 | 0s | 0s | Test::Builder::::_ok_debugTest::Builder::_ok_debug
0 | 0 | 0 | 0s | 0s | Test::Builder::::_plan_testsTest::Builder::_plan_tests
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::::_tryTest::Builder::_try
0 | 0 | 0 | 0s | 0s | Test::Builder::::_unoverloadTest::Builder::_unoverload
0 | 0 | 0 | 0s | 0s | Test::Builder::::_unoverload_numTest::Builder::_unoverload_num
0 | 0 | 0 | 0s | 0s | Test::Builder::::_unoverload_strTest::Builder::_unoverload_str
0 | 0 | 0 | 0s | 0s | Test::Builder::::callerTest::Builder::caller
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::::cmp_okTest::Builder::cmp_ok
0 | 0 | 0 | 0s | 0s | Test::Builder::::coordinate_forksTest::Builder::coordinate_forks
0 | 0 | 0 | 0s | 0s | Test::Builder::::croakTest::Builder::croak
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::::explainTest::Builder::explain
0 | 0 | 0 | 0s | 0s | Test::Builder::::failure_outputTest::Builder::failure_output
0 | 0 | 0 | 0s | 0s | Test::Builder::::finalizeTest::Builder::finalize
0 | 0 | 0 | 0s | 0s | Test::Builder::::find_TODOTest::Builder::find_TODO
0 | 0 | 0 | 0s | 0s | Test::Builder::::has_planTest::Builder::has_plan
0 | 0 | 0 | 0s | 0s | Test::Builder::::in_todoTest::Builder::in_todo
0 | 0 | 0 | 0s | 0s | Test::Builder::::is_eqTest::Builder::is_eq
0 | 0 | 0 | 0s | 0s | Test::Builder::::is_fhTest::Builder::is_fh
0 | 0 | 0 | 0s | 0s | Test::Builder::::is_numTest::Builder::is_num
0 | 0 | 0 | 0s | 0s | Test::Builder::::is_passingTest::Builder::is_passing
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::::levelTest::Builder::level
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_endingTest::Builder::no_ending
0 | 0 | 0 | 0s | 0s | Test::Builder::::no_log_resultsTest::Builder::no_log_results
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::::outputTest::Builder::output
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::::todoTest::Builder::todo
0 | 0 | 0 | 0s | 0s | Test::Builder::::todo_endTest::Builder::todo_end
0 | 0 | 0 | 0s | 0s | Test::Builder::::todo_outputTest::Builder::todo_output
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 | 31µs | 1 | 14µs | # spent 14µs within Test::Builder::BEGIN@3 which was called: # once (14µs+0s) by Test::Builder::Module::BEGIN@5 at line 3 use 5.006; # spent 14µs making 1 call to Test::Builder::BEGIN@3
4 | 2 | 13µs | 2 | 7µs | # spent 5µs (4+2) within Test::Builder::BEGIN@4 which was called: # once (4µs+2µs) by Test::Builder::Module::BEGIN@5 at line 4 use strict; # spent 5µs making 1 call to Test::Builder::BEGIN@4 # spent 2µs making 1 call to strict::import
5 | 2 | 36µs | 2 | 42µs | # spent 23µs (3+20) within Test::Builder::BEGIN@5 which was called: # once (3µs+20µs) by Test::Builder::Module::BEGIN@5 at line 5 use warnings; # spent 23µs making 1 call to Test::Builder::BEGIN@5 # spent 20µs making 1 call to warnings::import
6 |  |  |  |  |
7 | 1 | 400ns |  |  | our $VERSION = '1.302198';
8 |  |  |  |  |
9 |  |  |  |  | # spent 2µs within Test::Builder::BEGIN@9 which was called: # once (2µs+0s) by Test::Builder::Module::BEGIN@5 at line 13 BEGIN {
10 | 1 | 2µs |  |  | if( $] < 5.008 ) {
11 |  |  |  |  | require Test::Builder::IO::Scalar;
12 |  |  |  |  | }
13 | 1 | 19µs | 1 | 2µs | } # spent 2µs making 1 call to Test::Builder::BEGIN@9
14 |  |  |  |  |
15 | 2 | 101µs | 2 | 1.52ms | # spent 1.48ms (1.17+307µs) within Test::Builder::BEGIN@15 which was called: # once (1.17ms+307µs) by Test::Builder::Module::BEGIN@5 at line 15 use Scalar::Util qw/blessed reftype weaken/; # spent 1.48ms making 1 call to Test::Builder::BEGIN@15 # spent 41µs making 1 call to Exporter::import
16 |  |  |  |  |
17 | 2 | 88µs | 2 | 11.2ms | # spent 11.2ms (1.33+9.87) within Test::Builder::BEGIN@17 which was called: # once (1.33ms+9.87ms) by Test::Builder::Module::BEGIN@5 at line 17 use Test2::Util qw/USE_THREADS try get_tid/; # spent 11.2ms making 1 call to Test::Builder::BEGIN@17 # spent 39µs making 1 call to Exporter::import
18 | 2 | 112µs | 2 | 27.6ms | # spent 27.5ms (5.39+22.1) within Test::Builder::BEGIN@18 which was called: # once (5.39ms+22.1ms) by Test::Builder::Module::BEGIN@5 at line 18 use Test2::API qw/context release/; # spent 27.5ms making 1 call to Test::Builder::BEGIN@18 # spent 79µs making 1 call to Exporter::import
19 |  |  |  |  | # Make Test::Builder thread-safe for ithreads.
20 |  |  |  |  | # spent 12µs (5+7) within Test::Builder::BEGIN@20 which was called: # once (5µs+7µs) by Test::Builder::Module::BEGIN@5 at line 31 BEGIN {
21 | 1 | 1µs | 2 | 7µs | warn "Test::Builder was loaded after Test2 initialization, this is not recommended." # spent 5µs making 1 call to Test2::API::test2_init_done # spent 2µs making 1 call to Test2::API::test2_load_done
22 |  |  |  |  | if Test2::API::test2_init_done() || Test2::API::test2_load_done();
23 |  |  |  |  |
24 | 1 | 1µs |  |  | if (USE_THREADS && ! Test2::API::test2_ipc_disabled()) {
25 |  |  |  |  | require Test2::IPC;
26 |  |  |  |  | require Test2::IPC::Driver::Files;
27 |  |  |  |  | Test2::IPC::Driver::Files->import;
28 |  |  |  |  | Test2::API::test2_ipc_enable_polling();
29 |  |  |  |  | Test2::API::test2_no_wait(1);
30 |  |  |  |  | }
31 | 1 | 13µs | 1 | 12µs | } # spent 12µs making 1 call to Test::Builder::BEGIN@20
32 |  |  |  |  |
33 | 2 | 18µs | 2 | 9µs | # spent 9µs (8+300ns) within Test::Builder::BEGIN@33 which was called: # once (8µs+300ns) by Test::Builder::Module::BEGIN@5 at line 33 use Test2::Event::Subtest; # spent 9µs making 1 call to Test::Builder::BEGIN@33 # spent 300ns making 1 call to Test::Builder::__ANON__
34 | 2 | 15µs | 2 | 6µs | # spent 6µs (6+200ns) within Test::Builder::BEGIN@34 which was called: # once (6µs+200ns) by Test::Builder::Module::BEGIN@5 at line 34 use Test2::Hub::Subtest; # spent 6µs making 1 call to Test::Builder::BEGIN@34 # spent 200ns making 1 call to Test::Builder::__ANON__
35 |  |  |  |  |
36 | 2 | 72µs | 2 | 2.63ms | # spent 2.62ms (343µs+2.28) within Test::Builder::BEGIN@36 which was called: # once (343µs+2.28ms) by Test::Builder::Module::BEGIN@5 at line 36 use Test::Builder::Formatter; # spent 2.62ms making 1 call to Test::Builder::BEGIN@36 # spent 12µs making 1 call to Test2::Formatter::import
37 | 2 | 133µs | 2 | 203µs | # spent 202µs (164+39) within Test::Builder::BEGIN@37 which was called: # once (164µs+39µs) by Test::Builder::Module::BEGIN@5 at line 37 use Test::Builder::TodoDiag; # spent 202µs making 1 call to Test::Builder::BEGIN@37 # spent 700ns making 1 call to Test::Builder::__ANON__
38 |  |  |  |  |
39 | 1 | 200ns |  |  | our $Level = 1;
40 | 1 | 3µs | 1 | 48µs | our $Test = $ENV{TB_NO_EARLY_INIT} ? undef : Test::Builder->new; # spent 48µs making 1 call to Test::Builder::new
41 |  |  |  |  |
42 |  |  |  |  | # spent 13µs (8+5) within Test::Builder::_add_ts_hooks which was called: # once (8µs+5µs) by Test::Builder::__ANON__[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm:148] at line 147 sub _add_ts_hooks {
43 | 1 | 200ns |  |  | my $self = shift;
44 |  |  |  |  |
45 | 1 | 800ns | 1 | 900ns | my $hub = $self->{Stack}->top; # spent 900ns making 1 call to Test2::API::Stack::top
46 |  |  |  |  |
47 |  |  |  |  | # Take a reference to the hash key, we do this to avoid closing over $self
48 |  |  |  |  | # which is the singleton. We use a reference because the value could change
49 |  |  |  |  | # in rare cases.
50 | 1 | 400ns |  |  | my $epkgr = \$self->{Exported_To};
51 |  |  |  |  |
52 |  |  |  |  | #$hub->add_context_aquire(sub {$_[0]->{level} += $Level - 1});
53 |  |  |  |  |
54 |  |  |  |  | $hub->pre_filter(
55 |  |  |  |  | # spent 14µs within Test::Builder::__ANON__[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm:88] which was called 3 times, avg 5µs/call: # 3 times (14µs+0s) by Test2::Hub::send at line 301 of Test2/Hub.pm, avg 5µs/call sub {
56 | 3 | 800ns |  |  | my ($active_hub, $e) = @_;
57 |  |  |  |  |
58 | 3 | 800ns |  |  | my $epkg = $$epkgr;
59 | 3 | 2µs |  |  | my $cpkg = $e->{trace} ? $e->{trace}->{frame}->[0] : undef;
60 |  |  |  |  |
61 | 2 | 20µs | 2 | 12µs | # spent 9µs (5+4) within Test::Builder::BEGIN@61 which was called: # once (5µs+4µs) by Test::Builder::Module::BEGIN@5 at line 61 no strict 'refs'; # spent 9µs making 1 call to Test::Builder::BEGIN@61 # spent 4µs making 1 call to strict::unimport
62 | 2 | 130µs | 2 | 26µs | # spent 15µs (4+11) within Test::Builder::BEGIN@62 which was called: # once (4µs+11µs) by Test::Builder::Module::BEGIN@5 at line 62 no warnings 'once'; # spent 15µs making 1 call to Test::Builder::BEGIN@62 # spent 11µs making 1 call to warnings::unimport
63 | 3 | 300ns |  |  | my $todo;
64 | 3 | 4µs |  |  | $todo = ${"$cpkg\::TODO"} if $cpkg;
65 | 3 | 2µs |  |  | $todo = ${"$epkg\::TODO"} if $epkg && !$todo;
66 |  |  |  |  |
67 | 3 | 4µs |  |  | return $e unless defined($todo);
68 |  |  |  |  | return $e unless length($todo);
69 |  |  |  |  |
70 |  |  |  |  | # Turn a diag into a todo diag
71 |  |  |  |  | return Test::Builder::TodoDiag->new(%$e) if ref($e) eq 'Test2::Event::Diag';
72 |  |  |  |  |
73 |  |  |  |  | $e->set_todo($todo) if $e->can('set_todo');
74 |  |  |  |  | $e->add_amnesty({tag => 'TODO', details => $todo});
75 |  |  |  |  |
76 |  |  |  |  | # Set todo on ok's
77 |  |  |  |  | if ($e->isa('Test2::Event::Ok')) {
78 |  |  |  |  | $e->set_effective_pass(1);
79 |  |  |  |  |
80 |  |  |  |  | if (my $result = $e->get_meta(__PACKAGE__)) {
81 |  |  |  |  | $result->{reason} ||= $todo;
82 |  |  |  |  | $result->{type} ||= 'todo';
83 |  |  |  |  | $result->{ok} = 1;
84 |  |  |  |  | }
85 |  |  |  |  | }
86 |  |  |  |  |
87 |  |  |  |  | return $e;
88 |  |  |  |  | },
89 |  |  |  |  |
90 |  |  |  |  | inherit => 1,
91 |  |  |  |  |
92 |  |  |  |  | intercept_inherit => {
93 |  |  |  |  | clean => sub {
94 |  |  |  |  | my %params = @_;
95 |  |  |  |  |
96 |  |  |  |  | my $state = $params{state};
97 |  |  |  |  | my $trace = $params{trace};
98 |  |  |  |  |
99 |  |  |  |  | my $epkg = $$epkgr;
100 |  |  |  |  | my $cpkg = $trace->{frame}->[0];
101 |  |  |  |  |
102 | 2 | 20µs | 2 | 12µs | # spent 9µs (5+4) within Test::Builder::BEGIN@102 which was called: # once (5µs+4µs) by Test::Builder::Module::BEGIN@5 at line 102 no strict 'refs'; # spent 9µs making 1 call to Test::Builder::BEGIN@102 # spent 4µs making 1 call to strict::unimport
103 | 2 | 81µs | 2 | 25µs | # spent 14µs (4+11) within Test::Builder::BEGIN@103 which was called: # once (4µs+11µs) by Test::Builder::Module::BEGIN@5 at line 103 no warnings 'once'; # spent 14µs making 1 call to Test::Builder::BEGIN@103 # spent 11µs making 1 call to warnings::unimport
104 |  |  |  |  |
105 |  |  |  |  | $state->{+__PACKAGE__} = {};
106 |  |  |  |  | $state->{+__PACKAGE__}->{"$cpkg\::TODO"} = ${"$cpkg\::TODO"} if $cpkg;
107 |  |  |  |  | $state->{+__PACKAGE__}->{"$epkg\::TODO"} = ${"$epkg\::TODO"} if $epkg;
108 |  |  |  |  |
109 |  |  |  |  | ${"$cpkg\::TODO"} = undef if $cpkg;
110 |  |  |  |  | ${"$epkg\::TODO"} = undef if $epkg;
111 |  |  |  |  | },
112 |  |  |  |  | restore => sub {
113 |  |  |  |  | my %params = @_;
114 |  |  |  |  | my $state = $params{state};
115 |  |  |  |  |
116 | 2 | 19µs | 2 | 12µs | # spent 8µs (5+4) within Test::Builder::BEGIN@116 which was called: # once (5µs+4µs) by Test::Builder::Module::BEGIN@5 at line 116 no strict 'refs'; # spent 8µs making 1 call to Test::Builder::BEGIN@116 # spent 4µs making 1 call to strict::unimport
117 | 2 | 27µs | 2 | 22µs | # spent 12µs (3+10) within Test::Builder::BEGIN@117 which was called: # once (3µs+10µs) by Test::Builder::Module::BEGIN@5 at line 117 no warnings 'once'; # spent 12µs making 1 call to Test::Builder::BEGIN@117 # spent 10µs making 1 call to warnings::unimport
118 |  |  |  |  |
119 |  |  |  |  | for my $item (keys %{$state->{+__PACKAGE__}}) {
120 | 2 | 29µs | 2 | 34µs | # spent 19µs (4+15) within Test::Builder::BEGIN@120 which was called: # once (4µs+15µs) by Test::Builder::Module::BEGIN@5 at line 120 no strict 'refs'; # spent 19µs making 1 call to Test::Builder::BEGIN@120 # spent 15µs making 1 call to strict::unimport
121 | 2 | 61µs | 2 | 17µs | # spent 10µs (3+7) within Test::Builder::BEGIN@121 which was called: # once (3µs+7µs) by Test::Builder::Module::BEGIN@5 at line 121 no warnings 'once'; # spent 10µs making 1 call to Test::Builder::BEGIN@121 # spent 7µs making 1 call to warnings::unimport
122 |  |  |  |  |
123 |  |  |  |  | ${"$item"} = $state->{+__PACKAGE__}->{$item};
124 |  |  |  |  | }
125 |  |  |  |  | },
126 |  |  |  |  | },
127 | 1 | 6µs | 1 | 4µs | ); # spent 4µs making 1 call to Test2::Hub::pre_filter
128 |  |  |  |  | }
129 |  |  |  |  |
130 |  |  |  |  | {
131 | 2 | 17µs | 2 | 25µs | # spent 14µs (4+10) within Test::Builder::BEGIN@131 which was called: # once (4µs+10µs) by Test::Builder::Module::BEGIN@5 at line 131 no warnings; # spent 14µs making 1 call to Test::Builder::BEGIN@131 # spent 10µs making 1 call to warnings::unimport
132 |  |  |  |  | # spent 15µs (4+11) within Test::Builder::INIT which was called: # once (4µs+11µs) by main::RUNTIME at line 0 of /home/micha/Projekt/spreadsheet-parsexlsx/t/bug-md-11.t INIT {
133 | 2 | 1.68ms | 2 | 31µs | # spent 17µs (3+14) within Test::Builder::BEGIN@133 which was called: # once (3µs+14µs) by Test::Builder::Module::BEGIN@5 at line 133 use warnings; # spent 17µs making 1 call to Test::Builder::BEGIN@133 # spent 14µs making 1 call to warnings::import
134 | 1 | 4µs | 2 | 11µs | Test2::API::test2_load() unless Test2::API::test2_in_preload(); # spent 6µs making 1 call to Test2::API::test2_in_preload # spent 5µs making 1 call to Test2::API::test2_load
135 |  |  |  |  | }
136 |  |  |  |  | }
137 |  |  |  |  |
138 | 1 | 200ns |  |  | # spent 53µs (16+36) within Test::Builder::new which was called 5 times, avg 11µs/call: # 4 times (5µs+0s) by Test::Builder::Module::builder at line 172 of Test/Builder/Module.pm, avg 1µs/call # once (12µs+36µs) by Test::Builder::Module::BEGIN@5 at line 40 sub new {
139 | 5 | 1µs |  |  | my($class) = shift;
140 | 5 | 2µs |  |  | unless($Test) {
141 | 1 | 1µs | 1 | 13µs | $Test = $class->create(singleton => 1); # spent 13µs making 1 call to Test::Builder::create
142 |  |  |  |  |
143 |  |  |  |  | Test2::API::test2_add_callback_post_load(
144 |  |  |  |  | # spent 449µs (6+443) within Test::Builder::__ANON__[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm:148] which was called: # once (6µs+443µs) by Test2::API::Instance::load at line 322 of Test2/API/Instance.pm sub {
145 | 1 | 2µs |  |  | $Test->{Original_Pid} = $$ if !$Test->{Original_Pid} || $Test->{Original_Pid} == 0;
146 | 1 | 1µs | 1 | 430µs | $Test->reset(singleton => 1); # spent 430µs making 1 call to Test::Builder::reset
147 | 1 | 4µs | 1 | 13µs | $Test->_add_ts_hooks; # spent 13µs making 1 call to Test::Builder::_add_ts_hooks
148 |  |  |  |  | }
149 | 1 | 2µs | 1 | 11µs | ); # spent 11µs making 1 call to Test2::API::test2_add_callback_post_load
150 |  |  |  |  |
151 |  |  |  |  | # Non-TB tools normally expect 0 added to the level. $Level is normally 1. So
152 |  |  |  |  | # we only want the level to change if $Level != 1.
153 |  |  |  |  | # TB->ctx compensates for this later.
154 | 9 | 12µs | 1 | 5µs | # spent 7µs within Test::Builder::__ANON__[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm:154] which was called 8 times, avg 862ns/call: # 8 times (7µs+0s) by Test2::API::context at line 414 of Test2/API.pm, avg 862ns/call Test2::API::test2_add_callback_context_aquire(sub { $_[0]->{level} += $Level - 1 }); # spent 5µs making 1 call to Test2::API::test2_add_callback_context_aquire
155 |  |  |  |  |
156 | 2 | 5µs | 2 | 48µs | # spent 58µs (15+43) within Test::Builder::__ANON__[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm:156] which was called: # once (15µs+43µs) by Test2::API::Instance::set_exit at line 554 of Test2/API/Instance.pm Test2::API::test2_add_callback_exit(sub { $Test->_ending(@_) }); # spent 43µs making 1 call to Test::Builder::_ending # spent 4µs making 1 call to Test2::API::test2_add_callback_exit
157 |  |  |  |  |
158 | 1 | 900ns | 1 | 3µs | Test2::API::test2_ipc()->set_no_fatal(1) if Test2::API::test2_has_ipc(); # spent 3µs making 1 call to Test2::API::test2_has_ipc
159 |  |  |  |  | }
160 | 5 | 7µs |  |  | return $Test;
161 |  |  |  |  | }
162 |  |  |  |  |
163 |  |  |  |  | # spent 13µs (7+6) within Test::Builder::create which was called: # once (7µs+6µs) by Test::Builder::new at line 141 sub create {
164 | 1 | 200ns |  |  | my $class = shift;
165 | 1 | 700ns |  |  | my %params = @_;
166 |  |  |  |  |
167 | 1 | 600ns |  |  | my $self = bless {}, $class;
168 | 1 | 3µs | 1 | 6µs | if ($params{singleton}) { # spent 6µs making 1 call to Test2::API::test2_stack
169 |  |  |  |  | $self->{Stack} = Test2::API::test2_stack();
170 |  |  |  |  | }
171 |  |  |  |  | else {
172 |  |  |  |  | $self->{Stack} = Test2::API::Stack->new;
173 |  |  |  |  | $self->{Stack}->new_hub(
174 |  |  |  |  | formatter => Test::Builder::Formatter->new,
175 |  |  |  |  | ipc => Test2::API::test2_ipc(),
176 |  |  |  |  | );
177 |  |  |  |  |
178 |  |  |  |  | $self->reset(%params);
179 |  |  |  |  | $self->_add_ts_hooks;
180 |  |  |  |  | }
181 |  |  |  |  |
182 | 1 | 2µs |  |  | return $self;
183 |  |  |  |  | }
184 |  |  |  |  |
185 |  |  |  |  | # spent 419µs (20+400) within Test::Builder::ctx which was called 8 times, avg 52µs/call: # once (3µs+213µs) by Test::Builder::reset at line 445 # once (4µs+61µs) by Test::Builder::ok at line 677 # once (2µs+30µs) by Test::Builder::reset at line 453 # once (2µs+27µs) by Test::Builder::done_testing at line 584 # once (2µs+21µs) by Test::Builder::use_numbers at line 1220 # once (2µs+19µs) by Test::Builder::current_test at line 1437 # once (2µs+16µs) by Test::Builder::reset_outputs at line 1409 # once (2µs+13µs) by Test::Builder::expected_tests at line 542 sub ctx {
186 | 8 | 1µs |  |  | my $self = shift;
187 |  |  |  |  | context(
188 |  |  |  |  | # 1 for our frame, another for the -1 off of $Level in our hook at the top.
189 |  |  |  |  | level => 2,
190 |  |  |  |  | fudge => 1,
191 |  |  |  |  | stack => $self->{Stack},
192 |  |  |  |  | hub => $self->{Hub},
193 | 8 | 26µs | 8 | 400µs | wrapped => 1, # spent 400µs making 8 calls to Test2::API::context, avg 50µs/call
194 |  |  |  |  | @_
195 |  |  |  |  | );
196 |  |  |  |  | }
197 |  |  |  |  |
198 |  |  |  |  | sub parent {
199 |  |  |  |  | my $self = shift;
200 |  |  |  |  | my $ctx = $self->ctx;
201 |  |  |  |  | my $chub = $self->{Hub} || $ctx->hub;
202 |  |  |  |  | $ctx->release;
203 |  |  |  |  |
204 |  |  |  |  | my $meta = $chub->meta(__PACKAGE__, {});
205 |  |  |  |  | my $parent = $meta->{parent};
206 |  |  |  |  |
207 |  |  |  |  | return undef unless $parent;
208 |  |  |  |  |
209 |  |  |  |  | return bless {
210 |  |  |  |  | Original_Pid => $$,
211 |  |  |  |  | Stack => $self->{Stack},
212 |  |  |  |  | Hub => $parent,
213 |  |  |  |  | }, blessed($self);
214 |  |  |  |  | }
215 |  |  |  |  |
216 |  |  |  |  | sub child {
217 |  |  |  |  | my( $self, $name ) = @_;
218 |  |  |  |  |
219 |  |  |  |  | $name ||= "Child of " . $self->name;
220 |  |  |  |  | my $ctx = $self->ctx;
221 |  |  |  |  |
222 |  |  |  |  | my $parent = $ctx->hub;
223 |  |  |  |  | my $pmeta = $parent->meta(__PACKAGE__, {});
224 |  |  |  |  | $self->croak("You already have a child named ($pmeta->{child}) running")
225 |  |  |  |  | if $pmeta->{child};
226 |  |  |  |  |
227 |  |  |  |  | $pmeta->{child} = $name;
228 |  |  |  |  |
229 |  |  |  |  | # Clear $TODO for the child.
230 |  |  |  |  | my $orig_TODO = $self->find_TODO(undef, 1, undef);
231 |  |  |  |  |
232 |  |  |  |  | my $subevents = [];
233 |  |  |  |  |
234 |  |  |  |  | my $hub = $ctx->stack->new_hub(
235 |  |  |  |  | class => 'Test2::Hub::Subtest',
236 |  |  |  |  | );
237 |  |  |  |  |
238 |  |  |  |  | $hub->pre_filter(sub {
239 |  |  |  |  | my ($active_hub, $e) = @_;
240 |  |  |  |  |
241 |  |  |  |  | # Turn a diag into a todo diag
242 |  |  |  |  | return Test::Builder::TodoDiag->new(%$e) if ref($e) eq 'Test2::Event::Diag';
243 |  |  |  |  |
244 |  |  |  |  | return $e;
245 |  |  |  |  | }, inherit => 1) if $orig_TODO;
246 |  |  |  |  |
247 |  |  |  |  | $hub->listen(sub { push @$subevents => $_[1] });
248 |  |  |  |  |
249 |  |  |  |  | $hub->set_nested( $parent->nested + 1 );
250 |  |  |  |  |
251 |  |  |  |  | my $meta = $hub->meta(__PACKAGE__, {});
252 |  |  |  |  | $meta->{Name} = $name;
253 |  |  |  |  | $meta->{TODO} = $orig_TODO;
254 |  |  |  |  | $meta->{TODO_PKG} = $ctx->trace->package;
255 |  |  |  |  | $meta->{parent} = $parent;
256 |  |  |  |  | $meta->{Test_Results} = [];
257 |  |  |  |  | $meta->{subevents} = $subevents;
258 |  |  |  |  | $meta->{subtest_id} = $hub->id;
259 |  |  |  |  | $meta->{subtest_uuid} = $hub->uuid;
260 |  |  |  |  | $meta->{subtest_buffered} = $parent->format ? 0 : 1;
261 |  |  |  |  |
262 |  |  |  |  | $self->_add_ts_hooks;
263 |  |  |  |  |
264 |  |  |  |  | $ctx->release;
265 |  |  |  |  | return bless { Original_Pid => $$, Stack => $self->{Stack}, Hub => $hub, no_log_results => $self->{no_log_results} }, blessed($self);
266 |  |  |  |  | }
267 |  |  |  |  |
268 |  |  |  |  | sub finalize {
269 |  |  |  |  | my $self = shift;
270 |  |  |  |  | my $ok = 1;
271 |  |  |  |  | ($ok) = @_ if @_;
272 |  |  |  |  |
273 |  |  |  |  | my $st_ctx = $self->ctx;
274 |  |  |  |  | my $chub = $self->{Hub} || return $st_ctx->release;
275 |  |  |  |  |
276 |  |  |  |  | my $meta = $chub->meta(__PACKAGE__, {});
277 |  |  |  |  | if ($meta->{child}) {
278 |  |  |  |  | $self->croak("Can't call finalize() with child ($meta->{child}) active");
279 |  |  |  |  | }
280 |  |  |  |  |
281 |  |  |  |  | local $? = 0; # don't fail if $subtests happened to set $? nonzero
282 |  |  |  |  |
283 |  |  |  |  | $self->{Stack}->pop($chub);
284 |  |  |  |  |
285 |  |  |  |  | $self->find_TODO($meta->{TODO_PKG}, 1, $meta->{TODO});
286 |  |  |  |  |
287 |  |  |  |  | my $parent = $self->parent;
288 |  |  |  |  | my $ctx = $parent->ctx;
289 |  |  |  |  | my $trace = $ctx->trace;
290 |  |  |  |  | delete $ctx->hub->meta(__PACKAGE__, {})->{child};
291 |  |  |  |  |
292 |  |  |  |  | $chub->finalize($trace->snapshot(hid => $chub->hid, nested => $chub->nested), 1)
293 |  |  |  |  | if $ok
294 |  |  |  |  | && $chub->count
295 |  |  |  |  | && !$chub->no_ending
296 |  |  |  |  | && !$chub->ended;
297 |  |  |  |  |
298 |  |  |  |  | my $plan = $chub->plan || 0;
299 |  |  |  |  | my $count = $chub->count;
300 |  |  |  |  | my $failed = $chub->failed;
301 |  |  |  |  | my $passed = $chub->is_passing;
302 |  |  |  |  |
303 |  |  |  |  | my $num_extra = $plan =~ m/\D/ ? 0 : $count - $plan;
304 |  |  |  |  | if ($count && $num_extra != 0) {
305 |  |  |  |  | my $s = $plan == 1 ? '' : 's';
306 |  |  |  |  | $st_ctx->diag(<<"FAIL");
307 |  |  |  |  | Looks like you planned $plan test$s but ran $count.
308 |  |  |  |  | FAIL
309 |  |  |  |  | }
310 |  |  |  |  |
311 |  |  |  |  | if ($failed) {
312 |  |  |  |  | my $s = $failed == 1 ? '' : 's';
313 |  |  |  |  |
314 |  |  |  |  | my $qualifier = $num_extra == 0 ? '' : ' run';
315 |  |  |  |  |
316 |  |  |  |  | $st_ctx->diag(<<"FAIL");
317 |  |  |  |  | Looks like you failed $failed test$s of $count$qualifier.
318 |  |  |  |  | FAIL
319 |  |  |  |  | }
320 |  |  |  |  |
321 |  |  |  |  | if (!$passed && !$failed && $count && !$num_extra) {
322 |  |  |  |  | $st_ctx->diag(<<"FAIL");
323 |  |  |  |  | All assertions inside the subtest passed, but errors were encountered.
324 |  |  |  |  | FAIL
325 |  |  |  |  | }
326 |  |  |  |  |
327 |  |  |  |  | $st_ctx->release;
328 |  |  |  |  |
329 |  |  |  |  | unless ($chub->bailed_out) {
330 |  |  |  |  | my $plan = $chub->plan;
331 |  |  |  |  | if ( $plan && $plan eq 'SKIP' ) {
332 |  |  |  |  | $parent->skip($chub->skip_reason, $meta->{Name});
333 |  |  |  |  | }
334 |  |  |  |  | elsif ( !$chub->count ) {
335 |  |  |  |  | $parent->ok( 0, sprintf q[No tests run for subtest "%s"], $meta->{Name} );
336 |  |  |  |  | }
337 |  |  |  |  | else {
338 |  |  |  |  | $parent->{subevents} = $meta->{subevents};
339 |  |  |  |  | $parent->{subtest_id} = $meta->{subtest_id};
340 |  |  |  |  | $parent->{subtest_uuid} = $meta->{subtest_uuid};
341 |  |  |  |  | $parent->{subtest_buffered} = $meta->{subtest_buffered};
342 |  |  |  |  | $parent->ok( $chub->is_passing, $meta->{Name} );
343 |  |  |  |  | }
344 |  |  |  |  | }
345 |  |  |  |  |
346 |  |  |  |  | $ctx->release;
347 |  |  |  |  | return $chub->is_passing;
348 |  |  |  |  | }
349 |  |  |  |  |
350 |  |  |  |  | sub subtest {
351 |  |  |  |  | my $self = shift;
352 |  |  |  |  | my ($name, $code, @args) = @_;
353 |  |  |  |  | my $ctx = $self->ctx;
354 |  |  |  |  | $ctx->throw("subtest()'s second argument must be a code ref")
355 |  |  |  |  | unless $code && reftype($code) eq 'CODE';
356 |  |  |  |  |
357 |  |  |  |  | $name ||= "Child of " . $self->name;
358 |  |  |  |  |
359 |  |  |  |  |
360 |  |  |  |  | $_->($name,$code,@args)
361 |  |  |  |  | for Test2::API::test2_list_pre_subtest_callbacks();
362 |  |  |  |  |
363 |  |  |  |  | $ctx->note("Subtest: $name");
364 |  |  |  |  |
365 |  |  |  |  | my $child = $self->child($name);
366 |  |  |  |  |
367 |  |  |  |  | my $start_pid = $$;
368 |  |  |  |  | my $st_ctx;
369 |  |  |  |  | my ($ok, $err, $finished, $child_error);
370 |  |  |  |  | T2_SUBTEST_WRAPPER: {
371 |  |  |  |  | my $ctx = $self->ctx;
372 |  |  |  |  | $st_ctx = $ctx->snapshot;
373 |  |  |  |  | $ctx->release;
374 |  |  |  |  | $ok = eval { local $Level = 1; $code->(@args); 1 };
375 |  |  |  |  | ($err, $child_error) = ($@, $?);
376 |  |  |  |  |
377 |  |  |  |  | # They might have done 'BEGIN { skip_all => "whatever" }'
378 |  |  |  |  | if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && blessed($err) eq 'Test::Builder::Exception')) {
379 |  |  |  |  | $ok = undef;
380 |  |  |  |  | $err = undef;
381 |  |  |  |  | }
382 |  |  |  |  | else {
383 |  |  |  |  | $finished = 1;
384 |  |  |  |  | }
385 |  |  |  |  | }
386 |  |  |  |  |
387 |  |  |  |  | if ($start_pid != $$ && !$INC{'Test2/IPC.pm'}) {
388 |  |  |  |  | warn $ok ? "Forked inside subtest, but subtest never finished!\n" : $err;
389 |  |  |  |  | exit 255;
390 |  |  |  |  | }
391 |  |  |  |  |
392 |  |  |  |  | my $trace = $ctx->trace;
393 |  |  |  |  |
394 |  |  |  |  | if (!$finished) {
395 |  |  |  |  | if(my $bailed = $st_ctx->hub->bailed_out) {
396 |  |  |  |  | my $chub = $child->{Hub};
397 |  |  |  |  | $self->{Stack}->pop($chub);
398 |  |  |  |  | $ctx->bail($bailed->reason);
399 |  |  |  |  | }
400 |  |  |  |  | my $code = $st_ctx->hub->exit_code;
401 |  |  |  |  | $ok = !$code;
402 |  |  |  |  | $err = "Subtest ended with exit code $code" if $code;
403 |  |  |  |  | }
404 |  |  |  |  |
405 |  |  |  |  | my $st_hub = $st_ctx->hub;
406 |  |  |  |  | my $plan = $st_hub->plan;
407 |  |  |  |  | my $count = $st_hub->count;
408 |  |  |  |  |
409 |  |  |  |  | if (!$count && (!defined($plan) || "$plan" ne 'SKIP')) {
410 |  |  |  |  | $st_ctx->plan(0) unless defined $plan;
411 |  |  |  |  | $st_ctx->diag('No tests run!');
412 |  |  |  |  | }
413 |  |  |  |  |
414 |  |  |  |  | $child->finalize($st_ctx->trace);
415 |  |  |  |  |
416 |  |  |  |  | $ctx->release;
417 |  |  |  |  |
418 |  |  |  |  | die $err unless $ok;
419 |  |  |  |  |
420 |  |  |  |  | $? = $child_error if defined $child_error;
421 |  |  |  |  |
422 |  |  |  |  | return $st_hub->is_passing;
423 |  |  |  |  | }
424 |  |  |  |  |
425 |  |  |  |  | sub name {
426 |  |  |  |  | my $self = shift;
427 |  |  |  |  | my $ctx = $self->ctx;
428 |  |  |  |  | release $ctx, $ctx->hub->meta(__PACKAGE__, {})->{Name};
429 |  |  |  |  | }
430 |  |  |  |  |
431 |  |  |  |  | # spent 430µs (47+383) within Test::Builder::reset which was called: # once (47µs+383µs) by Test::Builder::__ANON__[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm:148] at line 146 sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
432 | 1 | 900ns |  |  | my ($self, %params) = @_;
433 |  |  |  |  |
434 | 1 | 700ns | 1 | 700ns | Test2::API::test2_unset_is_end(); # spent 700ns making 1 call to Test2::API::test2_unset_is_end
435 |  |  |  |  |
436 |  |  |  |  | # We leave this a global because it has to be localized and localizing
437 |  |  |  |  | # hash keys is just asking for pain. Also, it was documented.
438 | 1 | 200ns |  |  | $Level = 1;
439 |  |  |  |  |
440 |  |  |  |  | $self->{no_log_results} = $ENV{TEST_NO_LOG_RESULTS} ? 1 : 0
441 | 1 | 200ns |  |  | unless $params{singleton};
442 |  |  |  |  |
443 | 1 | 1µs | 1 | 2µs | $self->{Original_Pid} = Test2::API::test2_in_preload() ? -1 : $$; # spent 2µs making 1 call to Test2::API::test2_in_preload
444 |  |  |  |  |
445 | 1 | 1µs | 1 | 216µs | my $ctx = $self->ctx; # spent 216µs making 1 call to Test::Builder::ctx
446 | 1 | 900ns | 1 | 2µs | my $hub = $ctx->hub; # spent 2µs making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
447 | 1 | 800ns | 1 | 6µs | $ctx->release; # spent 6µs making 1 call to Test2::API::Context::release
448 | 1 | 200ns |  |  | unless ($params{singleton}) {
449 |  |  |  |  | $hub->reset_state();
450 |  |  |  |  | $hub->_tb_reset();
451 |  |  |  |  | }
452 |  |  |  |  |
453 | 1 | 7µs | 2 | 32µs | $ctx = $self->ctx; # spent 32µs making 1 call to Test::Builder::ctx # spent 700ns making 1 call to Test2::API::Context::DESTROY
454 |  |  |  |  |
455 | 1 | 2µs | 2 | 7µs | my $meta = $ctx->hub->meta(__PACKAGE__, {}); # spent 6µs making 1 call to Test2::Util::ExternalMeta::meta # spent 800ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
456 |  |  |  |  | %$meta = (
457 |  |  |  |  | Name => $0,
458 |  |  |  |  | Ending => 0,
459 |  |  |  |  | Done_Testing => undef,
460 |  |  |  |  | Skip_All => 0,
461 |  |  |  |  | Test_Results => [],
462 |  |  |  |  | parent => $meta->{parent},
463 | 1 | 2µs |  |  | );
464 |  |  |  |  |
465 | 1 | 300ns |  |  | $self->{Exported_To} = undef unless $params{singleton};
466 |  |  |  |  |
467 | 1 | 400ns |  |  | $self->{Orig_Handles} ||= do {
468 | 1 | 1µs | 2 | 1µs | my $format = $ctx->hub->format; # spent 1µs making 1 call to Test2::Hub::format # spent 400ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
469 | 1 | 100ns |  |  | my $out;
470 | 1 | 8µs | 2 | 1µs | if ($format && $format->isa('Test2::Formatter::TAP')) { # spent 600ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84] # spent 600ns making 1 call to UNIVERSAL::isa
471 |  |  |  |  | $out = $format->handles;
472 |  |  |  |  | }
473 | 1 | 800ns |  |  | $out ? [@$out] : [];
474 |  |  |  |  | };
475 |  |  |  |  |
476 | 1 | 900ns | 1 | 48µs | $self->use_numbers(1); # spent 48µs making 1 call to Test::Builder::use_numbers
477 | 1 | 200ns |  |  | $self->no_header(0) unless $params{singleton};
478 | 1 | 100ns |  |  | $self->no_ending(0) unless $params{singleton};
479 | 1 | 800ns | 1 | 59µs | $self->reset_outputs; # spent 59µs making 1 call to Test::Builder::reset_outputs
480 |  |  |  |  |
481 | 1 | 1µs | 1 | 5µs | $ctx->release; # spent 5µs making 1 call to Test2::API::Context::release
482 |  |  |  |  |
483 | 1 | 4µs | 1 | 500ns | return; # spent 500ns making 1 call to Test2::API::Context::DESTROY
484 |  |  |  |  | }
485 |  |  |  |  |
486 |  |  |  |  |
487 | 1 | 1µs |  |  | my %plan_cmds = (
488 |  |  |  |  | no_plan => \&no_plan,
489 |  |  |  |  | skip_all => \&skip_all,
490 |  |  |  |  | tests => \&_plan_tests,
491 |  |  |  |  | );
492 |  |  |  |  |
493 |  |  |  |  | # spent 1µs within Test::Builder::plan which was called: # once (1µs+0s) by Test::Builder::Module::import at line 92 of Test/Builder/Module.pm sub plan {
494 | 1 | 300ns |  |  | my( $self, $cmd, $arg ) = @_;
495 |  |  |  |  |
496 | 1 | 1µs |  |  | return unless $cmd;
497 |  |  |  |  |
498 |  |  |  |  | my $ctx = $self->ctx;
499 |  |  |  |  | my $hub = $ctx->hub;
500 |  |  |  |  |
501 |  |  |  |  | $ctx->throw("You tried to plan twice") if $hub->plan;
502 |  |  |  |  |
503 |  |  |  |  | local $Level = $Level + 1;
504 |  |  |  |  |
505 |  |  |  |  | if( my $method = $plan_cmds{$cmd} ) {
506 |  |  |  |  | local $Level = $Level + 1;
507 |  |  |  |  | $self->$method($arg);
508 |  |  |  |  | }
509 |  |  |  |  | else {
510 |  |  |  |  | my @args = grep { defined } ( $cmd, $arg );
511 |  |  |  |  | $ctx->throw("plan() doesn't understand @args");
512 |  |  |  |  | }
513 |  |  |  |  |
514 |  |  |  |  | release $ctx, 1;
515 |  |  |  |  | }
516 |  |  |  |  |
517 |  |  |  |  |
518 |  |  |  |  | sub _plan_tests {
519 |  |  |  |  | my($self, $arg) = @_;
520 |  |  |  |  |
521 |  |  |  |  | my $ctx = $self->ctx;
522 |  |  |  |  |
523 |  |  |  |  | if($arg) {
524 |  |  |  |  | local $Level = $Level + 1;
525 |  |  |  |  | $self->expected_tests($arg);
526 |  |  |  |  | }
527 |  |  |  |  | elsif( !defined $arg ) {
528 |  |  |  |  | $ctx->throw("Got an undefined number of tests");
529 |  |  |  |  | }
530 |  |  |  |  | else {
531 |  |  |  |  | $ctx->throw("You said to run 0 tests");
532 |  |  |  |  | }
533 |  |  |  |  |
534 |  |  |  |  | $ctx->release;
535 |  |  |  |  | }
536 |  |  |  |  |
537 |  |  |  |  |
538 |  |  |  |  | # spent 29µs (11+18) within Test::Builder::expected_tests which was called: # once (11µs+18µs) by Test::Builder::done_testing at line 611 sub expected_tests {
539 | 1 | 200ns |  |  | my $self = shift;
540 | 1 | 300ns |  |  | my($max) = @_;
541 |  |  |  |  |
542 | 1 | 900ns | 1 | 15µs | my $ctx = $self->ctx; # spent 15µs making 1 call to Test::Builder::ctx
543 |  |  |  |  |
544 | 1 | 300ns |  |  | if(@_) {
545 |  |  |  |  | $self->croak("Number of tests must be a positive integer. You gave it '$max'")
546 |  |  |  |  | unless $max =~ /^\+?\d+$/;
547 |  |  |  |  |
548 |  |  |  |  | $ctx->plan($max);
549 |  |  |  |  | }
550 |  |  |  |  |
551 | 1 | 800ns | 1 | 400ns | my $hub = $ctx->hub; # spent 400ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
552 |  |  |  |  |
553 | 1 | 700ns | 1 | 2µs | $ctx->release; # spent 2µs making 1 call to Test2::API::Context::release
554 |  |  |  |  |
555 | 1 | 700ns | 1 | 700ns | my $plan = $hub->plan; # spent 700ns making 1 call to Test2::Hub::plan
556 | 1 | 3µs | 1 | 400ns | return 0 unless $plan; # spent 400ns making 1 call to Test2::API::Context::DESTROY
557 |  |  |  |  | return 0 if $plan =~ m/\D/;
558 |  |  |  |  | return $plan;
559 |  |  |  |  | }
560 |  |  |  |  |
561 |  |  |  |  |
562 |  |  |  |  | sub no_plan {
563 |  |  |  |  | my($self, $arg) = @_;
564 |  |  |  |  |
565 |  |  |  |  | my $ctx = $self->ctx;
566 |  |  |  |  |
567 |  |  |  |  | if (defined $ctx->hub->plan) {
568 |  |  |  |  | warn "Plan already set, no_plan() is a no-op, this will change to a hard failure in the future.";
569 |  |  |  |  | $ctx->release;
570 |  |  |  |  | return;
571 |  |  |  |  | }
572 |  |  |  |  |
573 |  |  |  |  | $ctx->alert("no_plan takes no arguments") if $arg;
574 |  |  |  |  |
575 |  |  |  |  | $ctx->hub->plan('NO PLAN');
576 |  |  |  |  |
577 |  |  |  |  | release $ctx, 1;
578 |  |  |  |  | }
579 |  |  |  |  |
580 |  |  |  |  |
581 |  |  |  |  | # spent 353µs (45+309) within Test::Builder::done_testing which was called: # once (45µs+309µs) by Test::More::done_testing at line 249 of Test/More.pm sub done_testing {
582 | 1 | 400ns |  |  | my($self, $num_tests) = @_;
583 |  |  |  |  |
584 | 1 | 1µs | 1 | 30µs | my $ctx = $self->ctx; # spent 30µs making 1 call to Test::Builder::ctx
585 |  |  |  |  |
586 | 1 | 4µs | 2 | 9µs | my $meta = $ctx->hub->meta(__PACKAGE__, {}); # spent 7µs making 1 call to Test2::Util::ExternalMeta::meta # spent 2µs making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
587 |  |  |  |  |
588 | 1 | 600ns |  |  | if ($meta->{Done_Testing}) {
589 |  |  |  |  | my ($file, $line) = @{$meta->{Done_Testing}}[1,2];
590 |  |  |  |  | local $ctx->hub->{ended}; # OMG This is awful.
591 |  |  |  |  | $self->ok(0, "done_testing() was already called at $file line $line");
592 |  |  |  |  | $ctx->release;
593 |  |  |  |  | return;
594 |  |  |  |  | }
595 | 1 | 4µs | 2 | 3µs | $meta->{Done_Testing} = [$ctx->trace->call]; # spent 2µs making 1 call to Test2::EventFacet::Trace::call # spent 1µs making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
596 |  |  |  |  |
597 | 1 | 2µs | 2 | 2µs | my $plan = $ctx->hub->plan; # spent 2µs making 1 call to Test2::Hub::plan # spent 400ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
598 | 1 | 2µs | 2 | 1µs | my $count = $ctx->hub->count; # spent 1µs making 2 calls to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84], avg 550ns/call
599 |  |  |  |  |
600 |  |  |  |  | # If done_testing() specified the number of tests, shut off no_plan
601 | 1 | 1µs |  |  | if( defined $num_tests ) {
602 |  |  |  |  | $ctx->plan($num_tests) if !$plan || $plan eq 'NO PLAN';
603 |  |  |  |  | }
604 |  |  |  |  | elsif ($count && defined $num_tests && $count != $num_tests) {
605 |  |  |  |  | $self->ok(0, "planned to run @{[ $self->expected_tests ]} but done_testing() expects $num_tests");
606 |  |  |  |  | }
607 |  |  |  |  | else {
608 | 1 | 2µs | 1 | 40µs | $num_tests = $self->current_test; # spent 40µs making 1 call to Test::Builder::current_test
609 |  |  |  |  | }
610 |  |  |  |  |
611 | 1 | 2µs | 1 | 29µs | if( $self->expected_tests && $num_tests != $self->expected_tests ) { # spent 29µs making 1 call to Test::Builder::expected_tests
612 |  |  |  |  | $self->ok(0, "planned to run @{[ $self->expected_tests ]} ".
613 |  |  |  |  | "but done_testing() expects $num_tests");
614 |  |  |  |  | }
615 |  |  |  |  |
616 | 1 | 1µs | 2 | 700ns | $ctx->plan($num_tests) if $ctx->hub->plan && $ctx->hub->plan eq 'NO PLAN'; # spent 400ns making 1 call to Test2::Hub::plan # spent 300ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
617 |  |  |  |  |
618 | 1 | 3µs | 3 | 186µs | $ctx->hub->finalize($ctx->trace, 1); # spent 186µs making 1 call to Test2::Hub::finalize # spent 600ns making 2 calls to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84], avg 300ns/call
619 |  |  |  |  |
620 | 1 | 6µs | 2 | 8µs | release $ctx, 1; # spent 7µs making 1 call to Test2::API::release # spent 700ns making 1 call to Test2::API::Context::DESTROY
621 |  |  |  |  | }
622 |  |  |  |  |
623 |  |  |  |  |
624 |  |  |  |  | sub has_plan {
625 |  |  |  |  | my $self = shift;
626 |  |  |  |  |
627 |  |  |  |  | my $ctx = $self->ctx;
628 |  |  |  |  | my $plan = $ctx->hub->plan;
629 |  |  |  |  | $ctx->release;
630 |  |  |  |  |
631 |  |  |  |  | return( $plan ) if $plan && $plan !~ m/\D/;
632 |  |  |  |  | return('no_plan') if $plan && $plan eq 'NO PLAN';
633 |  |  |  |  | return(undef);
634 |  |  |  |  | }
635 |  |  |  |  |
636 |  |  |  |  |
637 |  |  |  |  | sub skip_all {
638 |  |  |  |  | my( $self, $reason ) = @_;
639 |  |  |  |  |
640 |  |  |  |  | my $ctx = $self->ctx;
641 |  |  |  |  |
642 |  |  |  |  | $ctx->hub->meta(__PACKAGE__, {})->{Skip_All} = $reason || 1;
643 |  |  |  |  |
644 |  |  |  |  | # Work around old perl bug
645 |  |  |  |  | if ($] < 5.020000) {
646 |  |  |  |  | my $begin = 0;
647 |  |  |  |  | my $level = 0;
648 |  |  |  |  | while (my @call = caller($level++)) {
649 |  |  |  |  | last unless @call && $call[0];
650 |  |  |  |  | next unless $call[3] =~ m/::BEGIN$/;
651 |  |  |  |  | $begin++;
652 |  |  |  |  | last;
653 |  |  |  |  | }
654 |  |  |  |  | # HACK!
655 |  |  |  |  | die 'Label not found for "last T2_SUBTEST_WRAPPER"' if $begin && $ctx->hub->meta(__PACKAGE__, {})->{parent};
656 |  |  |  |  | }
657 |  |  |  |  |
658 |  |  |  |  | $reason = "$reason" if defined $reason;
659 |  |  |  |  |
660 |  |  |  |  | $ctx->plan(0, SKIP => $reason);
661 |  |  |  |  | }
662 |  |  |  |  |
663 |  |  |  |  |
664 |  |  |  |  | # spent 2µs within Test::Builder::exported_to which was called 2 times, avg 1µs/call: # once (2µs+0s) by Test::Builder::Module::import at line 87 of Test/Builder/Module.pm # once (800ns+0s) by Test::More::import_extra at line 208 of Test/More.pm sub exported_to {
665 | 2 | 700ns |  |  | my( $self, $pack ) = @_;
666 |  |  |  |  |
667 | 2 | 600ns |  |  | if( defined $pack ) {
668 |  |  |  |  | $self->{Exported_To} = $pack;
669 |  |  |  |  | }
670 | 2 | 3µs |  |  | return $self->{Exported_To};
671 |  |  |  |  | }
672 |  |  |  |  |
673 |  |  |  |  |
674 |  |  |  |  | # spent 256µs (40+215) within Test::Builder::ok which was called: # once (40µs+215µs) by Test::More::ok at line 323 of Test/More.pm sub ok {
675 | 1 | 500ns |  |  | my( $self, $test, $name ) = @_;
676 |  |  |  |  |
677 | 1 | 2µs | 1 | 66µs | my $ctx = $self->ctx; # spent 66µs making 1 call to Test::Builder::ctx
678 |  |  |  |  |
679 |  |  |  |  | # $test might contain an object which we don't want to accidentally
680 |  |  |  |  | # store, so we turn it into a boolean.
681 | 1 | 500ns |  |  | $test = $test ? 1 : 0;
682 |  |  |  |  |
683 |  |  |  |  | # In case $name is a string overloaded object, force it to stringify.
684 | 2 | 73µs | 2 | 36µs | # spent 21µs (5+15) within Test::Builder::BEGIN@684 which was called: # once (5µs+15µs) by Test::Builder::Module::BEGIN@5 at line 684 no warnings qw/uninitialized numeric/; # spent 21µs making 1 call to Test::Builder::BEGIN@684 # spent 15µs making 1 call to warnings::unimport
685 | 1 | 300ns |  |  | $name = "$name" if defined $name;
686 |  |  |  |  |
687 |  |  |  |  | # Profiling showed that the regex here was a huge time waster, doing the
688 |  |  |  |  | # numeric addition first cuts our profile time from ~300ms to ~50ms
689 | 1 | 1µs |  |  | $self->diag(<<" ERR") if 0 + $name && $name =~ /^[\d\s]+$/;
690 |  |  |  |  | You named your test '$name'. You shouldn't use numbers for your test names.
691 |  |  |  |  | Very confusing.
692 |  |  |  |  | ERR
693 | 2 | 338µs | 2 | 47µs | # spent 26µs (4+21) within Test::Builder::BEGIN@693 which was called: # once (4µs+21µs) by Test::Builder::Module::BEGIN@5 at line 693 use warnings qw/uninitialized numeric/; # spent 26µs making 1 call to Test::Builder::BEGIN@693 # spent 21µs making 1 call to warnings::import
694 |  |  |  |  |
695 | 1 | 400ns |  |  | my $trace = $ctx->{trace};
696 | 1 | 400ns |  |  | my $hub = $ctx->{hub};
697 |  |  |  |  |
698 | 1 | 3µs |  |  | my $result = {
699 |  |  |  |  | ok => $test,
700 |  |  |  |  | actual_ok => $test,
701 |  |  |  |  | reason => '',
702 |  |  |  |  | type => '',
703 |  |  |  |  | (name => defined($name) ? $name : ''),
704 |  |  |  |  | };
705 |  |  |  |  |
706 | 1 | 2µs |  |  | $hub->{_meta}->{+__PACKAGE__}->{Test_Results}[ $hub->{count} ] = $result unless $self->{no_log_results};
707 |  |  |  |  |
708 | 1 | 300ns |  |  | my $orig_name = $name;
709 |  |  |  |  |
710 | 1 | 200ns |  |  | my @attrs;
711 | 1 | 400ns |  |  | my $subevents = delete $self->{subevents};
712 | 1 | 400ns |  |  | my $subtest_id = delete $self->{subtest_id};
713 | 1 | 300ns |  |  | my $subtest_uuid = delete $self->{subtest_uuid};
714 | 1 | 300ns |  |  | my $subtest_buffered = delete $self->{subtest_buffered};
715 | 1 | 300ns |  |  | my $epkg = 'Test2::Event::Ok';
716 | 1 | 200ns |  |  | if ($subevents) {
717 |  |  |  |  | $epkg = 'Test2::Event::Subtest';
718 |  |  |  |  | push @attrs => (subevents => $subevents, subtest_id => $subtest_id, subtest_uuid => $subtest_uuid, buffered => $subtest_buffered);
719 |  |  |  |  | }
720 |  |  |  |  |
721 | 1 | 9µs |  |  | my $e = bless {
722 |  |  |  |  | trace => bless( {%$trace}, 'Test2::EventFacet::Trace'),
723 |  |  |  |  | pass => $test,
724 |  |  |  |  | name => $name,
725 |  |  |  |  | _meta => {'Test::Builder' => $result},
726 |  |  |  |  | effective_pass => $test,
727 |  |  |  |  | @attrs,
728 |  |  |  |  | }, $epkg;
729 | 1 | 2µs | 1 | 139µs | $hub->send($e); # spent 139µs making 1 call to Test2::Hub::send
730 |  |  |  |  |
731 | 1 | 400ns |  |  | $self->_ok_debug($trace, $orig_name) unless($test);
732 |  |  |  |  |
733 | 1 | 2µs | 1 | 9µs | $ctx->release; # spent 9µs making 1 call to Test2::API::Context::release
734 | 1 | 12µs | 1 | 2µs | return $test; # spent 2µs making 1 call to Test2::API::Context::DESTROY
735 |  |  |  |  | }
736 |  |  |  |  |
737 |  |  |  |  | sub _ok_debug {
738 |  |  |  |  | my $self = shift;
739 |  |  |  |  | my ($trace, $orig_name) = @_;
740 |  |  |  |  |
741 |  |  |  |  | my $is_todo = $self->in_todo;
742 |  |  |  |  |
743 |  |  |  |  | my $msg = $is_todo ? "Failed (TODO)" : "Failed";
744 |  |  |  |  |
745 |  |  |  |  | my (undef, $file, $line) = $trace->call;
746 |  |  |  |  | if (defined $orig_name) {
747 |  |  |  |  | $self->diag(qq[ $msg test '$orig_name'\n at $file line $line.\n]);
748 |  |  |  |  | }
749 |  |  |  |  | else {
750 |  |  |  |  | $self->diag(qq[ $msg test at $file line $line.\n]);
751 |  |  |  |  | }
752 |  |  |  |  | }
753 |  |  |  |  |
754 |  |  |  |  | sub _diag_fh {
755 |  |  |  |  | my $self = shift;
756 |  |  |  |  | local $Level = $Level + 1;
757 |  |  |  |  | return $self->in_todo ? $self->todo_output : $self->failure_output;
758 |  |  |  |  | }
759 |  |  |  |  |
760 |  |  |  |  | sub _unoverload {
761 |  |  |  |  | my ($self, $type, $thing) = @_;
762 |  |  |  |  |
763 |  |  |  |  | return unless ref $$thing;
764 |  |  |  |  | return unless blessed($$thing) || scalar $self->_try(sub{ $$thing->isa('UNIVERSAL') });
765 |  |  |  |  | {
766 |  |  |  |  | local ($!, $@);
767 |  |  |  |  | require overload;
768 |  |  |  |  | }
769 |  |  |  |  | my $string_meth = overload::Method( $$thing, $type ) || return;
770 |  |  |  |  | $$thing = $$thing->$string_meth(undef, 0);
771 |  |  |  |  | }
772 |  |  |  |  |
773 |  |  |  |  | sub _unoverload_str {
774 |  |  |  |  | my $self = shift;
775 |  |  |  |  |
776 |  |  |  |  | $self->_unoverload( q[""], $_ ) for @_;
777 |  |  |  |  | }
778 |  |  |  |  |
779 |  |  |  |  | sub _unoverload_num {
780 |  |  |  |  | my $self = shift;
781 |  |  |  |  |
782 |  |  |  |  | $self->_unoverload( '0+', $_ ) for @_;
783 |  |  |  |  |
784 |  |  |  |  | for my $val (@_) {
785 |  |  |  |  | next unless $self->_is_dualvar($$val);
786 |  |  |  |  | $$val = $$val + 0;
787 |  |  |  |  | }
788 |  |  |  |  | }
789 |  |  |  |  |
790 |  |  |  |  | # This is a hack to detect a dualvar such as $!
791 |  |  |  |  | sub _is_dualvar {
792 |  |  |  |  | my( $self, $val ) = @_;
793 |  |  |  |  |
794 |  |  |  |  | # Objects are not dualvars.
795 |  |  |  |  | return 0 if ref $val;
796 |  |  |  |  |
797 | 2 | 796µs | 2 | 31µs | # spent 18µs (5+13) within Test::Builder::BEGIN@797 which was called: # once (5µs+13µs) by Test::Builder::Module::BEGIN@5 at line 797 no warnings 'numeric'; # spent 18µs making 1 call to Test::Builder::BEGIN@797 # spent 13µs making 1 call to warnings::unimport
798 |  |  |  |  | my $numval = $val + 0;
799 |  |  |  |  | return ($numval != 0 and $numval ne $val ? 1 : 0);
800 |  |  |  |  | }
801 |  |  |  |  |
802 |  |  |  |  |
803 |  |  |  |  | sub is_eq {
804 |  |  |  |  | my( $self, $got, $expect, $name ) = @_;
805 |  |  |  |  |
806 |  |  |  |  | my $ctx = $self->ctx;
807 |  |  |  |  |
808 |  |  |  |  | local $Level = $Level + 1;
809 |  |  |  |  |
810 |  |  |  |  | if( !defined $got || !defined $expect ) {
811 |  |  |  |  | # undef only matches undef and nothing else
812 |  |  |  |  | my $test = !defined $got && !defined $expect;
813 |  |  |  |  |
814 |  |  |  |  | $self->ok( $test, $name );
815 |  |  |  |  | $self->_is_diag( $got, 'eq', $expect ) unless $test;
816 |  |  |  |  | $ctx->release;
817 |  |  |  |  | return $test;
818 |  |  |  |  | }
819 |  |  |  |  |
820 |  |  |  |  | release $ctx, $self->cmp_ok( $got, 'eq', $expect, $name );
821 |  |  |  |  | }
822 |  |  |  |  |
823 |  |  |  |  |
824 |  |  |  |  | sub is_num {
825 |  |  |  |  | my( $self, $got, $expect, $name ) = @_;
826 |  |  |  |  | my $ctx = $self->ctx;
827 |  |  |  |  | local $Level = $Level + 1;
828 |  |  |  |  |
829 |  |  |  |  | if( !defined $got || !defined $expect ) {
830 |  |  |  |  | # undef only matches undef and nothing else
831 |  |  |  |  | my $test = !defined $got && !defined $expect;
832 |  |  |  |  |
833 |  |  |  |  | $self->ok( $test, $name );
834 |  |  |  |  | $self->_is_diag( $got, '==', $expect ) unless $test;
835 |  |  |  |  | $ctx->release;
836 |  |  |  |  | return $test;
837 |  |  |  |  | }
838 |  |  |  |  |
839 |  |  |  |  | release $ctx, $self->cmp_ok( $got, '==', $expect, $name );
840 |  |  |  |  | }
841 |  |  |  |  |
842 |  |  |  |  |
843 |  |  |  |  | sub _diag_fmt {
844 |  |  |  |  | my( $self, $type, $val ) = @_;
845 |  |  |  |  |
846 |  |  |  |  | if( defined $$val ) {
847 |  |  |  |  | if( $type eq 'eq' or $type eq 'ne' ) {
848 |  |  |  |  | # quote and force string context
849 |  |  |  |  | $$val = "'$$val'";
850 |  |  |  |  | }
851 |  |  |  |  | else {
852 |  |  |  |  | # force numeric context
853 |  |  |  |  | $self->_unoverload_num($val);
854 |  |  |  |  | }
855 |  |  |  |  | }
856 |  |  |  |  | else {
857 |  |  |  |  | $$val = 'undef';
858 |  |  |  |  | }
859 |  |  |  |  |
860 |  |  |  |  | return;
861 |  |  |  |  | }
862 |  |  |  |  |
863 |  |  |  |  |
864 |  |  |  |  | sub _is_diag {
865 |  |  |  |  | my( $self, $got, $type, $expect ) = @_;
866 |  |  |  |  |
867 |  |  |  |  | $self->_diag_fmt( $type, $_ ) for \$got, \$expect;
868 |  |  |  |  |
869 |  |  |  |  | local $Level = $Level + 1;
870 |  |  |  |  | return $self->diag(<<"DIAGNOSTIC");
871 |  |  |  |  | got: $got
872 |  |  |  |  | expected: $expect
873 |  |  |  |  | DIAGNOSTIC
874 |  |  |  |  |
875 |  |  |  |  | }
876 |  |  |  |  |
877 |  |  |  |  | sub _isnt_diag {
878 |  |  |  |  | my( $self, $got, $type ) = @_;
879 |  |  |  |  |
880 |  |  |  |  | $self->_diag_fmt( $type, \$got );
881 |  |  |  |  |
882 |  |  |  |  | local $Level = $Level + 1;
883 |  |  |  |  | return $self->diag(<<"DIAGNOSTIC");
884 |  |  |  |  | got: $got
885 |  |  |  |  | expected: anything else
886 |  |  |  |  | DIAGNOSTIC
887 |  |  |  |  | }
888 |  |  |  |  |
889 |  |  |  |  |
890 |  |  |  |  | sub isnt_eq {
891 |  |  |  |  | my( $self, $got, $dont_expect, $name ) = @_;
892 |  |  |  |  | my $ctx = $self->ctx;
893 |  |  |  |  | local $Level = $Level + 1;
894 |  |  |  |  |
895 |  |  |  |  | if( !defined $got || !defined $dont_expect ) {
896 |  |  |  |  | # undef only matches undef and nothing else
897 |  |  |  |  | my $test = defined $got || defined $dont_expect;
898 |  |  |  |  |
899 |  |  |  |  | $self->ok( $test, $name );
900 |  |  |  |  | $self->_isnt_diag( $got, 'ne' ) unless $test;
901 |  |  |  |  | $ctx->release;
902 |  |  |  |  | return $test;
903 |  |  |  |  | }
904 |  |  |  |  |
905 |  |  |  |  | release $ctx, $self->cmp_ok( $got, 'ne', $dont_expect, $name );
906 |  |  |  |  | }
907 |  |  |  |  |
908 |  |  |  |  | sub isnt_num {
909 |  |  |  |  | my( $self, $got, $dont_expect, $name ) = @_;
910 |  |  |  |  | my $ctx = $self->ctx;
911 |  |  |  |  | local $Level = $Level + 1;
912 |  |  |  |  |
913 |  |  |  |  | if( !defined $got || !defined $dont_expect ) {
914 |  |  |  |  | # undef only matches undef and nothing else
915 |  |  |  |  | my $test = defined $got || defined $dont_expect;
916 |  |  |  |  |
917 |  |  |  |  | $self->ok( $test, $name );
918 |  |  |  |  | $self->_isnt_diag( $got, '!=' ) unless $test;
919 |  |  |  |  | $ctx->release;
920 |  |  |  |  | return $test;
921 |  |  |  |  | }
922 |  |  |  |  |
923 |  |  |  |  | release $ctx, $self->cmp_ok( $got, '!=', $dont_expect, $name );
924 |  |  |  |  | }
925 |  |  |  |  |
926 |  |  |  |  |
927 |  |  |  |  | sub like {
928 |  |  |  |  | my( $self, $thing, $regex, $name ) = @_;
929 |  |  |  |  | my $ctx = $self->ctx;
930 |  |  |  |  |
931 |  |  |  |  | local $Level = $Level + 1;
932 |  |  |  |  |
933 |  |  |  |  | release $ctx, $self->_regex_ok( $thing, $regex, '=~', $name );
934 |  |  |  |  | }
935 |  |  |  |  |
936 |  |  |  |  | sub unlike {
937 |  |  |  |  | my( $self, $thing, $regex, $name ) = @_;
938 |  |  |  |  | my $ctx = $self->ctx;
939 |  |  |  |  |
940 |  |  |  |  | local $Level = $Level + 1;
941 |  |  |  |  |
942 |  |  |  |  | release $ctx, $self->_regex_ok( $thing, $regex, '!~', $name );
943 |  |  |  |  | }
944 |  |  |  |  |
945 |  |  |  |  |
946 | 1 | 3µs |  |  | my %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" );
947 |  |  |  |  |
948 |  |  |  |  | # Bad, these are not comparison operators. Should we include more?
949 | 1 | 3µs |  |  | my %cmp_ok_bl = map { ( $_, 1 ) } ( "=", "+=", ".=", "x=", "^=", "|=", "||=", "&&=", "...");
950 |  |  |  |  |
951 |  |  |  |  | sub cmp_ok {
952 |  |  |  |  | my( $self, $got, $type, $expect, $name ) = @_;
953 |  |  |  |  | my $ctx = $self->ctx;
954 |  |  |  |  |
955 |  |  |  |  | if ($cmp_ok_bl{$type}) {
956 |  |  |  |  | $ctx->throw("$type is not a valid comparison operator in cmp_ok()");
957 |  |  |  |  | }
958 |  |  |  |  |
959 |  |  |  |  | my ($test, $succ);
960 |  |  |  |  | my $error;
961 |  |  |  |  | {
962 |  |  |  |  | ## no critic (BuiltinFunctions::ProhibitStringyEval)
963 |  |  |  |  |
964 |  |  |  |  | local( $@, $!, $SIG{__DIE__} ); # isolate eval
965 |  |  |  |  |
966 |  |  |  |  | my($pack, $file, $line) = $ctx->trace->call();
967 |  |  |  |  | my $warning_bits = $ctx->trace->warning_bits;
968 |  |  |  |  | # convert this to a code string so the BEGIN doesn't have to close
969 |  |  |  |  | # over it, which can lead to issues with Devel::Cover
970 |  |  |  |  | my $bits_code = defined $warning_bits ? qq["\Q$warning_bits\E"] : 'undef';
971 |  |  |  |  |
972 |  |  |  |  | # This is so that warnings come out at the caller's level
973 |  |  |  |  | $succ = eval qq[
974 |  |  |  |  | BEGIN {\${^WARNING_BITS} = $bits_code};
975 |  |  |  |  | #line $line "(eval in cmp_ok) $file"
976 |  |  |  |  | \$test = (\$got $type \$expect);
977 |  |  |  |  | 1;
978 |  |  |  |  | ];
979 |  |  |  |  | $error = $@;
980 |  |  |  |  | }
981 |  |  |  |  | local $Level = $Level + 1;
982 |  |  |  |  | my $ok = $self->ok( $test, $name );
983 |  |  |  |  |
984 |  |  |  |  | # Treat overloaded objects as numbers if we're asked to do a
985 |  |  |  |  | # numeric comparison.
986 |  |  |  |  | my $unoverload
987 |  |  |  |  | = $numeric_cmps{$type}
988 |  |  |  |  | ? '_unoverload_num'
989 |  |  |  |  | : '_unoverload_str';
990 |  |  |  |  |
991 |  |  |  |  | $self->diag(<<"END") unless $succ;
992 |  |  |  |  | An error occurred while using $type:
993 |  |  |  |  | ------------------------------------
994 |  |  |  |  | $error
995 |  |  |  |  | ------------------------------------
996 |  |  |  |  | END
997 |  |  |  |  |
998 |  |  |  |  | unless($ok) {
999 |  |  |  |  | $self->$unoverload( \$got, \$expect );
1000 |  |  |  |  |
1001 |  |  |  |  | if( $type =~ /^(eq|==)$/ ) {
1002 |  |  |  |  | $self->_is_diag( $got, $type, $expect );
1003 |  |  |  |  | }
1004 |  |  |  |  | elsif( $type =~ /^(ne|!=)$/ ) {
1005 |  |  |  |  | if (defined($got) xor defined($expect)) {
1006 |  |  |  |  | $self->_cmp_diag( $got, $type, $expect );
1007 |  |  |  |  | }
1008 |  |  |  |  | else {
1009 |  |  |  |  | $self->_isnt_diag( $got, $type );
1010 |  |  |  |  | }
1011 |  |  |  |  | }
1012 |  |  |  |  | else {
1013 |  |  |  |  | $self->_cmp_diag( $got, $type, $expect );
1014 |  |  |  |  | }
1015 |  |  |  |  | }
1016 |  |  |  |  | return release $ctx, $ok;
1017 |  |  |  |  | }
1018 |  |  |  |  |
1019 |  |  |  |  | sub _cmp_diag {
1020 |  |  |  |  | my( $self, $got, $type, $expect ) = @_;
1021 |  |  |  |  |
1022 |  |  |  |  | $got = defined $got ? "'$got'" : 'undef';
1023 |  |  |  |  | $expect = defined $expect ? "'$expect'" : 'undef';
1024 |  |  |  |  |
1025 |  |  |  |  | local $Level = $Level + 1;
1026 |  |  |  |  | return $self->diag(<<"DIAGNOSTIC");
1027 |  |  |  |  | $got
1028 |  |  |  |  | $type
1029 |  |  |  |  | $expect
1030 |  |  |  |  | DIAGNOSTIC
1031 |  |  |  |  | }
1032 |  |  |  |  |
1033 |  |  |  |  | sub _caller_context {
1034 |  |  |  |  | my $self = shift;
1035 |  |  |  |  |
1036 |  |  |  |  | my( $pack, $file, $line ) = $self->caller(1);
1037 |  |  |  |  |
1038 |  |  |  |  | my $code = '';
1039 |  |  |  |  | $code .= "#line $line $file\n" if defined $file and defined $line;
1040 |  |  |  |  |
1041 |  |  |  |  | return $code;
1042 |  |  |  |  | }
1043 |  |  |  |  |
1044 |  |  |  |  |
1045 |  |  |  |  | sub BAIL_OUT {
1046 |  |  |  |  | my( $self, $reason ) = @_;
1047 |  |  |  |  |
1048 |  |  |  |  | my $ctx = $self->ctx;
1049 |  |  |  |  |
1050 |  |  |  |  | $self->{Bailed_Out} = 1;
1051 |  |  |  |  |
1052 |  |  |  |  | $ctx->bail($reason);
1053 |  |  |  |  | }
1054 |  |  |  |  |
1055 |  |  |  |  |
1056 |  |  |  |  | {
1057 | 3 | 439µs | 2 | 32µs | # spent 19µs (5+14) within Test::Builder::BEGIN@1057 which was called: # once (5µs+14µs) by Test::Builder::Module::BEGIN@5 at line 1057 no warnings 'once'; # spent 19µs making 1 call to Test::Builder::BEGIN@1057 # spent 14µs making 1 call to warnings::unimport
1058 | 1 | 800ns |  |  | *BAILOUT = \&BAIL_OUT;
1059 |  |  |  |  | }
1060 |  |  |  |  |
1061 |  |  |  |  | sub skip {
1062 |  |  |  |  | my( $self, $why, $name ) = @_;
1063 |  |  |  |  | $why ||= '';
1064 |  |  |  |  | $name = '' unless defined $name;
1065 |  |  |  |  | $self->_unoverload_str( \$why );
1066 |  |  |  |  |
1067 |  |  |  |  | my $ctx = $self->ctx;
1068 |  |  |  |  |
1069 |  |  |  |  | $name = "$name";
1070 |  |  |  |  | $why = "$why";
1071 |  |  |  |  |
1072 |  |  |  |  | $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
1073 |  |  |  |  | $name =~ s{\n}{\n# }sg;
1074 |  |  |  |  | $why =~ s{\n}{\n# }sg;
1075 |  |  |  |  |
1076 |  |  |  |  | $ctx->hub->meta(__PACKAGE__, {})->{Test_Results}[ $ctx->hub->count ] = {
1077 |  |  |  |  | 'ok' => 1,
1078 |  |  |  |  | actual_ok => 1,
1079 |  |  |  |  | name => $name,
1080 |  |  |  |  | type => 'skip',
1081 |  |  |  |  | reason => $why,
1082 |  |  |  |  | } unless $self->{no_log_results};
1083 |  |  |  |  |
1084 |  |  |  |  | my $tctx = $ctx->snapshot;
1085 |  |  |  |  | $tctx->skip('', $why);
1086 |  |  |  |  |
1087 |  |  |  |  | return release $ctx, 1;
1088 |  |  |  |  | }
1089 |  |  |  |  |
1090 |  |  |  |  |
1091 |  |  |  |  | sub todo_skip {
1092 |  |  |  |  | my( $self, $why ) = @_;
1093 |  |  |  |  | $why ||= '';
1094 |  |  |  |  |
1095 |  |  |  |  | my $ctx = $self->ctx;
1096 |  |  |  |  |
1097 |  |  |  |  | $ctx->hub->meta(__PACKAGE__, {})->{Test_Results}[ $ctx->hub->count ] = {
1098 |  |  |  |  | 'ok' => 1,
1099 |  |  |  |  | actual_ok => 0,
1100 |  |  |  |  | name => '',
1101 |  |  |  |  | type => 'todo_skip',
1102 |  |  |  |  | reason => $why,
1103 |  |  |  |  | } unless $self->{no_log_results};
1104 |  |  |  |  |
1105 |  |  |  |  | $why =~ s{\n}{\n# }sg;
1106 |  |  |  |  | my $tctx = $ctx->snapshot;
1107 |  |  |  |  | $tctx->send_event( 'Skip', todo => $why, todo_diag => 1, reason => $why, pass => 0);
1108 |  |  |  |  |
1109 |  |  |  |  | return release $ctx, 1;
1110 |  |  |  |  | }
1111 |  |  |  |  |
1112 |  |  |  |  |
1113 |  |  |  |  | sub maybe_regex {
1114 |  |  |  |  | my( $self, $regex ) = @_;
1115 |  |  |  |  | my $usable_regex = undef;
1116 |  |  |  |  |
1117 |  |  |  |  | return $usable_regex unless defined $regex;
1118 |  |  |  |  |
1119 |  |  |  |  | my( $re, $opts );
1120 |  |  |  |  |
1121 |  |  |  |  | # Check for qr/foo/
1122 |  |  |  |  | if( _is_qr($regex) ) {
1123 |  |  |  |  | $usable_regex = $regex;
1124 |  |  |  |  | }
1125 |  |  |  |  | # Check for '/foo/' or 'm,foo,'
1126 |  |  |  |  | elsif(( $re, $opts ) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or
1127 |  |  |  |  | ( undef, $re, $opts ) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx
1128 |  |  |  |  | )
1129 |  |  |  |  | {
1130 |  |  |  |  | $usable_regex = length $opts ? "(?$opts)$re" : $re;
1131 |  |  |  |  | }
1132 |  |  |  |  |
1133 |  |  |  |  | return $usable_regex;
1134 |  |  |  |  | }
1135 |  |  |  |  |
1136 |  |  |  |  | sub _is_qr {
1137 |  |  |  |  | my $regex = shift;
1138 |  |  |  |  |
1139 |  |  |  |  | # is_regexp() checks for regexes in a robust manner, say if they're
1140 |  |  |  |  | # blessed.
1141 |  |  |  |  | return re::is_regexp($regex) if defined &re::is_regexp;
1142 |  |  |  |  | return ref $regex eq 'Regexp';
1143 |  |  |  |  | }
1144 |  |  |  |  |
1145 |  |  |  |  | sub _regex_ok {
1146 |  |  |  |  | my( $self, $thing, $regex, $cmp, $name ) = @_;
1147 |  |  |  |  |
1148 |  |  |  |  | my $ok = 0;
1149 |  |  |  |  | my $usable_regex = $self->maybe_regex($regex);
1150 |  |  |  |  | unless( defined $usable_regex ) {
1151 |  |  |  |  | local $Level = $Level + 1;
1152 |  |  |  |  | $ok = $self->ok( 0, $name );
1153 |  |  |  |  | $self->diag(" '$regex' doesn't look much like a regex to me.");
1154 |  |  |  |  | return $ok;
1155 |  |  |  |  | }
1156 |  |  |  |  |
1157 |  |  |  |  | {
1158 |  |  |  |  | my $test;
1159 |  |  |  |  | my $context = $self->_caller_context;
1160 |  |  |  |  |
1161 |  |  |  |  | {
1162 |  |  |  |  | ## no critic (BuiltinFunctions::ProhibitStringyEval)
1163 |  |  |  |  |
1164 |  |  |  |  | local( $@, $!, $SIG{__DIE__} ); # isolate eval
1165 |  |  |  |  |
1166 |  |  |  |  | # No point in issuing an uninit warning, they'll see it in the diagnostics
1167 | 2 | 250µs | 2 | 32µs | # spent 18µs (5+13) within Test::Builder::BEGIN@1167 which was called: # once (5µs+13µs) by Test::Builder::Module::BEGIN@5 at line 1167 no warnings 'uninitialized'; # spent 18µs making 1 call to Test::Builder::BEGIN@1167 # spent 13µs making 1 call to warnings::unimport
1168 |  |  |  |  |
1169 |  |  |  |  | $test = eval $context . q{$test = $thing =~ /$usable_regex/ ? 1 : 0};
1170 |  |  |  |  | }
1171 |  |  |  |  |
1172 |  |  |  |  | $test = !$test if $cmp eq '!~';
1173 |  |  |  |  |
1174 |  |  |  |  | local $Level = $Level + 1;
1175 |  |  |  |  | $ok = $self->ok( $test, $name );
1176 |  |  |  |  | }
1177 |  |  |  |  |
1178 |  |  |  |  | unless($ok) {
1179 |  |  |  |  | $thing = defined $thing ? "'$thing'" : 'undef';
1180 |  |  |  |  | my $match = $cmp eq '=~' ? "doesn't match" : "matches";
1181 |  |  |  |  |
1182 |  |  |  |  | local $Level = $Level + 1;
1183 |  |  |  |  | $self->diag( sprintf <<'DIAGNOSTIC', $thing, $match, $regex );
1184 |  |  |  |  | %s
1185 |  |  |  |  | %13s '%s'
1186 |  |  |  |  | DIAGNOSTIC
1187 |  |  |  |  |
1188 |  |  |  |  | }
1189 |  |  |  |  |
1190 |  |  |  |  | return $ok;
1191 |  |  |  |  | }
1192 |  |  |  |  |
1193 |  |  |  |  |
1194 |  |  |  |  | sub is_fh {
1195 |  |  |  |  | my $self = shift;
1196 |  |  |  |  | my $maybe_fh = shift;
1197 |  |  |  |  | return 0 unless defined $maybe_fh;
1198 |  |  |  |  |
1199 |  |  |  |  | return 1 if ref $maybe_fh eq 'GLOB'; # its a glob ref
1200 |  |  |  |  | return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob
1201 |  |  |  |  |
1202 |  |  |  |  | return eval { $maybe_fh->isa("IO::Handle") } ||
1203 |  |  |  |  | eval { tied($maybe_fh)->can('TIEHANDLE') };
1204 |  |  |  |  | }
1205 |  |  |  |  |
1206 |  |  |  |  |
1207 |  |  |  |  | sub level {
1208 |  |  |  |  | my( $self, $level ) = @_;
1209 |  |  |  |  |
1210 |  |  |  |  | if( defined $level ) {
1211 |  |  |  |  | $Level = $level;
1212 |  |  |  |  | }
1213 |  |  |  |  | return $Level;
1214 |  |  |  |  | }
1215 |  |  |  |  |
1216 |  |  |  |  |
1217 |  |  |  |  | # spent 48µs (16+33) within Test::Builder::use_numbers which was called: # once (16µs+33µs) by Test::Builder::reset at line 476 sub use_numbers {
1218 | 1 | 200ns |  |  | my( $self, $use_nums ) = @_;
1219 |  |  |  |  |
1220 | 1 | 700ns | 1 | 23µs | my $ctx = $self->ctx; # spent 23µs making 1 call to Test::Builder::ctx
1221 | 1 | 1µs | 2 | 1µs | my $format = $ctx->hub->format; # spent 800ns making 1 call to Test2::Hub::format # spent 500ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
1222 | 1 | 5µs | 2 | 2µs | unless ($format && $format->can('no_numbers') && $format->can('set_no_numbers')) { # spent 2µs making 2 calls to UNIVERSAL::can, avg 1µs/call
1223 |  |  |  |  | warn "The current formatter does not support 'use_numbers'" if $format;
1224 |  |  |  |  | return release $ctx, 0;
1225 |  |  |  |  | }
1226 |  |  |  |  |
1227 | 1 | 800ns | 1 | 1µs | $format->set_no_numbers(!$use_nums) if defined $use_nums; # spent 1µs making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:85]
1228 |  |  |  |  |
1229 | 1 | 4µs | 3 | 6µs | return release $ctx, $format->no_numbers ? 0 : 1; # spent 4µs making 1 call to Test2::API::release # spent 600ns making 1 call to Test2::API::Context::DESTROY # spent 400ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
1230 |  |  |  |  | }
1231 |  |  |  |  |
1232 |  |  |  |  | # spent 12µs within Test::Builder::BEGIN@1232 which was called: # once (12µs+0s) by Test::Builder::Module::BEGIN@5 at line 1254 BEGIN {
1233 | 1 | 2µs |  |  | for my $method (qw(no_header no_diag)) {
1234 | 2 | 600ns |  |  | my $set = "set_$method";
1235 |  |  |  |  | my $code = sub {
1236 |  |  |  |  | my( $self, $no ) = @_;
1237 |  |  |  |  |
1238 |  |  |  |  | my $ctx = $self->ctx;
1239 |  |  |  |  | my $format = $ctx->hub->format;
1240 |  |  |  |  | unless ($format && $format->can($set)) {
1241 |  |  |  |  | warn "The current formatter does not support '$method'" if $format;
1242 |  |  |  |  | $ctx->release;
1243 |  |  |  |  | return
1244 |  |  |  |  | }
1245 |  |  |  |  |
1246 |  |  |  |  | $format->$set($no) if defined $no;
1247 |  |  |  |  |
1248 |  |  |  |  | return release $ctx, $format->$method ? 1 : 0;
1249 | 2 | 6µs |  |  | };
1250 |  |  |  |  |
1251 | 2 | 28µs | 2 | 14µs | # spent 10µs (6+4) within Test::Builder::BEGIN@1251 which was called: # once (6µs+4µs) by Test::Builder::Module::BEGIN@5 at line 1251 no strict 'refs'; ## no critic # spent 10µs making 1 call to Test::Builder::BEGIN@1251 # spent 4µs making 1 call to strict::unimport
1252 | 2 | 3µs |  |  | *$method = $code;
1253 |  |  |  |  | }
1254 | 1 | 735µs | 1 | 12µs | } # spent 12µs making 1 call to Test::Builder::BEGIN@1232
1255 |  |  |  |  |
1256 |  |  |  |  | sub no_ending {
1257 |  |  |  |  | my( $self, $no ) = @_;
1258 |  |  |  |  |
1259 |  |  |  |  | my $ctx = $self->ctx;
1260 |  |  |  |  |
1261 |  |  |  |  | $ctx->hub->set_no_ending($no) if defined $no;
1262 |  |  |  |  |
1263 |  |  |  |  | return release $ctx, $ctx->hub->no_ending;
1264 |  |  |  |  | }
1265 |  |  |  |  |
1266 |  |  |  |  | sub diag {
1267 |  |  |  |  | my $self = shift;
1268 |  |  |  |  | return unless @_;
1269 |  |  |  |  |
1270 |  |  |  |  | my $text = join '' => map {defined($_) ? $_ : 'undef'} @_;
1271 |  |  |  |  |
1272 |  |  |  |  | if (Test2::API::test2_in_preload()) {
1273 |  |  |  |  | chomp($text);
1274 |  |  |  |  | $text =~ s/^/# /msg;
1275 |  |  |  |  | print STDERR $text, "\n";
1276 |  |  |  |  | return 0;
1277 |  |  |  |  | }
1278 |  |  |  |  |
1279 |  |  |  |  | my $ctx = $self->ctx;
1280 |  |  |  |  | $ctx->diag($text);
1281 |  |  |  |  | $ctx->release;
1282 |  |  |  |  | return 0;
1283 |  |  |  |  | }
1284 |  |  |  |  |
1285 |  |  |  |  |
1286 |  |  |  |  | sub note {
1287 |  |  |  |  | my $self = shift;
1288 |  |  |  |  | return unless @_;
1289 |  |  |  |  |
1290 |  |  |  |  | my $text = join '' => map {defined($_) ? $_ : 'undef'} @_;
1291 |  |  |  |  |
1292 |  |  |  |  | if (Test2::API::test2_in_preload()) {
1293 |  |  |  |  | chomp($text);
1294 |  |  |  |  | $text =~ s/^/# /msg;
1295 |  |  |  |  | print STDOUT $text, "\n";
1296 |  |  |  |  | return 0;
1297 |  |  |  |  | }
1298 |  |  |  |  |
1299 |  |  |  |  | my $ctx = $self->ctx;
1300 |  |  |  |  | $ctx->note($text);
1301 |  |  |  |  | $ctx->release;
1302 |  |  |  |  | return 0;
1303 |  |  |  |  | }
1304 |  |  |  |  |
1305 |  |  |  |  |
1306 |  |  |  |  | sub explain {
1307 |  |  |  |  | my $self = shift;
1308 |  |  |  |  |
1309 |  |  |  |  | local ($@, $!);
1310 |  |  |  |  | require Data::Dumper;
1311 |  |  |  |  |
1312 |  |  |  |  | return map {
1313 |  |  |  |  | ref $_
1314 |  |  |  |  | ? do {
1315 |  |  |  |  | my $dumper = Data::Dumper->new( [$_] );
1316 |  |  |  |  | $dumper->Indent(1)->Terse(1);
1317 |  |  |  |  | $dumper->Sortkeys(1) if $dumper->can("Sortkeys");
1318 |  |  |  |  | $dumper->Dump;
1319 |  |  |  |  | }
1320 |  |  |  |  | : $_
1321 |  |  |  |  | } @_;
1322 |  |  |  |  | }
1323 |  |  |  |  |
1324 |  |  |  |  |
1325 |  |  |  |  | sub output {
1326 |  |  |  |  | my( $self, $fh ) = @_;
1327 |  |  |  |  |
1328 |  |  |  |  | my $ctx = $self->ctx;
1329 |  |  |  |  | my $format = $ctx->hub->format;
1330 |  |  |  |  | $ctx->release;
1331 |  |  |  |  | return unless $format && $format->isa('Test2::Formatter::TAP');
1332 |  |  |  |  |
1333 |  |  |  |  | $format->handles->[Test2::Formatter::TAP::OUT_STD()] = $self->_new_fh($fh)
1334 |  |  |  |  | if defined $fh;
1335 |  |  |  |  |
1336 |  |  |  |  | return $format->handles->[Test2::Formatter::TAP::OUT_STD()];
1337 |  |  |  |  | }
1338 |  |  |  |  |
1339 |  |  |  |  | sub failure_output {
1340 |  |  |  |  | my( $self, $fh ) = @_;
1341 |  |  |  |  |
1342 |  |  |  |  | my $ctx = $self->ctx;
1343 |  |  |  |  | my $format = $ctx->hub->format;
1344 |  |  |  |  | $ctx->release;
1345 |  |  |  |  | return unless $format && $format->isa('Test2::Formatter::TAP');
1346 |  |  |  |  |
1347 |  |  |  |  | $format->handles->[Test2::Formatter::TAP::OUT_ERR()] = $self->_new_fh($fh)
1348 |  |  |  |  | if defined $fh;
1349 |  |  |  |  |
1350 |  |  |  |  | return $format->handles->[Test2::Formatter::TAP::OUT_ERR()];
1351 |  |  |  |  | }
1352 |  |  |  |  |
1353 |  |  |  |  | sub todo_output {
1354 |  |  |  |  | my( $self, $fh ) = @_;
1355 |  |  |  |  |
1356 |  |  |  |  | my $ctx = $self->ctx;
1357 |  |  |  |  | my $format = $ctx->hub->format;
1358 |  |  |  |  | $ctx->release;
1359 |  |  |  |  | return unless $format && $format->isa('Test::Builder::Formatter');
1360 |  |  |  |  |
1361 |  |  |  |  | $format->handles->[Test::Builder::Formatter::OUT_TODO()] = $self->_new_fh($fh)
1362 |  |  |  |  | if defined $fh;
1363 |  |  |  |  |
1364 |  |  |  |  | return $format->handles->[Test::Builder::Formatter::OUT_TODO()];
1365 |  |  |  |  | }
1366 |  |  |  |  |
1367 |  |  |  |  | sub _new_fh {
1368 |  |  |  |  | my $self = shift;
1369 |  |  |  |  | my($file_or_fh) = shift;
1370 |  |  |  |  |
1371 |  |  |  |  | my $fh;
1372 |  |  |  |  | if( $self->is_fh($file_or_fh) ) {
1373 |  |  |  |  | $fh = $file_or_fh;
1374 |  |  |  |  | }
1375 |  |  |  |  | elsif( ref $file_or_fh eq 'SCALAR' ) {
1376 |  |  |  |  | # Scalar refs as filehandles was added in 5.8.
1377 |  |  |  |  | if( $] >= 5.008 ) {
1378 |  |  |  |  | open $fh, ">>", $file_or_fh
1379 |  |  |  |  | or $self->croak("Can't open scalar ref $file_or_fh: $!");
1380 |  |  |  |  | }
1381 |  |  |  |  | # Emulate scalar ref filehandles with a tie.
1382 |  |  |  |  | else {
1383 |  |  |  |  | $fh = Test::Builder::IO::Scalar->new($file_or_fh)
1384 |  |  |  |  | or $self->croak("Can't tie scalar ref $file_or_fh");
1385 |  |  |  |  | }
1386 |  |  |  |  | }
1387 |  |  |  |  | else {
1388 |  |  |  |  | open $fh, ">", $file_or_fh
1389 |  |  |  |  | or $self->croak("Can't open test output log $file_or_fh: $!");
1390 |  |  |  |  | _autoflush($fh);
1391 |  |  |  |  | }
1392 |  |  |  |  |
1393 |  |  |  |  | return $fh;
1394 |  |  |  |  | }
1395 |  |  |  |  |
1396 |  |  |  |  | sub _autoflush {
1397 |  |  |  |  | my($fh) = shift;
1398 |  |  |  |  | my $old_fh = select $fh;
1399 |  |  |  |  | $| = 1;
1400 |  |  |  |  | select $old_fh;
1401 |  |  |  |  |
1402 |  |  |  |  | return;
1403 |  |  |  |  | }
1404 |  |  |  |  |
1405 |  |  |  |  |
1406 |  |  |  |  | # spent 59µs (28+31) within Test::Builder::reset_outputs which was called: # once (28µs+31µs) by Test::Builder::reset at line 479 sub reset_outputs {
1407 | 1 | 100ns |  |  | my $self = shift;
1408 |  |  |  |  |
1409 | 1 | 700ns | 1 | 17µs | my $ctx = $self->ctx; # spent 17µs making 1 call to Test::Builder::ctx
1410 | 1 | 1µs | 2 | 1µs | my $format = $ctx->hub->format; # spent 700ns making 1 call to Test2::Hub::format # spent 500ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
1411 | 1 | 400ns | 1 | 2µs | $ctx->release; # spent 2µs making 1 call to Test2::API::Context::release
1412 | 1 | 2µs | 1 | 400ns | return unless $format && $format->isa('Test2::Formatter::TAP'); # spent 400ns making 1 call to UNIVERSAL::isa
1413 | 1 | 2µs | 1 | 900ns | $format->set_handles([@{$self->{Orig_Handles}}]) if $self->{Orig_Handles}; # spent 900ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:85]
1414 |  |  |  |  |
1415 | 1 | 4µs | 1 | 9µs | return; # spent 9µs making 1 call to Test2::API::Context::DESTROY
1416 |  |  |  |  | }
1417 |  |  |  |  |
1418 |  |  |  |  |
1419 |  |  |  |  | sub carp {
1420 |  |  |  |  | my $self = shift;
1421 |  |  |  |  | my $ctx = $self->ctx;
1422 |  |  |  |  | $ctx->alert(join "", @_);
1423 |  |  |  |  | $ctx->release;
1424 |  |  |  |  | }
1425 |  |  |  |  |
1426 |  |  |  |  | sub croak {
1427 |  |  |  |  | my $self = shift;
1428 |  |  |  |  | my $ctx = $self->ctx;
1429 |  |  |  |  | $ctx->throw(join "", @_);
1430 |  |  |  |  | $ctx->release;
1431 |  |  |  |  | }
1432 |  |  |  |  |
1433 |  |  |  |  |
1434 |  |  |  |  | # spent 40µs (11+29) within Test::Builder::current_test which was called: # once (11µs+29µs) by Test::Builder::done_testing at line 608 sub current_test {
1435 | 1 | 300ns |  |  | my( $self, $num ) = @_;
1436 |  |  |  |  |
1437 | 1 | 900ns | 1 | 21µs | my $ctx = $self->ctx; # spent 21µs making 1 call to Test::Builder::ctx
1438 | 1 | 800ns | 1 | 500ns | my $hub = $ctx->hub; # spent 500ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
1439 |  |  |  |  |
1440 | 1 | 300ns |  |  | if( defined $num ) {
1441 |  |  |  |  | $hub->set_count($num);
1442 |  |  |  |  |
1443 |  |  |  |  | unless ($self->{no_log_results}) {
1444 |  |  |  |  | # If the test counter is being pushed forward fill in the details.
1445 |  |  |  |  | my $test_results = $ctx->hub->meta(__PACKAGE__, {})->{Test_Results};
1446 |  |  |  |  | if ($num > @$test_results) {
1447 |  |  |  |  | my $start = @$test_results ? @$test_results : 0;
1448 |  |  |  |  | for ($start .. $num - 1) {
1449 |  |  |  |  | $test_results->[$_] = {
1450 |  |  |  |  | 'ok' => 1,
1451 |  |  |  |  | actual_ok => undef,
1452 |  |  |  |  | reason => 'incrementing test number',
1453 |  |  |  |  | type => 'unknown',
1454 |  |  |  |  | name => undef
1455 |  |  |  |  | };
1456 |  |  |  |  | }
1457 |  |  |  |  | }
1458 |  |  |  |  | # If backward, wipe history. Its their funeral.
1459 |  |  |  |  | elsif ($num < @$test_results) {
1460 |  |  |  |  | $#{$test_results} = $num - 1;
1461 |  |  |  |  | }
1462 |  |  |  |  | }
1463 |  |  |  |  | }
1464 | 1 | 6µs | 3 | 7µs | return release $ctx, $hub->count; # spent 6µs making 1 call to Test2::API::release # spent 700ns making 1 call to Test2::API::Context::DESTROY # spent 300ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
1465 |  |  |  |  | }
1466 |  |  |  |  |
1467 |  |  |  |  |
1468 |  |  |  |  | sub is_passing {
1469 |  |  |  |  | my $self = shift;
1470 |  |  |  |  |
1471 |  |  |  |  | my $ctx = $self->ctx;
1472 |  |  |  |  | my $hub = $ctx->hub;
1473 |  |  |  |  |
1474 |  |  |  |  | if( @_ ) {
1475 |  |  |  |  | my ($bool) = @_;
1476 |  |  |  |  | $hub->set_failed(0) if $bool;
1477 |  |  |  |  | $hub->is_passing($bool);
1478 |  |  |  |  | }
1479 |  |  |  |  |
1480 |  |  |  |  | return release $ctx, $hub->is_passing;
1481 |  |  |  |  | }
1482 |  |  |  |  |
1483 |  |  |  |  |
1484 |  |  |  |  | sub summary {
1485 |  |  |  |  | my($self) = shift;
1486 |  |  |  |  |
1487 |  |  |  |  | return if $self->{no_log_results};
1488 |  |  |  |  |
1489 |  |  |  |  | my $ctx = $self->ctx;
1490 |  |  |  |  | my $data = $ctx->hub->meta(__PACKAGE__, {})->{Test_Results};
1491 |  |  |  |  | $ctx->release;
1492 |  |  |  |  | return map { $_ ? $_->{'ok'} : () } @$data;
1493 |  |  |  |  | }
1494 |  |  |  |  |
1495 |  |  |  |  |
1496 |  |  |  |  | sub details {
1497 |  |  |  |  | my $self = shift;
1498 |  |  |  |  |
1499 |  |  |  |  | return if $self->{no_log_results};
1500 |  |  |  |  |
1501 |  |  |  |  | my $ctx = $self->ctx;
1502 |  |  |  |  | my $data = $ctx->hub->meta(__PACKAGE__, {})->{Test_Results};
1503 |  |  |  |  | $ctx->release;
1504 |  |  |  |  | return @$data;
1505 |  |  |  |  | }
1506 |  |  |  |  |
1507 |  |  |  |  |
1508 |  |  |  |  | sub find_TODO {
1509 |  |  |  |  | my( $self, $pack, $set, $new_value ) = @_;
1510 |  |  |  |  |
1511 |  |  |  |  | my $ctx = $self->ctx;
1512 |  |  |  |  |
1513 |  |  |  |  | $pack ||= $ctx->trace->package || $self->exported_to;
1514 |  |  |  |  | $ctx->release;
1515 |  |  |  |  |
1516 |  |  |  |  | return unless $pack;
1517 |  |  |  |  |
1518 | 2 | 27µs | 2 | 15µs | # spent 11µs (6+4) within Test::Builder::BEGIN@1518 which was called: # once (6µs+4µs) by Test::Builder::Module::BEGIN@5 at line 1518 no strict 'refs'; ## no critic # spent 11µs making 1 call to Test::Builder::BEGIN@1518 # spent 4µs making 1 call to strict::unimport
1519 | 2 | 92µs | 2 | 31µs | # spent 19µs (7+12) within Test::Builder::BEGIN@1519 which was called: # once (7µs+12µs) by Test::Builder::Module::BEGIN@5 at line 1519 no warnings 'once'; # spent 19µs making 1 call to Test::Builder::BEGIN@1519 # spent 12µs making 1 call to warnings::unimport
1520 |  |  |  |  | my $old_value = ${ $pack . '::TODO' };
1521 |  |  |  |  | $set and ${ $pack . '::TODO' } = $new_value;
1522 |  |  |  |  | return $old_value;
1523 |  |  |  |  | }
1524 |  |  |  |  |
1525 |  |  |  |  | sub todo {
1526 |  |  |  |  | my( $self, $pack ) = @_;
1527 |  |  |  |  |
1528 |  |  |  |  | local $Level = $Level + 1;
1529 |  |  |  |  | my $ctx = $self->ctx;
1530 |  |  |  |  | $ctx->release;
1531 |  |  |  |  |
1532 |  |  |  |  | my $meta = $ctx->hub->meta(__PACKAGE__, {todo => []})->{todo};
1533 |  |  |  |  | return $meta->[-1]->[1] if $meta && @$meta;
1534 |  |  |  |  |
1535 |  |  |  |  | $pack ||= $ctx->trace->package;
1536 |  |  |  |  |
1537 |  |  |  |  | return unless $pack;
1538 |  |  |  |  |
1539 | 2 | 20µs | 2 | 13µs | # spent 9µs (5+4) within Test::Builder::BEGIN@1539 which was called: # once (5µs+4µs) by Test::Builder::Module::BEGIN@5 at line 1539 no strict 'refs'; ## no critic # spent 9µs making 1 call to Test::Builder::BEGIN@1539 # spent 4µs making 1 call to strict::unimport
1540 | 2 | 72µs | 2 | 25µs | # spent 14µs (4+11) within Test::Builder::BEGIN@1540 which was called: # once (4µs+11µs) by Test::Builder::Module::BEGIN@5 at line 1540 no warnings 'once'; # spent 14µs making 1 call to Test::Builder::BEGIN@1540 # spent 11µs making 1 call to warnings::unimport
1541 |  |  |  |  | return ${ $pack . '::TODO' };
1542 |  |  |  |  | }
1543 |  |  |  |  |
1544 |  |  |  |  | sub in_todo {
1545 |  |  |  |  | my $self = shift;
1546 |  |  |  |  |
1547 |  |  |  |  | local $Level = $Level + 1;
1548 |  |  |  |  | my $ctx = $self->ctx;
1549 |  |  |  |  | $ctx->release;
1550 |  |  |  |  |
1551 |  |  |  |  | my $meta = $ctx->hub->meta(__PACKAGE__, {todo => []})->{todo};
1552 |  |  |  |  | return 1 if $meta && @$meta;
1553 |  |  |  |  |
1554 |  |  |  |  | my $pack = $ctx->trace->package || return 0;
1555 |  |  |  |  |
1556 | 2 | 21µs | 2 | 12µs | # spent 9µs (6+3) within Test::Builder::BEGIN@1556 which was called: # once (6µs+3µs) by Test::Builder::Module::BEGIN@5 at line 1556 no strict 'refs'; ## no critic # spent 9µs making 1 call to Test::Builder::BEGIN@1556 # spent 3µs making 1 call to strict::unimport
1557 | 2 | 662µs | 2 | 24µs | # spent 13µs (3+10) within Test::Builder::BEGIN@1557 which was called: # once (3µs+10µs) by Test::Builder::Module::BEGIN@5 at line 1557 no warnings 'once'; # spent 13µs making 1 call to Test::Builder::BEGIN@1557 # spent 10µs making 1 call to warnings::unimport
1558 |  |  |  |  | my $todo = ${ $pack . '::TODO' };
1559 |  |  |  |  |
1560 |  |  |  |  | return 0 unless defined $todo;
1561 |  |  |  |  | return 0 if "$todo" eq '';
1562 |  |  |  |  | return 1;
1563 |  |  |  |  | }
1564 |  |  |  |  |
1565 |  |  |  |  | sub todo_start {
1566 |  |  |  |  | my $self = shift;
1567 |  |  |  |  | my $message = @_ ? shift : '';
1568 |  |  |  |  |
1569 |  |  |  |  | my $ctx = $self->ctx;
1570 |  |  |  |  |
1571 |  |  |  |  | my $hub = $ctx->hub;
1572 |  |  |  |  | my $filter = $hub->pre_filter(sub {
1573 |  |  |  |  | my ($active_hub, $e) = @_;
1574 |  |  |  |  |
1575 |  |  |  |  | # Turn a diag into a todo diag
1576 |  |  |  |  | return Test::Builder::TodoDiag->new(%$e) if ref($e) eq 'Test2::Event::Diag';
1577 |  |  |  |  |
1578 |  |  |  |  | # Set todo on ok's
1579 |  |  |  |  | if ($hub == $active_hub && $e->isa('Test2::Event::Ok')) {
1580 |  |  |  |  | $e->set_todo($message);
1581 |  |  |  |  | $e->set_effective_pass(1);
1582 |  |  |  |  |
1583 |  |  |  |  | if (my $result = $e->get_meta(__PACKAGE__)) {
1584 |  |  |  |  | $result->{reason} ||= $message;
1585 |  |  |  |  | $result->{type} ||= 'todo';
1586 |  |  |  |  | $result->{ok} = 1;
1587 |  |  |  |  | }
1588 |  |  |  |  | }
1589 |  |  |  |  |
1590 |  |  |  |  | return $e;
1591 |  |  |  |  | }, inherit => 1);
1592 |  |  |  |  |
1593 |  |  |  |  | push @{$ctx->hub->meta(__PACKAGE__, {todo => []})->{todo}} => [$filter, $message];
1594 |  |  |  |  |
1595 |  |  |  |  | $ctx->release;
1596 |  |  |  |  |
1597 |  |  |  |  | return;
1598 |  |  |  |  | }
1599 |  |  |  |  |
1600 |  |  |  |  | sub todo_end {
1601 |  |  |  |  | my $self = shift;
1602 |  |  |  |  |
1603 |  |  |  |  | my $ctx = $self->ctx;
1604 |  |  |  |  |
1605 |  |  |  |  | my $set = pop @{$ctx->hub->meta(__PACKAGE__, {todo => []})->{todo}};
1606 |  |  |  |  |
1607 |  |  |  |  | $ctx->throw('todo_end() called without todo_start()') unless $set;
1608 |  |  |  |  |
1609 |  |  |  |  | $ctx->hub->pre_unfilter($set->[0]);
1610 |  |  |  |  |
1611 |  |  |  |  | $ctx->release;
1612 |  |  |  |  |
1613 |  |  |  |  | return;
1614 |  |  |  |  | }
1615 |  |  |  |  |
1616 |  |  |  |  |
1617 |  |  |  |  | sub caller { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
1618 |  |  |  |  | my( $self ) = @_;
1619 |  |  |  |  |
1620 |  |  |  |  | my $ctx = $self->ctx;
1621 |  |  |  |  |
1622 |  |  |  |  | my $trace = $ctx->trace;
1623 |  |  |  |  | $ctx->release;
1624 |  |  |  |  | return wantarray ? $trace->call : $trace->package;
1625 |  |  |  |  | }
1626 |  |  |  |  |
1627 |  |  |  |  |
1628 |  |  |  |  | sub _try {
1629 |  |  |  |  | my( $self, $code, %opts ) = @_;
1630 |  |  |  |  |
1631 |  |  |  |  | my $error;
1632 |  |  |  |  | my $return;
1633 |  |  |  |  | {
1634 |  |  |  |  | local $!; # eval can mess up $!
1635 |  |  |  |  | local $@; # don't set $@ in the test
1636 |  |  |  |  | local $SIG{__DIE__}; # don't trip an outside DIE handler.
1637 |  |  |  |  | $return = eval { $code->() };
1638 |  |  |  |  | $error = $@;
1639 |  |  |  |  | }
1640 |  |  |  |  |
1641 |  |  |  |  | die $error if $error and $opts{die_on_fail};
1642 |  |  |  |  |
1643 |  |  |  |  | return wantarray ? ( $return, $error ) : $return;
1644 |  |  |  |  | }
1645 |  |  |  |  |
1646 |  |  |  |  | # spent 43µs (29+14) within Test::Builder::_ending which was called: # once (29µs+14µs) by Test::Builder::__ANON__[/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test/Builder.pm:156] at line 156 sub _ending {
1647 | 1 | 200ns |  |  | my $self = shift;
1648 | 1 | 500ns |  |  | my ($ctx, $real_exit_code, $new) = @_;
1649 |  |  |  |  |
1650 | 1 | 300ns |  |  | unless ($ctx) {
1651 |  |  |  |  | my $octx = $self->ctx;
1652 |  |  |  |  | $ctx = $octx->snapshot;
1653 |  |  |  |  | $octx->release;
1654 |  |  |  |  | }
1655 |  |  |  |  |
1656 | 1 | 1µs | 2 | 900ns | return if $ctx->hub->no_ending; # spent 900ns making 2 calls to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84], avg 450ns/call
1657 | 1 | 3µs | 2 | 4µs | return if $ctx->hub->meta(__PACKAGE__, {})->{Ending}++; # spent 4µs making 1 call to Test2::Util::ExternalMeta::meta # spent 300ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
1658 |  |  |  |  |
1659 |  |  |  |  | # Don't bother with an ending if this is a forked copy. Only the parent
1660 |  |  |  |  | # should do the ending.
1661 | 1 | 1µs |  |  | return unless $self->{Original_Pid} == $$;
1662 |  |  |  |  |
1663 | 1 | 800ns | 1 | 300ns | my $hub = $ctx->hub; # spent 300ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
1664 | 1 | 2µs | 1 | 1µs | return if $hub->bailed_out; # spent 1µs making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
1665 |  |  |  |  |
1666 | 1 | 1µs | 1 | 900ns | my $plan = $hub->plan; # spent 900ns making 1 call to Test2::Hub::plan
1667 | 1 | 900ns | 1 | 500ns | my $count = $hub->count; # spent 500ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
1668 | 1 | 1µs | 1 | 600ns | my $failed = $hub->failed; # spent 600ns making 1 call to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84]
1669 | 1 | 800ns | 1 | 5µs | my $passed = $hub->is_passing; # spent 5µs making 1 call to Test2::Hub::is_passing
1670 | 1 | 400ns |  |  | return unless $plan || $count || $failed;
1671 |  |  |  |  |
1672 |  |  |  |  | # Ran tests but never declared a plan or hit done_testing
1673 | 1 | 900ns | 1 | 500ns | if( !defined($hub->plan) and $hub->count ) { # spent 500ns making 1 call to Test2::Hub::plan
1674 |  |  |  |  | $self->diag("Tests were run but no plan was declared and done_testing() was not seen.");
1675 |  |  |  |  |
1676 |  |  |  |  | if($real_exit_code) {
1677 |  |  |  |  | $self->diag(<<"FAIL");
1678 |  |  |  |  | Looks like your test exited with $real_exit_code just after $count.
1679 |  |  |  |  | FAIL
1680 |  |  |  |  | $$new ||= $real_exit_code;
1681 |  |  |  |  | return;
1682 |  |  |  |  | }
1683 |  |  |  |  |
1684 |  |  |  |  | # But if the tests ran, handle exit code.
1685 |  |  |  |  | if($failed > 0) {
1686 |  |  |  |  | my $exit_code = $failed <= 254 ? $failed : 254;
1687 |  |  |  |  | $$new ||= $exit_code;
1688 |  |  |  |  | return;
1689 |  |  |  |  | }
1690 |  |  |  |  |
1691 |  |  |  |  | $$new ||= 254;
1692 |  |  |  |  | return;
1693 |  |  |  |  | }
1694 |  |  |  |  |
1695 | 1 | 200ns |  |  | if ($real_exit_code && !$count) {
1696 |  |  |  |  | $self->diag("Looks like your test exited with $real_exit_code before it could output anything.");
1697 |  |  |  |  | $$new ||= $real_exit_code;
1698 |  |  |  |  | return;
1699 |  |  |  |  | }
1700 |  |  |  |  |
1701 | 1 | 800ns |  |  | return if $plan && "$plan" eq 'SKIP';
1702 |  |  |  |  |
1703 | 1 | 200ns |  |  | if (!$count) {
1704 |  |  |  |  | $self->diag('No tests run!');
1705 |  |  |  |  | $$new ||= 255;
1706 |  |  |  |  | return;
1707 |  |  |  |  | }
1708 |  |  |  |  |
1709 | 1 | 200ns |  |  | if ($real_exit_code) {
1710 |  |  |  |  | $self->diag(<<"FAIL");
1711 |  |  |  |  | Looks like your test exited with $real_exit_code just after $count.
1712 |  |  |  |  | FAIL
1713 |  |  |  |  | $$new ||= $real_exit_code;
1714 |  |  |  |  | return;
1715 |  |  |  |  | }
1716 |  |  |  |  |
1717 | 1 | 400ns |  |  | if ($plan eq 'NO PLAN') {
1718 |  |  |  |  | $ctx->plan( $count );
1719 |  |  |  |  | $plan = $hub->plan;
1720 |  |  |  |  | }
1721 |  |  |  |  |
1722 |  |  |  |  | # Figure out if we passed or failed and print helpful messages.
1723 | 1 | 300ns |  |  | my $num_extra = $count - $plan;
1724 |  |  |  |  |
1725 | 1 | 300ns |  |  | if ($num_extra != 0) {
1726 |  |  |  |  | my $s = $plan == 1 ? '' : 's';
1727 |  |  |  |  | $self->diag(<<"FAIL");
1728 |  |  |  |  | Looks like you planned $plan test$s but ran $count.
1729 |  |  |  |  | FAIL
1730 |  |  |  |  | }
1731 |  |  |  |  |
1732 | 1 | 300ns |  |  | if ($failed) {
1733 |  |  |  |  | my $s = $failed == 1 ? '' : 's';
1734 |  |  |  |  |
1735 |  |  |  |  | my $qualifier = $num_extra == 0 ? '' : ' run';
1736 |  |  |  |  |
1737 |  |  |  |  | $self->diag(<<"FAIL");
1738 |  |  |  |  | Looks like you failed $failed test$s of $count$qualifier.
1739 |  |  |  |  | FAIL
1740 |  |  |  |  | }
1741 |  |  |  |  |
1742 | 1 | 400ns |  |  | if (!$passed && !$failed && $count && !$num_extra) {
1743 |  |  |  |  | $ctx->diag(<<"FAIL");
1744 |  |  |  |  | All assertions passed, but errors were encountered.
1745 |  |  |  |  | FAIL
1746 |  |  |  |  | }
1747 |  |  |  |  |
1748 | 1 | 200ns |  |  | my $exit_code = 0;
1749 | 1 | 800ns |  |  | if ($failed) {
1750 |  |  |  |  | $exit_code = $failed <= 254 ? $failed : 254;
1751 |  |  |  |  | }
1752 |  |  |  |  | elsif ($num_extra != 0) {
1753 |  |  |  |  | $exit_code = 255;
1754 |  |  |  |  | }
1755 |  |  |  |  | elsif (!$passed) {
1756 |  |  |  |  | $exit_code = 255;
1757 |  |  |  |  | }
1758 |  |  |  |  |
1759 | 1 | 800ns |  |  | $$new ||= $exit_code;
1760 | 1 | 2µs |  |  | return;
1761 |  |  |  |  | }
1762 |  |  |  |  |
1763 |  |  |  |  | # Some things used this even though it was private... I am looking at you
1764 |  |  |  |  | # Test::Builder::Prefix...
1765 |  |  |  |  | sub _print_comment {
1766 |  |  |  |  | my( $self, $fh, @msgs ) = @_;
1767 |  |  |  |  |
1768 |  |  |  |  | return if $self->no_diag;
1769 |  |  |  |  | return unless @msgs;
1770 |  |  |  |  |
1771 |  |  |  |  | # Prevent printing headers when compiling (i.e. -c)
1772 |  |  |  |  | return if $^C;
1773 |  |  |  |  |
1774 |  |  |  |  | # Smash args together like print does.
1775 |  |  |  |  | # Convert undef to 'undef' so its readable.
1776 |  |  |  |  | my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs;
1777 |  |  |  |  |
1778 |  |  |  |  | # Escape the beginning, _print will take care of the rest.
1779 |  |  |  |  | $msg =~ s/^/# /;
1780 |  |  |  |  |
1781 |  |  |  |  | local( $\, $", $, ) = ( undef, ' ', '' );
1782 |  |  |  |  | print $fh $msg;
1783 |  |  |  |  |
1784 |  |  |  |  | return 0;
1785 |  |  |  |  | }
1786 |  |  |  |  |
1787 |  |  |  |  | # This is used by Test::SharedFork to turn on IPC after the fact. Not
1788 |  |  |  |  | # documenting because I do not want it used. The method name is borrowed from
1789 |  |  |  |  | # Test::Builder 2
1790 |  |  |  |  | # Once Test2 stuff goes stable this method will be removed and Test::SharedFork
1791 |  |  |  |  | # will be made smarter.
1792 |  |  |  |  | sub coordinate_forks {
1793 |  |  |  |  | my $self = shift;
1794 |  |  |  |  |
1795 |  |  |  |  | {
1796 |  |  |  |  | local ($@, $!);
1797 |  |  |  |  | require Test2::IPC;
1798 |  |  |  |  | }
1799 |  |  |  |  | Test2::IPC->import;
1800 |  |  |  |  | Test2::API::test2_ipc_enable_polling();
1801 |  |  |  |  | Test2::API::test2_load();
1802 |  |  |  |  | my $ipc = Test2::IPC::apply_ipc($self->{Stack});
1803 |  |  |  |  | $ipc->set_no_fatal(1);
1804 |  |  |  |  | Test2::API::test2_no_wait(1);
1805 |  |  |  |  | }
1806 |  |  |  |  |
1807 |  |  |  |  | sub no_log_results { $_[0]->{no_log_results} = 1 }
1808 |  |  |  |  |
1809 | 1 | 6µs |  |  | 1;
1810 |  |  |  |  |
1811 |  |  |  |  | __END__
|  |  |  |  | # spent 1µs within Test::Builder::__ANON__ which was called 3 times, avg 400ns/call: # once (700ns+0s) by Test::Builder::BEGIN@37 at line 37 # once (300ns+0s) by Test::Builder::BEGIN@33 at line 33 # once (200ns+0s) by Test::Builder::BEGIN@34 at line 34 sub Test::Builder::__ANON__; # xsub