← 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
StatementsExecuted 283 statements in 6.59ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1115.39ms27.5msTest::Builder::::BEGIN@18Test::Builder::BEGIN@18
1111.33ms11.2msTest::Builder::::BEGIN@17Test::Builder::BEGIN@17
1111.17ms1.48msTest::Builder::::BEGIN@15Test::Builder::BEGIN@15
111343µs2.62msTest::Builder::::BEGIN@36Test::Builder::BEGIN@36
111164µs202µsTest::Builder::::BEGIN@37Test::Builder::BEGIN@37
11147µs430µsTest::Builder::::resetTest::Builder::reset
11145µs353µsTest::Builder::::done_testingTest::Builder::done_testing
11140µs256µsTest::Builder::::okTest::Builder::ok
11129µs43µsTest::Builder::::_endingTest::Builder::_ending
11128µs59µsTest::Builder::::reset_outputsTest::Builder::reset_outputs
88120µs419µsTest::Builder::::ctxTest::Builder::ctx
52216µs53µsTest::Builder::::newTest::Builder::new
11116µs48µsTest::Builder::::use_numbersTest::Builder::use_numbers
11115µs58µsTest::Builder::::__ANON__[:156]Test::Builder::__ANON__[:156]
31114µs14µsTest::Builder::::__ANON__[:88]Test::Builder::__ANON__[:88]
11114µs14µsTest::Builder::::BEGIN@3Test::Builder::BEGIN@3
11112µs12µsTest::Builder::::BEGIN@1232Test::Builder::BEGIN@1232
11111µs29µsTest::Builder::::expected_testsTest::Builder::expected_tests
11111µs40µsTest::Builder::::current_testTest::Builder::current_test
1118µs9µsTest::Builder::::BEGIN@33Test::Builder::BEGIN@33
1118µs13µsTest::Builder::::_add_ts_hooksTest::Builder::_add_ts_hooks
1117µs13µsTest::Builder::::createTest::Builder::create
1117µs19µsTest::Builder::::BEGIN@1519Test::Builder::BEGIN@1519
8117µs7µsTest::Builder::::__ANON__[:154]Test::Builder::__ANON__[:154]
1116µs11µsTest::Builder::::BEGIN@1518Test::Builder::BEGIN@1518
1116µs10µsTest::Builder::::BEGIN@1251Test::Builder::BEGIN@1251
1116µs449µsTest::Builder::::__ANON__[:148]Test::Builder::__ANON__[:148]
1116µs6µsTest::Builder::::BEGIN@34Test::Builder::BEGIN@34
1116µs9µsTest::Builder::::BEGIN@1556Test::Builder::BEGIN@1556
1115µs21µsTest::Builder::::BEGIN@684Test::Builder::BEGIN@684
1115µs19µsTest::Builder::::BEGIN@1057Test::Builder::BEGIN@1057
1115µs9µsTest::Builder::::BEGIN@1539Test::Builder::BEGIN@1539
1115µs18µsTest::Builder::::BEGIN@797Test::Builder::BEGIN@797
1115µs9µsTest::Builder::::BEGIN@102Test::Builder::BEGIN@102
1115µs18µsTest::Builder::::BEGIN@1167Test::Builder::BEGIN@1167
1115µs8µsTest::Builder::::BEGIN@116Test::Builder::BEGIN@116
1115µs12µsTest::Builder::::BEGIN@20Test::Builder::BEGIN@20
1115µs9µsTest::Builder::::BEGIN@61Test::Builder::BEGIN@61
1114µs19µsTest::Builder::::BEGIN@120Test::Builder::BEGIN@120
1114µs14µsTest::Builder::::BEGIN@131Test::Builder::BEGIN@131
1114µs26µsTest::Builder::::BEGIN@693Test::Builder::BEGIN@693
1114µs5µsTest::Builder::::BEGIN@4Test::Builder::BEGIN@4
1114µs15µsTest::Builder::::INITTest::Builder::INIT
1114µs14µsTest::Builder::::BEGIN@103Test::Builder::BEGIN@103
1114µs14µsTest::Builder::::BEGIN@1540Test::Builder::BEGIN@1540
1114µs15µsTest::Builder::::BEGIN@62Test::Builder::BEGIN@62
1113µs13µsTest::Builder::::BEGIN@1557Test::Builder::BEGIN@1557
1113µs17µsTest::Builder::::BEGIN@133Test::Builder::BEGIN@133
1113µs23µsTest::Builder::::BEGIN@5Test::Builder::BEGIN@5
1113µs12µsTest::Builder::::BEGIN@117Test::Builder::BEGIN@117
1113µs10µsTest::Builder::::BEGIN@121Test::Builder::BEGIN@121
2222µs2µsTest::Builder::::exported_toTest::Builder::exported_to
1112µs2µsTest::Builder::::BEGIN@9Test::Builder::BEGIN@9
3311µs1µsTest::Builder::::__ANON__Test::Builder::__ANON__ (xsub)
1111µs1µsTest::Builder::::planTest::Builder::plan
0000s0sTest::Builder::::BAIL_OUTTest::Builder::BAIL_OUT
0000s0sTest::Builder::::__ANON__[:111]Test::Builder::__ANON__[:111]
0000s0sTest::Builder::::__ANON__[:1249]Test::Builder::__ANON__[:1249]
0000s0sTest::Builder::::__ANON__[:125]Test::Builder::__ANON__[:125]
0000s0sTest::Builder::::__ANON__[:1591]Test::Builder::__ANON__[:1591]
0000s0sTest::Builder::::__ANON__[:245]Test::Builder::__ANON__[:245]
0000s0sTest::Builder::::__ANON__[:247]Test::Builder::__ANON__[:247]
0000s0sTest::Builder::::__ANON__[:764]Test::Builder::__ANON__[:764]
0000s0sTest::Builder::::_autoflushTest::Builder::_autoflush
0000s0sTest::Builder::::_caller_contextTest::Builder::_caller_context
0000s0sTest::Builder::::_cmp_diagTest::Builder::_cmp_diag
0000s0sTest::Builder::::_diag_fhTest::Builder::_diag_fh
0000s0sTest::Builder::::_diag_fmtTest::Builder::_diag_fmt
0000s0sTest::Builder::::_is_diagTest::Builder::_is_diag
0000s0sTest::Builder::::_is_dualvarTest::Builder::_is_dualvar
0000s0sTest::Builder::::_is_qrTest::Builder::_is_qr
0000s0sTest::Builder::::_isnt_diagTest::Builder::_isnt_diag
0000s0sTest::Builder::::_new_fhTest::Builder::_new_fh
0000s0sTest::Builder::::_ok_debugTest::Builder::_ok_debug
0000s0sTest::Builder::::_plan_testsTest::Builder::_plan_tests
0000s0sTest::Builder::::_print_commentTest::Builder::_print_comment
0000s0sTest::Builder::::_regex_okTest::Builder::_regex_ok
0000s0sTest::Builder::::_tryTest::Builder::_try
0000s0sTest::Builder::::_unoverloadTest::Builder::_unoverload
0000s0sTest::Builder::::_unoverload_numTest::Builder::_unoverload_num
0000s0sTest::Builder::::_unoverload_strTest::Builder::_unoverload_str
0000s0sTest::Builder::::callerTest::Builder::caller
0000s0sTest::Builder::::carpTest::Builder::carp
0000s0sTest::Builder::::childTest::Builder::child
0000s0sTest::Builder::::cmp_okTest::Builder::cmp_ok
0000s0sTest::Builder::::coordinate_forksTest::Builder::coordinate_forks
0000s0sTest::Builder::::croakTest::Builder::croak
0000s0sTest::Builder::::detailsTest::Builder::details
0000s0sTest::Builder::::diagTest::Builder::diag
0000s0sTest::Builder::::explainTest::Builder::explain
0000s0sTest::Builder::::failure_outputTest::Builder::failure_output
0000s0sTest::Builder::::finalizeTest::Builder::finalize
0000s0sTest::Builder::::find_TODOTest::Builder::find_TODO
0000s0sTest::Builder::::has_planTest::Builder::has_plan
0000s0sTest::Builder::::in_todoTest::Builder::in_todo
0000s0sTest::Builder::::is_eqTest::Builder::is_eq
0000s0sTest::Builder::::is_fhTest::Builder::is_fh
0000s0sTest::Builder::::is_numTest::Builder::is_num
0000s0sTest::Builder::::is_passingTest::Builder::is_passing
0000s0sTest::Builder::::isnt_eqTest::Builder::isnt_eq
0000s0sTest::Builder::::isnt_numTest::Builder::isnt_num
0000s0sTest::Builder::::levelTest::Builder::level
0000s0sTest::Builder::::likeTest::Builder::like
0000s0sTest::Builder::::maybe_regexTest::Builder::maybe_regex
0000s0sTest::Builder::::nameTest::Builder::name
0000s0sTest::Builder::::no_endingTest::Builder::no_ending
0000s0sTest::Builder::::no_log_resultsTest::Builder::no_log_results
0000s0sTest::Builder::::no_planTest::Builder::no_plan
0000s0sTest::Builder::::noteTest::Builder::note
0000s0sTest::Builder::::outputTest::Builder::output
0000s0sTest::Builder::::parentTest::Builder::parent
0000s0sTest::Builder::::skipTest::Builder::skip
0000s0sTest::Builder::::skip_allTest::Builder::skip_all
0000s0sTest::Builder::::subtestTest::Builder::subtest
0000s0sTest::Builder::::summaryTest::Builder::summary
0000s0sTest::Builder::::todoTest::Builder::todo
0000s0sTest::Builder::::todo_endTest::Builder::todo_end
0000s0sTest::Builder::::todo_outputTest::Builder::todo_output
0000s0sTest::Builder::::todo_skipTest::Builder::todo_skip
0000s0sTest::Builder::::todo_startTest::Builder::todo_start
0000s0sTest::Builder::::unlikeTest::Builder::unlike
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Test::Builder;
2
3231µs114µ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
4213µs27µ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
5236µs242µ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
71400nsour $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 {
1012µs if( $] < 5.008 ) {
11 require Test::Builder::IO::Scalar;
12 }
13119µs12µs}
# spent 2µs making 1 call to Test::Builder::BEGIN@9
14
152101µs21.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
17288µs211.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
182112µs227.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 {
2111µs27µ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
2411µ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 }
31113µs112µs}
# spent 12µs making 1 call to Test::Builder::BEGIN@20
32
33218µs29µ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__
34215µs26µ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
36272µs22.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
372133µs2203µ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
391200nsour $Level = 1;
4013µs148µsour $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 {
431200ns my $self = shift;
44
451800ns1900ns 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.
501400ns 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 {
563800ns my ($active_hub, $e) = @_;
57
583800ns my $epkg = $$epkgr;
5932µs my $cpkg = $e->{trace} ? $e->{trace}->{frame}->[0] : undef;
60
61220µs212µ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
622130µs226µ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
633300ns my $todo;
6434µs $todo = ${"$cpkg\::TODO"} if $cpkg;
6532µs $todo = ${"$epkg\::TODO"} if $epkg && !$todo;
66
6734µ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
102220µs212µ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
103281µs225µ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
116219µs212µ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
117227µs222µ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__}}) {
120229µs234µ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
121261µs217µ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 },
12716µs14µs );
# spent 4µs making 1 call to Test2::Hub::pre_filter
128}
129
130{
131217µs225µ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 {
13321.68ms231µ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
13414µs211µ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
1381200ns
# 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 {
13951µs my($class) = shift;
14052µs unless($Test) {
14111µs113µ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 {
14512µs $Test->{Original_Pid} = $$ if !$Test->{Original_Pid} || $Test->{Original_Pid} == 0;
14611µs1430µs $Test->reset(singleton => 1);
# spent 430µs making 1 call to Test::Builder::reset
14714µs113µs $Test->_add_ts_hooks;
# spent 13µs making 1 call to Test::Builder::_add_ts_hooks
148 }
14912µs111µ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.
154912µs15µ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
15625µs248µ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
1581900ns13µ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 }
16057µ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 {
1641200ns my $class = shift;
1651700ns my %params = @_;
166
1671600ns my $self = bless {}, $class;
16813µs16µ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
18212µ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 {
18681µ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},
193826µs8400µs wrapped => 1,
# spent 400µs making 8 calls to Test2::API::context, avg 50µs/call
194 @_
195 );
196}
197
198sub 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
216sub 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
268sub 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");
307Looks like you planned $plan test$s but ran $count.
308FAIL
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");
317Looks like you failed $failed test$s of $count$qualifier.
318FAIL
319 }
320
321 if (!$passed && !$failed && $count && !$num_extra) {
322 $st_ctx->diag(<<"FAIL");
323All assertions inside the subtest passed, but errors were encountered.
324FAIL
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
350sub 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
425sub 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)
4321900ns my ($self, %params) = @_;
433
4341700ns1700ns 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.
4381200ns $Level = 1;
439
440 $self->{no_log_results} = $ENV{TEST_NO_LOG_RESULTS} ? 1 : 0
4411200ns unless $params{singleton};
442
44311µs12µs $self->{Original_Pid} = Test2::API::test2_in_preload() ? -1 : $$;
# spent 2µs making 1 call to Test2::API::test2_in_preload
444
44511µs1216µs my $ctx = $self->ctx;
# spent 216µs making 1 call to Test::Builder::ctx
4461900ns12µs my $hub = $ctx->hub;
4471800ns16µs $ctx->release;
# spent 6µs making 1 call to Test2::API::Context::release
4481200ns unless ($params{singleton}) {
449 $hub->reset_state();
450 $hub->_tb_reset();
451 }
452
45317µs232µ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
45512µs27µ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},
46312µs );
464
4651300ns $self->{Exported_To} = undef unless $params{singleton};
466
4671400ns $self->{Orig_Handles} ||= do {
46811µs21µ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]
4691100ns my $out;
47018µs21µ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 }
4731800ns $out ? [@$out] : [];
474 };
475
4761900ns148µs $self->use_numbers(1);
# spent 48µs making 1 call to Test::Builder::use_numbers
4771200ns $self->no_header(0) unless $params{singleton};
4781100ns $self->no_ending(0) unless $params{singleton};
4791800ns159µs $self->reset_outputs;
# spent 59µs making 1 call to Test::Builder::reset_outputs
480
48111µs15µs $ctx->release;
# spent 5µs making 1 call to Test2::API::Context::release
482
48314µs1500ns return;
# spent 500ns making 1 call to Test2::API::Context::DESTROY
484}
485
486
48711µsmy %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 {
4941300ns my( $self, $cmd, $arg ) = @_;
495
49611µ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
518sub _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 {
5391200ns my $self = shift;
5401300ns my($max) = @_;
541
5421900ns115µs my $ctx = $self->ctx;
# spent 15µs making 1 call to Test::Builder::ctx
543
5441300ns 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
5511800ns1400ns my $hub = $ctx->hub;
552
5531700ns12µs $ctx->release;
# spent 2µs making 1 call to Test2::API::Context::release
554
5551700ns1700ns my $plan = $hub->plan;
# spent 700ns making 1 call to Test2::Hub::plan
55613µs1400ns 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
562sub 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 {
5821400ns my($self, $num_tests) = @_;
583
58411µs130µs my $ctx = $self->ctx;
# spent 30µs making 1 call to Test::Builder::ctx
585
58614µs29µ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
5881600ns 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 }
59514µs23µ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
59712µs22µ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]
59812µs21µ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
60111µ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 {
60812µs140µs $num_tests = $self->current_test;
# spent 40µs making 1 call to Test::Builder::current_test
609 }
610
61112µs129µ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
61611µs2700ns $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
61813µs3186µ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
62016µs28µ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
624sub 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
637sub 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 {
6652700ns my( $self, $pack ) = @_;
666
6672600ns if( defined $pack ) {
668 $self->{Exported_To} = $pack;
669 }
67023µ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 {
6751500ns my( $self, $test, $name ) = @_;
676
67712µs166µ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.
6811500ns $test = $test ? 1 : 0;
682
683 # In case $name is a string overloaded object, force it to stringify.
684273µs236µ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
6851300ns $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
68911µ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
6932338µs247µ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
6951400ns my $trace = $ctx->{trace};
6961400ns my $hub = $ctx->{hub};
697
69813µs my $result = {
699 ok => $test,
700 actual_ok => $test,
701 reason => '',
702 type => '',
703 (name => defined($name) ? $name : ''),
704 };
705
70612µs $hub->{_meta}->{+__PACKAGE__}->{Test_Results}[ $hub->{count} ] = $result unless $self->{no_log_results};
707
7081300ns my $orig_name = $name;
709
7101200ns my @attrs;
7111400ns my $subevents = delete $self->{subevents};
7121400ns my $subtest_id = delete $self->{subtest_id};
7131300ns my $subtest_uuid = delete $self->{subtest_uuid};
7141300ns my $subtest_buffered = delete $self->{subtest_buffered};
7151300ns my $epkg = 'Test2::Event::Ok';
7161200ns 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
72119µ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;
72912µs1139µs $hub->send($e);
# spent 139µs making 1 call to Test2::Hub::send
730
7311400ns $self->_ok_debug($trace, $orig_name) unless($test);
732
73312µs19µs $ctx->release;
# spent 9µs making 1 call to Test2::API::Context::release
734112µs12µs return $test;
# spent 2µs making 1 call to Test2::API::Context::DESTROY
735}
736
737sub _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
754sub _diag_fh {
755 my $self = shift;
756 local $Level = $Level + 1;
757 return $self->in_todo ? $self->todo_output : $self->failure_output;
758}
759
760sub _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
773sub _unoverload_str {
774 my $self = shift;
775
776 $self->_unoverload( q[""], $_ ) for @_;
777}
778
779sub _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 $!
791sub _is_dualvar {
792 my( $self, $val ) = @_;
793
794 # Objects are not dualvars.
795 return 0 if ref $val;
796
7972796µs231µ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
803sub 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
824sub 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
843sub _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
864sub _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
873DIAGNOSTIC
874
875}
876
877sub _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
886DIAGNOSTIC
887}
888
889
890sub 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
908sub 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
927sub 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
936sub 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
94613µsmy %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" );
947
948# Bad, these are not comparison operators. Should we include more?
94913µsmy %cmp_ok_bl = map { ( $_, 1 ) } ( "=", "+=", ".=", "x=", "^=", "|=", "||=", "&&=", "...");
950
951sub 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[
974BEGIN {\${^WARNING_BITS} = $bits_code};
975#line $line "(eval in cmp_ok) $file"
976\$test = (\$got $type \$expect);
9771;
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;
992An error occurred while using $type:
993------------------------------------
994$error
995------------------------------------
996END
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
1019sub _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
1030DIAGNOSTIC
1031}
1032
1033sub _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
1045sub 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{
10573439µs232µ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
10581800ns *BAILOUT = \&BAIL_OUT;
1059}
1060
1061sub 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
1091sub 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
1113sub 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
1136sub _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
1145sub _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
11672250µs232µ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'
1186DIAGNOSTIC
1187
1188 }
1189
1190 return $ok;
1191}
1192
1193
1194sub 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
1207sub 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 {
12181200ns my( $self, $use_nums ) = @_;
1219
12201700ns123µs my $ctx = $self->ctx;
# spent 23µs making 1 call to Test::Builder::ctx
122111µs21µ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]
122215µs22µ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
12271800ns11µs $format->set_no_numbers(!$use_nums) if defined $use_nums;
1228
122914µs36µ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 {
123312µs for my $method (qw(no_header no_diag)) {
12342600ns 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;
124926µs };
1250
1251228µs214µ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
125223µs *$method = $code;
1253 }
12541735µs112µs}
# spent 12µs making 1 call to Test::Builder::BEGIN@1232
1255
1256sub 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
1266sub 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
1286sub 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
1306sub 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
1325sub 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
1339sub 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
1353sub 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
1367sub _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
1396sub _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 {
14071100ns my $self = shift;
1408
14091700ns117µs my $ctx = $self->ctx;
# spent 17µs making 1 call to Test::Builder::ctx
141011µs21µ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]
14111400ns12µs $ctx->release;
# spent 2µs making 1 call to Test2::API::Context::release
141212µs1400ns return unless $format && $format->isa('Test2::Formatter::TAP');
# spent 400ns making 1 call to UNIVERSAL::isa
141312µs1900ns $format->set_handles([@{$self->{Orig_Handles}}]) if $self->{Orig_Handles};
1414
141514µs19µs return;
# spent 9µs making 1 call to Test2::API::Context::DESTROY
1416}
1417
1418
1419sub carp {
1420 my $self = shift;
1421 my $ctx = $self->ctx;
1422 $ctx->alert(join "", @_);
1423 $ctx->release;
1424}
1425
1426sub 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 {
14351300ns my( $self, $num ) = @_;
1436
14371900ns121µs my $ctx = $self->ctx;
# spent 21µs making 1 call to Test::Builder::ctx
14381800ns1500ns my $hub = $ctx->hub;
1439
14401300ns 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 }
146416µs37µ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
1468sub 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
1484sub 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
1496sub 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
1508sub 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
1518227µs215µ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
1519292µs231µ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
1525sub 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
1539220µs213µ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
1540272µs225µ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
1544sub 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
1556221µs212µ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
15572662µs224µ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
1565sub 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
1600sub 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
1617sub 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
1628sub _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 {
16471200ns my $self = shift;
16481500ns my ($ctx, $real_exit_code, $new) = @_;
1649
16501300ns unless ($ctx) {
1651 my $octx = $self->ctx;
1652 $ctx = $octx->snapshot;
1653 $octx->release;
1654 }
1655
165611µs2900ns return if $ctx->hub->no_ending;
# spent 900ns making 2 calls to Test2::Util::HashBase::__ANON__[Test2/Util/HashBase.pm:84], avg 450ns/call
165713µs24µ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.
166111µs return unless $self->{Original_Pid} == $$;
1662
16631800ns1300ns my $hub = $ctx->hub;
166412µs11µs return if $hub->bailed_out;
1665
166611µs1900ns my $plan = $hub->plan;
# spent 900ns making 1 call to Test2::Hub::plan
16671900ns1500ns my $count = $hub->count;
166811µs1600ns my $failed = $hub->failed;
16691800ns15µs my $passed = $hub->is_passing;
# spent 5µs making 1 call to Test2::Hub::is_passing
16701400ns return unless $plan || $count || $failed;
1671
1672 # Ran tests but never declared a plan or hit done_testing
16731900ns1500ns 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");
1678Looks like your test exited with $real_exit_code just after $count.
1679FAIL
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
16951200ns 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
17011800ns return if $plan && "$plan" eq 'SKIP';
1702
17031200ns if (!$count) {
1704 $self->diag('No tests run!');
1705 $$new ||= 255;
1706 return;
1707 }
1708
17091200ns if ($real_exit_code) {
1710 $self->diag(<<"FAIL");
1711Looks like your test exited with $real_exit_code just after $count.
1712FAIL
1713 $$new ||= $real_exit_code;
1714 return;
1715 }
1716
17171400ns 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.
17231300ns my $num_extra = $count - $plan;
1724
17251300ns if ($num_extra != 0) {
1726 my $s = $plan == 1 ? '' : 's';
1727 $self->diag(<<"FAIL");
1728Looks like you planned $plan test$s but ran $count.
1729FAIL
1730 }
1731
17321300ns if ($failed) {
1733 my $s = $failed == 1 ? '' : 's';
1734
1735 my $qualifier = $num_extra == 0 ? '' : ' run';
1736
1737 $self->diag(<<"FAIL");
1738Looks like you failed $failed test$s of $count$qualifier.
1739FAIL
1740 }
1741
17421400ns if (!$passed && !$failed && $count && !$num_extra) {
1743 $ctx->diag(<<"FAIL");
1744All assertions passed, but errors were encountered.
1745FAIL
1746 }
1747
17481200ns my $exit_code = 0;
17491800ns 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
17591800ns $$new ||= $exit_code;
176012µs return;
1761}
1762
1763# Some things used this even though it was private... I am looking at you
1764# Test::Builder::Prefix...
1765sub _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.
1792sub 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
1807sub no_log_results { $_[0]->{no_log_results} = 1 }
1808
180916µs1;
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