Filename | /home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/Test2/API/Context.pm |
Statements | Executed 172 statements in 1.92ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
8 | 6 | 2 | 34µs | 34µs | release | Test2::API::Context::
1 | 1 | 1 | 30µs | 32µs | BEGIN@2 | Test2::API::Context::
2 | 1 | 1 | 20µs | 20µs | init | Test2::API::Context::
10 | 10 | 3 | 16µs | 16µs | DESTROY | Test2::API::Context::
1 | 1 | 1 | 15µs | 116µs | send_ev2 | Test2::API::Context::
1 | 1 | 1 | 5µs | 133µs | BEGIN@26 | Test2::API::Context::
1 | 1 | 1 | 5µs | 18µs | BEGIN@72 | Test2::API::Context::
1 | 1 | 1 | 5µs | 26µs | BEGIN@8 | Test2::API::Context::
1 | 1 | 1 | 5µs | 25µs | BEGIN@25 | Test2::API::Context::
1 | 1 | 1 | 4µs | 21µs | BEGIN@10 | Test2::API::Context::
1 | 1 | 1 | 4µs | 19µs | BEGIN@9 | Test2::API::Context::
1 | 1 | 1 | 4µs | 21µs | BEGIN@3 | Test2::API::Context::
1 | 1 | 1 | 2µs | 2µs | BEGIN@12 | Test2::API::Context::
1 | 1 | 1 | 1µs | 1µs | BEGIN@13 | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | __ANON__[:175] | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | __ANON__[:470] | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | _parse_event | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | alert | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | bail | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | build_ev2 | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | build_event | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | diag | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | do_in_context | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | done_testing | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | fail | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | fail_and_release | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | failure_diag | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | note | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | ok | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | pass | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | pass_and_release | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | plan | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | restore_error_vars | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | send_ev2_and_release | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | send_event | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | send_event_and_release | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | skip | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | snapshot | Test2::API::Context::
0 | 0 | 0 | 0s | 0s | throw | Test2::API::Context::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Test2::API::Context; | ||||
2 | 2 | 25µs | 2 | 34µ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 # spent 32µs making 1 call to Test2::API::Context::BEGIN@2
# spent 2µs making 1 call to strict::import |
3 | 2 | 27µs | 2 | 39µ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 # spent 21µs making 1 call to Test2::API::Context::BEGIN@3
# spent 17µs making 1 call to warnings::import |
4 | |||||
5 | 1 | 300ns | our $VERSION = '1.302198'; | ||
6 | |||||
7 | |||||
8 | 2 | 18µs | 2 | 46µ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 # spent 26µs making 1 call to Test2::API::Context::BEGIN@8
# spent 21µs making 1 call to Exporter::import |
9 | 2 | 22µs | 2 | 34µ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 # spent 19µs making 1 call to Test2::API::Context::BEGIN@9
# spent 15µs making 1 call to Exporter::import |
10 | 2 | 15µs | 2 | 38µ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 # spent 21µs making 1 call to Test2::API::Context::BEGIN@10
# spent 17µs making 1 call to Exporter::import |
11 | |||||
12 | 2 | 9µs | 1 | 2µ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 # spent 2µs making 1 call to Test2::API::Context::BEGIN@12 |
13 | 2 | 66µs | 1 | 1µ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 # spent 1µs making 1 call to Test2::API::Context::BEGIN@13 |
14 | |||||
15 | # Preload some key event types | ||||
16 | my %LOADED = ( | ||||
17 | map { | ||||
18 | 13 | 10µs | my $pkg = "Test2::Event::$_"; | ||
19 | 12 | 2µs | my $file = "Test2/Event/$_.pm"; | ||
20 | 12 | 174µs | require $file unless $INC{$file}; | ||
21 | 12 | 5µs | ( $pkg => $pkg, $_ => $pkg ) | ||
22 | } qw/Ok Diag Note Plan Bail Exception Waiting Skip Subtest Pass Fail V2/ | ||||
23 | ); | ||||
24 | |||||
25 | 2 | 21µs | 2 | 45µ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 # spent 25µs making 1 call to Test2::API::Context::BEGIN@25
# spent 20µs making 1 call to Exporter::import |
26 | 1 | 3µs | 1 | 128µ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 # 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 | ||||
29 | 1 | 188µs | 1 | 133µ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. | ||||
33 | 1 | 1µs | 1 | 6µs | my $ON_RELEASE = Test2::API::_context_release_callbacks_ref(); # spent 6µs making 1 call to Test2::API::_context_release_callbacks_ref |
34 | 1 | 500ns | 1 | 3µs | my $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 | ||||
37 | 2 | 300ns | my $self = shift; | ||
38 | |||||
39 | confess "The 'trace' attribute is required" | ||||
40 | 2 | 600ns | unless $self->{+TRACE}; | ||
41 | |||||
42 | confess "The 'hub' attribute is required" | ||||
43 | 2 | 600ns | unless $self->{+HUB}; | ||
44 | |||||
45 | 2 | 1µs | $self->{+_DEPTH} = 0 unless defined $self->{+_DEPTH}; | ||
46 | |||||
47 | 2 | 13µs | $self->{+ERRNO} = $! unless exists $self->{+ERRNO}; | ||
48 | 2 | 1µs | $self->{+EVAL_ERROR} = $@ unless exists $self->{+EVAL_ERROR}; | ||
49 | 2 | 4µs | $self->{+CHILD_ERROR} = $? unless exists $self->{+CHILD_ERROR}; | ||
50 | } | ||||
51 | |||||
52 | sub snapshot { bless {%{$_[0]}, _is_canon => undef, _is_spawn => undef, _aborted => undef}, __PACKAGE__ } | ||||
53 | |||||
54 | sub 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 | ||||
60 | 10 | 40µ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. | ||||
72 | 2 | 1.21ms | 2 | 31µ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 # 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"; | ||||
78 | A context appears to have been destroyed without first calling release(). | ||||
79 | Based on \$@ it does not look like an exception was thrown (this is not always | ||||
80 | a reliable test) | ||||
81 | |||||
82 | This is a problem because the global error variables (\$!, \$@, and \$?) will | ||||
83 | not be restored. In addition some release callbacks will not work properly from | ||||
84 | inside a DESTROY method. | ||||
85 | |||||
86 | Here are the context creation details, just in case a tool forgot to call | ||||
87 | release(): | ||||
88 | File: $frame->[1] | ||||
89 | Line: $frame->[2] | ||||
90 | Tool: $frame->[3] | ||||
91 | |||||
92 | Here is a trace to the code that caused the context to be destroyed, this could | ||||
93 | be an exit(), a goto, or simply the end of a scope: | ||||
94 | $mess | ||||
95 | |||||
96 | Cleaning 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 | ||||
121 | 8 | 2µs | my ($self) = @_; | ||
122 | |||||
123 | 8 | 1µ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 | ||||
126 | 8 | 12µs | if $self->{+_IS_SPAWN}; | ||
127 | |||||
128 | croak "release() should not be called on context that is neither canon nor a child" | ||||
129 | 4 | 700ns | unless $self->{+_IS_CANON}; | ||
130 | |||||
131 | 4 | 700ns | my $hub = $self->{+HUB}; | ||
132 | 4 | 1µs | my $hid = $hub->{hid}; | ||
133 | |||||
134 | croak "context thinks it is canon, but it is not" | ||||
135 | 4 | 3µs | unless $CONTEXTS->{$hid} && $CONTEXTS->{$hid} == $self; | ||
136 | |||||
137 | # Remove the key itself to avoid a slow memory leak | ||||
138 | 4 | 2µs | $self->{+_IS_CANON} = undef; | ||
139 | 4 | 2µs | delete $CONTEXTS->{$hid}; | ||
140 | |||||
141 | 4 | 1µs | if (my $cbk = $self->{+_ON_RELEASE}) { | ||
142 | $_->($self) for reverse @$cbk; | ||||
143 | } | ||||
144 | 4 | 1µs | if (my $hcbk = $hub->{_context_release}) { | ||
145 | $_->($self) for reverse @$hcbk; | ||||
146 | } | ||||
147 | 4 | 2µ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 | ||||
152 | 4 | 6µs | ($!, $@, $?) = @$self{+ERRNO, +EVAL_ERROR, +CHILD_ERROR}; | ||
153 | |||||
154 | 4 | 6µs | return; | ||
155 | } | ||||
156 | |||||
157 | sub 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 | |||||
190 | sub done_testing { | ||||
191 | my $self = shift; | ||||
192 | $self->hub->finalize($self->trace, 1); | ||||
193 | return; | ||||
194 | } | ||||
195 | |||||
196 | sub 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 | |||||
204 | sub alert { | ||||
205 | my ($self, $msg) = @_; | ||||
206 | $self->trace->alert($msg); | ||||
207 | } | ||||
208 | |||||
209 | sub 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 | ||||
217 | 1 | 200ns | my $self = shift; | ||
218 | |||||
219 | 1 | 500ns | my $e; | ||
220 | { | ||||
221 | 2 | 1µs | local $Carp::CarpLevel = $Carp::CarpLevel + 1; | ||
222 | $e = Test2::Event::V2->new( | ||||
223 | 1 | 6µs | 2 | 19µ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 | |||||
228 | 1 | 400ns | if ($self->{+_ABORTED}) { | ||
229 | my $f = $e->facet_data; | ||||
230 | ${$self->{+_ABORTED}}++ if $f->{control}->{halt} || defined($f->{control}->{terminate}) || defined($e->terminate); | ||||
231 | } | ||||
232 | 1 | 5µs | 1 | 82µs | $self->{+HUB}->send($e); # spent 82µs making 1 call to Test2::Hub::send |
233 | } | ||||
234 | |||||
235 | sub 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 | |||||
245 | sub send_event_and_release { | ||||
246 | my $self = shift; | ||||
247 | my $out = $self->send_event(@_); | ||||
248 | $self->release; | ||||
249 | return $out; | ||||
250 | } | ||||
251 | |||||
252 | sub 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 | |||||
275 | sub 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 | |||||
289 | sub 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 | |||||
305 | sub 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 | |||||
322 | sub 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 | |||||
347 | sub 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 | |||||
373 | sub 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 | |||||
398 | sub 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 | |||||
418 | sub 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 | |||||
430 | sub note { | ||||
431 | my $self = shift; | ||||
432 | my ($message) = @_; | ||||
433 | $self->send_event('Note', message => $message); | ||||
434 | } | ||||
435 | |||||
436 | sub 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 | |||||
446 | sub plan { | ||||
447 | my ($self, $max, $directive, $reason) = @_; | ||||
448 | $self->send_event('Plan', max => $max, directive => $directive, reason => $reason); | ||||
449 | } | ||||
450 | |||||
451 | sub bail { | ||||
452 | my ($self, $reason) = @_; | ||||
453 | $self->send_event('Bail', reason => $reason); | ||||
454 | } | ||||
455 | |||||
456 | sub _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 | |||||
485 | 1 | 5µs | 1; | ||
486 | |||||
487 | __END__ |