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 |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 5.39ms | 27.5ms | BEGIN@18 | Test::Builder::
1 | 1 | 1 | 1.33ms | 11.2ms | BEGIN@17 | Test::Builder::
1 | 1 | 1 | 1.17ms | 1.48ms | BEGIN@15 | Test::Builder::
1 | 1 | 1 | 343µs | 2.62ms | BEGIN@36 | Test::Builder::
1 | 1 | 1 | 164µs | 202µs | BEGIN@37 | Test::Builder::
1 | 1 | 1 | 47µs | 430µs | reset | Test::Builder::
1 | 1 | 1 | 45µs | 353µs | done_testing | Test::Builder::
1 | 1 | 1 | 40µs | 256µs | ok | Test::Builder::
1 | 1 | 1 | 29µs | 43µs | _ending | Test::Builder::
1 | 1 | 1 | 28µs | 59µs | reset_outputs | Test::Builder::
8 | 8 | 1 | 20µs | 419µs | ctx | Test::Builder::
5 | 2 | 2 | 16µs | 53µs | new | Test::Builder::
1 | 1 | 1 | 16µs | 48µs | use_numbers | Test::Builder::
1 | 1 | 1 | 15µs | 58µs | __ANON__[:156] | Test::Builder::
3 | 1 | 1 | 14µs | 14µs | __ANON__[:88] | Test::Builder::
1 | 1 | 1 | 14µs | 14µs | BEGIN@3 | Test::Builder::
1 | 1 | 1 | 12µs | 12µs | BEGIN@1232 | Test::Builder::
1 | 1 | 1 | 11µs | 29µs | expected_tests | Test::Builder::
1 | 1 | 1 | 11µs | 40µs | current_test | Test::Builder::
1 | 1 | 1 | 8µs | 9µs | BEGIN@33 | Test::Builder::
1 | 1 | 1 | 8µs | 13µs | _add_ts_hooks | Test::Builder::
1 | 1 | 1 | 7µs | 13µs | create | Test::Builder::
1 | 1 | 1 | 7µs | 19µs | BEGIN@1519 | Test::Builder::
8 | 1 | 1 | 7µs | 7µs | __ANON__[:154] | Test::Builder::
1 | 1 | 1 | 6µs | 11µs | BEGIN@1518 | Test::Builder::
1 | 1 | 1 | 6µs | 10µs | BEGIN@1251 | Test::Builder::
1 | 1 | 1 | 6µs | 449µs | __ANON__[:148] | Test::Builder::
1 | 1 | 1 | 6µs | 6µs | BEGIN@34 | Test::Builder::
1 | 1 | 1 | 6µs | 9µs | BEGIN@1556 | Test::Builder::
1 | 1 | 1 | 5µs | 21µs | BEGIN@684 | Test::Builder::
1 | 1 | 1 | 5µs | 19µs | BEGIN@1057 | Test::Builder::
1 | 1 | 1 | 5µs | 9µs | BEGIN@1539 | Test::Builder::
1 | 1 | 1 | 5µs | 18µs | BEGIN@797 | Test::Builder::
1 | 1 | 1 | 5µs | 9µs | BEGIN@102 | Test::Builder::
1 | 1 | 1 | 5µs | 18µs | BEGIN@1167 | Test::Builder::
1 | 1 | 1 | 5µs | 8µs | BEGIN@116 | Test::Builder::
1 | 1 | 1 | 5µs | 12µs | BEGIN@20 | Test::Builder::
1 | 1 | 1 | 5µs | 9µs | BEGIN@61 | Test::Builder::
1 | 1 | 1 | 4µs | 19µs | BEGIN@120 | Test::Builder::
1 | 1 | 1 | 4µs | 14µs | BEGIN@131 | Test::Builder::
1 | 1 | 1 | 4µs | 26µs | BEGIN@693 | Test::Builder::
1 | 1 | 1 | 4µs | 5µs | BEGIN@4 | Test::Builder::
1 | 1 | 1 | 4µs | 15µs | INIT | Test::Builder::
1 | 1 | 1 | 4µs | 14µs | BEGIN@103 | Test::Builder::
1 | 1 | 1 | 4µs | 14µs | BEGIN@1540 | Test::Builder::
1 | 1 | 1 | 4µs | 15µs | BEGIN@62 | Test::Builder::
1 | 1 | 1 | 3µs | 13µs | BEGIN@1557 | Test::Builder::
1 | 1 | 1 | 3µs | 17µs | BEGIN@133 | Test::Builder::
1 | 1 | 1 | 3µs | 23µs | BEGIN@5 | Test::Builder::
1 | 1 | 1 | 3µs | 12µs | BEGIN@117 | Test::Builder::
1 | 1 | 1 | 3µs | 10µs | BEGIN@121 | Test::Builder::
2 | 2 | 2 | 2µs | 2µs | exported_to | Test::Builder::
1 | 1 | 1 | 2µs | 2µs | BEGIN@9 | Test::Builder::
3 | 3 | 1 | 1µs | 1µs | __ANON__ (xsub) | Test::Builder::
1 | 1 | 1 | 1µs | 1µs | plan | Test::Builder::
0 | 0 | 0 | 0s | 0s | BAIL_OUT | Test::Builder::
0 | 0 | 0 | 0s | 0s | __ANON__[:111] | Test::Builder::
0 | 0 | 0 | 0s | 0s | __ANON__[:1249] | Test::Builder::
0 | 0 | 0 | 0s | 0s | __ANON__[:125] | Test::Builder::
0 | 0 | 0 | 0s | 0s | __ANON__[:1591] | Test::Builder::
0 | 0 | 0 | 0s | 0s | __ANON__[:245] | Test::Builder::
0 | 0 | 0 | 0s | 0s | __ANON__[:247] | Test::Builder::
0 | 0 | 0 | 0s | 0s | __ANON__[:764] | Test::Builder::
0 | 0 | 0 | 0s | 0s | _autoflush | Test::Builder::
0 | 0 | 0 | 0s | 0s | _caller_context | Test::Builder::
0 | 0 | 0 | 0s | 0s | _cmp_diag | Test::Builder::
0 | 0 | 0 | 0s | 0s | _diag_fh | Test::Builder::
0 | 0 | 0 | 0s | 0s | _diag_fmt | Test::Builder::
0 | 0 | 0 | 0s | 0s | _is_diag | Test::Builder::
0 | 0 | 0 | 0s | 0s | _is_dualvar | Test::Builder::
0 | 0 | 0 | 0s | 0s | _is_qr | Test::Builder::
0 | 0 | 0 | 0s | 0s | _isnt_diag | Test::Builder::
0 | 0 | 0 | 0s | 0s | _new_fh | Test::Builder::
0 | 0 | 0 | 0s | 0s | _ok_debug | Test::Builder::
0 | 0 | 0 | 0s | 0s | _plan_tests | Test::Builder::
0 | 0 | 0 | 0s | 0s | _print_comment | Test::Builder::
0 | 0 | 0 | 0s | 0s | _regex_ok | Test::Builder::
0 | 0 | 0 | 0s | 0s | _try | Test::Builder::
0 | 0 | 0 | 0s | 0s | _unoverload | Test::Builder::
0 | 0 | 0 | 0s | 0s | _unoverload_num | Test::Builder::
0 | 0 | 0 | 0s | 0s | _unoverload_str | Test::Builder::
0 | 0 | 0 | 0s | 0s | caller | Test::Builder::
0 | 0 | 0 | 0s | 0s | carp | Test::Builder::
0 | 0 | 0 | 0s | 0s | child | Test::Builder::
0 | 0 | 0 | 0s | 0s | cmp_ok | Test::Builder::
0 | 0 | 0 | 0s | 0s | coordinate_forks | Test::Builder::
0 | 0 | 0 | 0s | 0s | croak | Test::Builder::
0 | 0 | 0 | 0s | 0s | details | Test::Builder::
0 | 0 | 0 | 0s | 0s | diag | Test::Builder::
0 | 0 | 0 | 0s | 0s | explain | Test::Builder::
0 | 0 | 0 | 0s | 0s | failure_output | Test::Builder::
0 | 0 | 0 | 0s | 0s | finalize | Test::Builder::
0 | 0 | 0 | 0s | 0s | find_TODO | Test::Builder::
0 | 0 | 0 | 0s | 0s | has_plan | Test::Builder::
0 | 0 | 0 | 0s | 0s | in_todo | Test::Builder::
0 | 0 | 0 | 0s | 0s | is_eq | Test::Builder::
0 | 0 | 0 | 0s | 0s | is_fh | Test::Builder::
0 | 0 | 0 | 0s | 0s | is_num | Test::Builder::
0 | 0 | 0 | 0s | 0s | is_passing | Test::Builder::
0 | 0 | 0 | 0s | 0s | isnt_eq | Test::Builder::
0 | 0 | 0 | 0s | 0s | isnt_num | Test::Builder::
0 | 0 | 0 | 0s | 0s | level | Test::Builder::
0 | 0 | 0 | 0s | 0s | like | Test::Builder::
0 | 0 | 0 | 0s | 0s | maybe_regex | Test::Builder::
0 | 0 | 0 | 0s | 0s | name | Test::Builder::
0 | 0 | 0 | 0s | 0s | no_ending | Test::Builder::
0 | 0 | 0 | 0s | 0s | no_log_results | Test::Builder::
0 | 0 | 0 | 0s | 0s | no_plan | Test::Builder::
0 | 0 | 0 | 0s | 0s | note | Test::Builder::
0 | 0 | 0 | 0s | 0s | output | Test::Builder::
0 | 0 | 0 | 0s | 0s | parent | Test::Builder::
0 | 0 | 0 | 0s | 0s | skip | Test::Builder::
0 | 0 | 0 | 0s | 0s | skip_all | Test::Builder::
0 | 0 | 0 | 0s | 0s | subtest | Test::Builder::
0 | 0 | 0 | 0s | 0s | summary | Test::Builder::
0 | 0 | 0 | 0s | 0s | todo | Test::Builder::
0 | 0 | 0 | 0s | 0s | todo_end | Test::Builder::
0 | 0 | 0 | 0s | 0s | todo_output | Test::Builder::
0 | 0 | 0 | 0s | 0s | todo_skip | Test::Builder::
0 | 0 | 0 | 0s | 0s | todo_start | Test::Builder::
0 | 0 | 0 | 0s | 0s | unlike | Test::Builder::
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 # 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 # 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 # 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 | ||||
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 # 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 # 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 # 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 | ||||
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 # 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 # 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 # 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 # 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 | ||||
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 | ||||
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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 # 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 | ||||
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 # 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 | ||
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 | ||||
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 # 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 # 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 | ||||
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 | ||||
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 | ||||
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 | ||||
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 | ||||
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 | ||||
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 | ||||
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 | ||||
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 # 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 # 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 # 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 # 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 # 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 | ||||
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 | ||||
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 # 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 | ||||
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 | ||||
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 # 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 # 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 # 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 # 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 # 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 # 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 | ||||
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__ | ||||
sub Test::Builder::__ANON__; # xsub |