← 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:23 2024

Filename/home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test2/API/Context.pm
StatementsExecuted 172 statements in 1.92ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
86234µs34µsTest2::API::Context::::releaseTest2::API::Context::release
11130µs32µsTest2::API::Context::::BEGIN@2Test2::API::Context::BEGIN@2
21120µs20µsTest2::API::Context::::initTest2::API::Context::init
1010316µs16µsTest2::API::Context::::DESTROYTest2::API::Context::DESTROY
11115µs116µsTest2::API::Context::::send_ev2Test2::API::Context::send_ev2
1115µs133µsTest2::API::Context::::BEGIN@26Test2::API::Context::BEGIN@26
1115µs18µsTest2::API::Context::::BEGIN@72Test2::API::Context::BEGIN@72
1115µs26µsTest2::API::Context::::BEGIN@8Test2::API::Context::BEGIN@8
1115µs25µsTest2::API::Context::::BEGIN@25Test2::API::Context::BEGIN@25
1114µs21µsTest2::API::Context::::BEGIN@10Test2::API::Context::BEGIN@10
1114µs19µsTest2::API::Context::::BEGIN@9Test2::API::Context::BEGIN@9
1114µs21µsTest2::API::Context::::BEGIN@3Test2::API::Context::BEGIN@3
1112µs2µsTest2::API::Context::::BEGIN@12Test2::API::Context::BEGIN@12
1111µs1µsTest2::API::Context::::BEGIN@13Test2::API::Context::BEGIN@13
0000s0sTest2::API::Context::::__ANON__[:175]Test2::API::Context::__ANON__[:175]
0000s0sTest2::API::Context::::__ANON__[:470]Test2::API::Context::__ANON__[:470]
0000s0sTest2::API::Context::::_parse_eventTest2::API::Context::_parse_event
0000s0sTest2::API::Context::::alertTest2::API::Context::alert
0000s0sTest2::API::Context::::bailTest2::API::Context::bail
0000s0sTest2::API::Context::::build_ev2Test2::API::Context::build_ev2
0000s0sTest2::API::Context::::build_eventTest2::API::Context::build_event
0000s0sTest2::API::Context::::diagTest2::API::Context::diag
0000s0sTest2::API::Context::::do_in_contextTest2::API::Context::do_in_context
0000s0sTest2::API::Context::::done_testingTest2::API::Context::done_testing
0000s0sTest2::API::Context::::failTest2::API::Context::fail
0000s0sTest2::API::Context::::fail_and_releaseTest2::API::Context::fail_and_release
0000s0sTest2::API::Context::::failure_diagTest2::API::Context::failure_diag
0000s0sTest2::API::Context::::noteTest2::API::Context::note
0000s0sTest2::API::Context::::okTest2::API::Context::ok
0000s0sTest2::API::Context::::passTest2::API::Context::pass
0000s0sTest2::API::Context::::pass_and_releaseTest2::API::Context::pass_and_release
0000s0sTest2::API::Context::::planTest2::API::Context::plan
0000s0sTest2::API::Context::::restore_error_varsTest2::API::Context::restore_error_vars
0000s0sTest2::API::Context::::send_ev2_and_releaseTest2::API::Context::send_ev2_and_release
0000s0sTest2::API::Context::::send_eventTest2::API::Context::send_event
0000s0sTest2::API::Context::::send_event_and_releaseTest2::API::Context::send_event_and_release
0000s0sTest2::API::Context::::skipTest2::API::Context::skip
0000s0sTest2::API::Context::::snapshotTest2::API::Context::snapshot
0000s0sTest2::API::Context::::throwTest2::API::Context::throw
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Test2::API::Context;
2225µs234µs
# spent 32µs (30+2) within Test2::API::Context::BEGIN@2 which was called: # once (30µs+2µs) by Test::Builder::BEGIN@18 at line 2
use strict;
# spent 32µs making 1 call to Test2::API::Context::BEGIN@2 # spent 2µs making 1 call to strict::import
3227µs239µs
# spent 21µs (4+17) within Test2::API::Context::BEGIN@3 which was called: # once (4µs+17µs) by Test::Builder::BEGIN@18 at line 3
use warnings;
# spent 21µs making 1 call to Test2::API::Context::BEGIN@3 # spent 17µs making 1 call to warnings::import
4
51300nsour $VERSION = '1.302198';
6
7
8218µs246µs
# spent 26µs (5+21) within Test2::API::Context::BEGIN@8 which was called: # once (5µs+21µs) by Test::Builder::BEGIN@18 at line 8
use Carp qw/confess croak/;
# spent 26µs making 1 call to Test2::API::Context::BEGIN@8 # spent 21µs making 1 call to Exporter::import
9222µs234µs
# spent 19µs (4+15) within Test2::API::Context::BEGIN@9 which was called: # once (4µs+15µs) by Test::Builder::BEGIN@18 at line 9
use Scalar::Util qw/weaken blessed/;
# spent 19µs making 1 call to Test2::API::Context::BEGIN@9 # spent 15µs making 1 call to Exporter::import
10215µs238µs
# spent 21µs (4+17) within Test2::API::Context::BEGIN@10 which was called: # once (4µs+17µs) by Test::Builder::BEGIN@18 at line 10
use Test2::Util qw/get_tid try pkg_to_file get_tid/;
# spent 21µs making 1 call to Test2::API::Context::BEGIN@10 # spent 17µs making 1 call to Exporter::import
11
1229µs12µs
# spent 2µs within Test2::API::Context::BEGIN@12 which was called: # once (2µs+0s) by Test::Builder::BEGIN@18 at line 12
use Test2::EventFacet::Trace();
# spent 2µs making 1 call to Test2::API::Context::BEGIN@12
13266µs11µs
# spent 1µs within Test2::API::Context::BEGIN@13 which was called: # once (1µs+0s) by Test::Builder::BEGIN@18 at line 13
use Test2::API();
# spent 1µs making 1 call to Test2::API::Context::BEGIN@13
14
15# Preload some key event types
16my %LOADED = (
17 map {
181310µs my $pkg = "Test2::Event::$_";
19122µs my $file = "Test2/Event/$_.pm";
2012174µs require $file unless $INC{$file};
21125µs ( $pkg => $pkg, $_ => $pkg )
22 } qw/Ok Diag Note Plan Bail Exception Waiting Skip Subtest Pass Fail V2/
23);
24
25221µs245µs
# spent 25µs (5+20) within Test2::API::Context::BEGIN@25 which was called: # once (5µs+20µs) by Test::Builder::BEGIN@18 at line 25
use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/;
# spent 25µs making 1 call to Test2::API::Context::BEGIN@25 # spent 20µs making 1 call to Exporter::import
2613µs1128µs
# spent 133µs (5+128) within Test2::API::Context::BEGIN@26 which was called: # once (5µs+128µs) by Test::Builder::BEGIN@18 at line 29
use Test2::Util::HashBase qw{
# spent 128µs making 1 call to Test2::Util::HashBase::import
27 stack hub trace _on_release _depth _is_canon _is_spawn _aborted
28 errno eval_error child_error thrown
291188µs1133µs};
# spent 133µs making 1 call to Test2::API::Context::BEGIN@26
30
31# Private, not package vars
32# It is safe to cache these.
3311µs16µsmy $ON_RELEASE = Test2::API::_context_release_callbacks_ref();
# spent 6µs making 1 call to Test2::API::_context_release_callbacks_ref
341500ns13µsmy $CONTEXTS = Test2::API::_contexts_ref();
# spent 3µs making 1 call to Test2::API::_contexts_ref
35
36
# spent 20µs within Test2::API::Context::init which was called 2 times, avg 10µs/call: # 2 times (20µs+0s) by Test2::Util::HashBase::_new at line 155 of Test2/Util/HashBase.pm, avg 10µs/call
sub init {
372300ns my $self = shift;
38
39 confess "The 'trace' attribute is required"
402600ns unless $self->{+TRACE};
41
42 confess "The 'hub' attribute is required"
432600ns unless $self->{+HUB};
44
4521µs $self->{+_DEPTH} = 0 unless defined $self->{+_DEPTH};
46
47213µs $self->{+ERRNO} = $! unless exists $self->{+ERRNO};
4821µs $self->{+EVAL_ERROR} = $@ unless exists $self->{+EVAL_ERROR};
4924µs $self->{+CHILD_ERROR} = $? unless exists $self->{+CHILD_ERROR};
50}
51
52sub snapshot { bless {%{$_[0]}, _is_canon => undef, _is_spawn => undef, _aborted => undef}, __PACKAGE__ }
53
54sub restore_error_vars {
55 my $self = shift;
56 ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR};
57}
58
59
# spent 16µs within Test2::API::Context::DESTROY which was called 10 times, avg 2µs/call: # once (9µs+0s) by Test::Builder::reset_outputs at line 1415 of Test/Builder.pm # once (2µs+0s) by Test::Builder::ok at line 734 of Test/Builder.pm # once (700ns+0s) by Test2::API::test2_set_is_end at line 48 of Test2/API.pm # once (700ns+0s) by Test::Builder::done_testing at line 620 of Test/Builder.pm # once (700ns+0s) by Test::Builder::current_test at line 1464 of Test/Builder.pm # once (700ns+0s) by Test::Builder::reset at line 453 of Test/Builder.pm # once (600ns+0s) by Test::Builder::use_numbers at line 1229 of Test/Builder.pm # once (600ns+0s) by Test2::API::Instance::set_exit at line 551 of Test2/API/Instance.pm # once (500ns+0s) by Test::Builder::reset at line 483 of Test/Builder.pm # once (400ns+0s) by Test::Builder::expected_tests at line 556 of Test/Builder.pm
sub DESTROY {
601040µs return unless $_[0]->{+_IS_CANON} || $_[0]->{+_IS_SPAWN};
61 return if $_[0]->{+_ABORTED} && ${$_[0]->{+_ABORTED}};
62 my ($self) = @_;
63
64 my $hub = $self->{+HUB};
65 my $hid = $hub->{hid};
66
67 # Do not show the warning if it looks like an exception has been thrown, or
68 # if the context is not local to this process or thread.
69 {
70 # Sometimes $@ is uninitialized, not a problem in this case so do not
71 # show the warning about using eq.
7221.21ms231µs
# spent 18µs (5+13) within Test2::API::Context::BEGIN@72 which was called: # once (5µs+13µs) by Test::Builder::BEGIN@18 at line 72
no warnings 'uninitialized';
# spent 18µs making 1 call to Test2::API::Context::BEGIN@72 # spent 13µs making 1 call to warnings::unimport
73 if($self->{+EVAL_ERROR} eq $@ && $hub->is_local) {
74 require Carp;
75 my $mess = Carp::longmess("Context destroyed");
76 my $frame = $self->{+_IS_SPAWN} || $self->{+TRACE}->frame;
77 warn <<" EOT";
78A context appears to have been destroyed without first calling release().
79Based on \$@ it does not look like an exception was thrown (this is not always
80a reliable test)
81
82This is a problem because the global error variables (\$!, \$@, and \$?) will
83not be restored. In addition some release callbacks will not work properly from
84inside a DESTROY method.
85
86Here are the context creation details, just in case a tool forgot to call
87release():
88 File: $frame->[1]
89 Line: $frame->[2]
90 Tool: $frame->[3]
91
92Here is a trace to the code that caused the context to be destroyed, this could
93be an exit(), a goto, or simply the end of a scope:
94$mess
95
96Cleaning up the CONTEXT stack...
97 EOT
98 }
99 }
100
101 return if $self->{+_IS_SPAWN};
102
103 # Remove the key itself to avoid a slow memory leak
104 delete $CONTEXTS->{$hid};
105 $self->{+_IS_CANON} = undef;
106
107 if (my $cbk = $self->{+_ON_RELEASE}) {
108 $_->($self) for reverse @$cbk;
109 }
110 if (my $hcbk = $hub->{_context_release}) {
111 $_->($self) for reverse @$hcbk;
112 }
113 $_->($self) for reverse @$ON_RELEASE;
114}
115
116# release exists to implement behaviors like die-on-fail. In die-on-fail you
117# want to die after a failure, but only after diagnostics have been reported.
118# The ideal time for the die to happen is when the context is released.
119# Unfortunately die does not work in a DESTROY block.
120
# spent 34µs within Test2::API::Context::release which was called 8 times, avg 4µs/call: # 3 times (10µs+0s) by Test2::API::release at line 570 of Test2/API.pm, avg 3µs/call # once (9µs+0s) by Test::Builder::ok at line 733 of Test/Builder.pm # once (6µs+0s) by Test::Builder::reset at line 447 of Test/Builder.pm # once (5µs+0s) by Test::Builder::reset at line 481 of Test/Builder.pm # once (2µs+0s) by Test::Builder::expected_tests at line 553 of Test/Builder.pm # once (2µs+0s) by Test::Builder::reset_outputs at line 1411 of Test/Builder.pm
sub release {
12182µs my ($self) = @_;
122
12381µs ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} and return if $self->{+THROWN};
124
125 ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} and return $self->{+_IS_SPAWN} = undef
126812µs if $self->{+_IS_SPAWN};
127
128 croak "release() should not be called on context that is neither canon nor a child"
1294700ns unless $self->{+_IS_CANON};
130
1314700ns my $hub = $self->{+HUB};
13241µs my $hid = $hub->{hid};
133
134 croak "context thinks it is canon, but it is not"
13543µs unless $CONTEXTS->{$hid} && $CONTEXTS->{$hid} == $self;
136
137 # Remove the key itself to avoid a slow memory leak
13842µs $self->{+_IS_CANON} = undef;
13942µs delete $CONTEXTS->{$hid};
140
14141µs if (my $cbk = $self->{+_ON_RELEASE}) {
142 $_->($self) for reverse @$cbk;
143 }
14441µs if (my $hcbk = $hub->{_context_release}) {
145 $_->($self) for reverse @$hcbk;
146 }
14742µs $_->($self) for reverse @$ON_RELEASE;
148
149 # Do this last so that nothing else changes them.
150 # If one of the hooks dies then these do not get restored, this is
151 # intentional
15246µs ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR};
153
15446µs return;
155}
156
157sub do_in_context {
158 my $self = shift;
159 my ($sub, @args) = @_;
160
161 # We need to update the pid/tid and error vars.
162 my $clone = $self->snapshot;
163 @$clone{+ERRNO, +EVAL_ERROR, +CHILD_ERROR} = ($!, $@, $?);
164 $clone->{+TRACE} = $clone->{+TRACE}->snapshot(pid => $$, tid => get_tid());
165
166 my $hub = $clone->{+HUB};
167 my $hid = $hub->hid;
168
169 my $old = $CONTEXTS->{$hid};
170
171 $clone->{+_IS_CANON} = 1;
172 $CONTEXTS->{$hid} = $clone;
173 weaken($CONTEXTS->{$hid});
174 my ($ok, $err) = &try($sub, @args);
175 my ($rok, $rerr) = try { $clone->release };
176 delete $clone->{+_IS_CANON};
177
178 if ($old) {
179 $CONTEXTS->{$hid} = $old;
180 weaken($CONTEXTS->{$hid});
181 }
182 else {
183 delete $CONTEXTS->{$hid};
184 }
185
186 die $err unless $ok;
187 die $rerr unless $rok;
188}
189
190sub done_testing {
191 my $self = shift;
192 $self->hub->finalize($self->trace, 1);
193 return;
194}
195
196sub throw {
197 my ($self, $msg) = @_;
198 $self->{+THROWN} = 1;
199 ${$self->{+_ABORTED}}++ if $self->{+_ABORTED};
200 $self->release if $self->{+_IS_CANON} || $self->{+_IS_SPAWN};
201 $self->trace->throw($msg);
202}
203
204sub alert {
205 my ($self, $msg) = @_;
206 $self->trace->alert($msg);
207}
208
209sub send_ev2_and_release {
210 my $self = shift;
211 my $out = $self->send_ev2(@_);
212 $self->release;
213 return $out;
214}
215
216
# spent 116µs (15+101) within Test2::API::Context::send_ev2 which was called: # once (15µs+101µs) by Test2::API::test2_set_is_end at line 46 of Test2/API.pm
sub send_ev2 {
2171200ns my $self = shift;
218
2191500ns my $e;
220 {
22121µs local $Carp::CarpLevel = $Carp::CarpLevel + 1;
222 $e = Test2::Event::V2->new(
22316µs219µs trace => $self->{+TRACE}->snapshot,
# spent 16µs making 1 call to Test2::Util::HashBase::_new # spent 3µs making 1 call to Test2::EventFacet::Trace::snapshot
224 @_,
225 );
226 }
227
2281400ns if ($self->{+_ABORTED}) {
229 my $f = $e->facet_data;
230 ${$self->{+_ABORTED}}++ if $f->{control}->{halt} || defined($f->{control}->{terminate}) || defined($e->terminate);
231 }
23215µs182µs $self->{+HUB}->send($e);
# spent 82µs making 1 call to Test2::Hub::send
233}
234
235sub build_ev2 {
236 my $self = shift;
237
238 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
239 Test2::Event::V2->new(
240 trace => $self->{+TRACE}->snapshot,
241 @_,
242 );
243}
244
245sub send_event_and_release {
246 my $self = shift;
247 my $out = $self->send_event(@_);
248 $self->release;
249 return $out;
250}
251
252sub send_event {
253 my $self = shift;
254 my $event = shift;
255 my %args = @_;
256
257 my $pkg = $LOADED{$event} || $self->_parse_event($event);
258
259 my $e;
260 {
261 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
262 $e = $pkg->new(
263 trace => $self->{+TRACE}->snapshot,
264 %args,
265 );
266 }
267
268 if ($self->{+_ABORTED}) {
269 my $f = $e->facet_data;
270 ${$self->{+_ABORTED}}++ if $f->{control}->{halt} || defined($f->{control}->{terminate}) || defined($e->terminate);
271 }
272 $self->{+HUB}->send($e);
273}
274
275sub build_event {
276 my $self = shift;
277 my $event = shift;
278 my %args = @_;
279
280 my $pkg = $LOADED{$event} || $self->_parse_event($event);
281
282 local $Carp::CarpLevel = $Carp::CarpLevel + 1;
283 $pkg->new(
284 trace => $self->{+TRACE}->snapshot,
285 %args,
286 );
287}
288
289sub pass {
290 my $self = shift;
291 my ($name) = @_;
292
293 my $e = bless(
294 {
295 trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
296 name => $name,
297 },
298 "Test2::Event::Pass"
299 );
300
301 $self->{+HUB}->send($e);
302 return $e;
303}
304
305sub pass_and_release {
306 my $self = shift;
307 my ($name) = @_;
308
309 my $e = bless(
310 {
311 trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
312 name => $name,
313 },
314 "Test2::Event::Pass"
315 );
316
317 $self->{+HUB}->send($e);
318 $self->release;
319 return 1;
320}
321
322sub fail {
323 my $self = shift;
324 my ($name, @diag) = @_;
325
326 my $e = bless(
327 {
328 trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
329 name => $name,
330 },
331 "Test2::Event::Fail"
332 );
333
334 for my $msg (@diag) {
335 if (ref($msg) eq 'Test2::EventFacet::Info::Table') {
336 $e->add_info({tag => 'DIAG', debug => 1, $msg->info_args});
337 }
338 else {
339 $e->add_info({tag => 'DIAG', debug => 1, details => $msg});
340 }
341 }
342
343 $self->{+HUB}->send($e);
344 return $e;
345}
346
347sub fail_and_release {
348 my $self = shift;
349 my ($name, @diag) = @_;
350
351 my $e = bless(
352 {
353 trace => bless({%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
354 name => $name,
355 },
356 "Test2::Event::Fail"
357 );
358
359 for my $msg (@diag) {
360 if (ref($msg) eq 'Test2::EventFacet::Info::Table') {
361 $e->add_info({tag => 'DIAG', debug => 1, $msg->info_args});
362 }
363 else {
364 $e->add_info({tag => 'DIAG', debug => 1, details => $msg});
365 }
366 }
367
368 $self->{+HUB}->send($e);
369 $self->release;
370 return 0;
371}
372
373sub ok {
374 my $self = shift;
375 my ($pass, $name, $on_fail) = @_;
376
377 my $hub = $self->{+HUB};
378
379 my $e = bless {
380 trace => bless( {%{$self->{+TRACE}}}, 'Test2::EventFacet::Trace'),
381 pass => $pass,
382 name => $name,
383 }, 'Test2::Event::Ok';
384 $e->init;
385
386 $hub->send($e);
387 return $e if $pass;
388
389 $self->failure_diag($e);
390
391 if ($on_fail && @$on_fail) {
392 $self->diag($_) for @$on_fail;
393 }
394
395 return $e;
396}
397
398sub failure_diag {
399 my $self = shift;
400 my ($e) = @_;
401
402 # Figure out the debug info, this is typically the file name and line
403 # number, but can also be a custom message. If no trace object is provided
404 # then we have nothing useful to display.
405 my $name = $e->name;
406 my $trace = $e->trace;
407 my $debug = $trace ? $trace->debug : "[No trace info available]";
408
409 # Create the initial diagnostics. If the test has a name we put the debug
410 # info on a second line, this behavior is inherited from Test::Builder.
411 my $msg = defined($name)
412 ? qq[Failed test '$name'\n$debug.\n]
413 : qq[Failed test $debug.\n];
414
415 $self->diag($msg);
416}
417
418sub skip {
419 my $self = shift;
420 my ($name, $reason, @extra) = @_;
421 $self->send_event(
422 'Skip',
423 name => $name,
424 reason => $reason,
425 pass => 1,
426 @extra,
427 );
428}
429
430sub note {
431 my $self = shift;
432 my ($message) = @_;
433 $self->send_event('Note', message => $message);
434}
435
436sub diag {
437 my $self = shift;
438 my ($message) = @_;
439 my $hub = $self->{+HUB};
440 $self->send_event(
441 'Diag',
442 message => $message,
443 );
444}
445
446sub plan {
447 my ($self, $max, $directive, $reason) = @_;
448 $self->send_event('Plan', max => $max, directive => $directive, reason => $reason);
449}
450
451sub bail {
452 my ($self, $reason) = @_;
453 $self->send_event('Bail', reason => $reason);
454}
455
456sub _parse_event {
457 my $self = shift;
458 my $event = shift;
459
460 my $pkg;
461 if ($event =~ m/^\+(.*)/) {
462 $pkg = $1;
463 }
464 else {
465 $pkg = "Test2::Event::$event";
466 }
467
468 unless ($LOADED{$pkg}) {
469 my $file = pkg_to_file($pkg);
470 my ($ok, $err) = try { require $file };
471 $self->throw("Could not load event module '$pkg': $err")
472 unless $ok;
473
474 $LOADED{$pkg} = $pkg;
475 }
476
477 confess "'$pkg' is not a subclass of 'Test2::Event'"
478 unless $pkg->isa('Test2::Event');
479
480 $LOADED{$event} = $pkg;
481
482 return $pkg;
483}
484
48515µs1;
486
487__END__