Commit | Line | Data |
---|---|---|
b4514920 CG |
1 | package Test2::API; |
2 | use strict; | |
3 | use warnings; | |
4 | ||
f70b3f77 | 5 | use Time::HiRes qw/time/; |
07bc328a SH |
6 | use Test2::Util qw/USE_THREADS/; |
7 | ||
fa951d2c CBW |
8 | BEGIN { |
9 | $ENV{TEST_ACTIVE} ||= 1; | |
10 | $ENV{TEST2_ACTIVE} = 1; | |
11 | } | |
12 | ||
cf76a266 | 13 | our $VERSION = '1.302198'; |
b4514920 CG |
14 | |
15 | ||
16 | my $INST; | |
17 | my $ENDING = 0; | |
ab7a3d99 | 18 | sub test2_unset_is_end { $ENDING = 0 } |
b4514920 CG |
19 | sub test2_get_is_end { $ENDING } |
20 | ||
ab7a3d99 CG |
21 | sub test2_set_is_end { |
22 | my $before = $ENDING; | |
23 | ($ENDING) = @_ ? @_ : (1); | |
24 | ||
25 | # Only send the event in a transition from false to true | |
26 | return if $before; | |
27 | return unless $ENDING; | |
28 | ||
29 | return unless $INST; | |
30 | my $stack = $INST->stack or return; | |
31 | my $root = $stack->root or return; | |
32 | ||
62fc0889 CG |
33 | return unless $root->count; |
34 | ||
ab7a3d99 CG |
35 | return unless $$ == $INST->pid; |
36 | return unless get_tid() == $INST->tid; | |
37 | ||
38 | my $trace = Test2::EventFacet::Trace->new( | |
39 | frame => [__PACKAGE__, __FILE__, __LINE__, __PACKAGE__ . '::test2_set_is_end'], | |
40 | ); | |
41 | my $ctx = Test2::API::Context->new( | |
42 | trace => $trace, | |
43 | hub => $root, | |
44 | ); | |
45 | ||
46 | $ctx->send_ev2(control => { phase => 'END', details => 'Transition to END phase' }); | |
47 | ||
48 | 1; | |
49 | } | |
50 | ||
b4514920 | 51 | use Test2::API::Instance(\$INST); |
07bc328a | 52 | |
b4514920 CG |
53 | # Set the exit status |
54 | END { | |
55 | test2_set_is_end(); # See gh #16 | |
56 | $INST->set_exit(); | |
57 | } | |
58 | ||
07bc328a SH |
59 | sub CLONE { |
60 | my $init = test2_init_done(); | |
61 | my $load = test2_load_done(); | |
62 | ||
63 | return if $init && $load; | |
64 | ||
65 | require Carp; | |
66 | Carp::croak "Test2 must be fully loaded before you start a new thread!\n"; | |
67 | } | |
68 | ||
b4514920 CG |
69 | # See gh #16 |
70 | { | |
71 | no warnings; | |
72 | INIT { eval 'END { test2_set_is_end() }; 1' or die $@ } | |
73 | } | |
74 | ||
75 | BEGIN { | |
76 | no warnings 'once'; | |
77 | if($] ge '5.014' || $ENV{T2_CHECK_DEPTH} || $Test2::API::DO_DEPTH_CHECK) { | |
78 | *DO_DEPTH_CHECK = sub() { 1 }; | |
79 | } | |
80 | else { | |
81 | *DO_DEPTH_CHECK = sub() { 0 }; | |
82 | } | |
83 | } | |
84 | ||
07bc328a SH |
85 | use Test2::EventFacet::Trace(); |
86 | use Test2::Util::Trace(); # Legacy | |
b4514920 CG |
87 | |
88 | use Test2::Hub::Subtest(); | |
89 | use Test2::Hub::Interceptor(); | |
90 | use Test2::Hub::Interceptor::Terminator(); | |
91 | ||
92 | use Test2::Event::Ok(); | |
93 | use Test2::Event::Diag(); | |
94 | use Test2::Event::Note(); | |
95 | use Test2::Event::Plan(); | |
96 | use Test2::Event::Bail(); | |
97 | use Test2::Event::Exception(); | |
98 | use Test2::Event::Waiting(); | |
99 | use Test2::Event::Skip(); | |
100 | use Test2::Event::Subtest(); | |
101 | ||
95db2efb | 102 | use Carp qw/carp croak confess/; |
b4514920 | 103 | use Scalar::Util qw/blessed weaken/; |
e82ffdf2 | 104 | use Test2::Util qw/get_tid clone_io pkg_to_file gen_uid/; |
b4514920 CG |
105 | |
106 | our @EXPORT_OK = qw{ | |
107 | context release | |
108 | context_do | |
109 | no_context | |
07bc328a | 110 | intercept intercept_deep |
b4514920 CG |
111 | run_subtest |
112 | ||
113 | test2_init_done | |
114 | test2_load_done | |
07bc328a SH |
115 | test2_load |
116 | test2_start_preload | |
117 | test2_stop_preload | |
118 | test2_in_preload | |
00ea29f1 | 119 | test2_is_testing_done |
b4514920 CG |
120 | |
121 | test2_set_is_end | |
ab7a3d99 | 122 | test2_unset_is_end |
b4514920 CG |
123 | test2_get_is_end |
124 | ||
125 | test2_pid | |
126 | test2_tid | |
127 | test2_stack | |
128 | test2_no_wait | |
e26b661b SH |
129 | test2_ipc_wait_enable |
130 | test2_ipc_wait_disable | |
131 | test2_ipc_wait_enabled | |
b4514920 | 132 | |
43de38c4 TR |
133 | test2_add_uuid_via |
134 | ||
e82ffdf2 SH |
135 | test2_add_callback_testing_done |
136 | ||
b4514920 CG |
137 | test2_add_callback_context_aquire |
138 | test2_add_callback_context_acquire | |
139 | test2_add_callback_context_init | |
140 | test2_add_callback_context_release | |
141 | test2_add_callback_exit | |
142 | test2_add_callback_post_load | |
e26b661b | 143 | test2_add_callback_pre_subtest |
b4514920 CG |
144 | test2_list_context_aquire_callbacks |
145 | test2_list_context_acquire_callbacks | |
146 | test2_list_context_init_callbacks | |
147 | test2_list_context_release_callbacks | |
148 | test2_list_exit_callbacks | |
149 | test2_list_post_load_callbacks | |
e26b661b | 150 | test2_list_pre_subtest_callbacks |
b4514920 CG |
151 | |
152 | test2_ipc | |
e26b661b | 153 | test2_has_ipc |
43de38c4 TR |
154 | test2_ipc_disable |
155 | test2_ipc_disabled | |
b4514920 CG |
156 | test2_ipc_drivers |
157 | test2_ipc_add_driver | |
158 | test2_ipc_polling | |
159 | test2_ipc_disable_polling | |
160 | test2_ipc_enable_polling | |
161 | test2_ipc_get_pending | |
162 | test2_ipc_set_pending | |
07bc328a SH |
163 | test2_ipc_get_timeout |
164 | test2_ipc_set_timeout | |
b4514920 CG |
165 | |
166 | test2_formatter | |
167 | test2_formatters | |
168 | test2_formatter_add | |
169 | test2_formatter_set | |
07bc328a SH |
170 | |
171 | test2_stdout | |
172 | test2_stderr | |
173 | test2_reset_io | |
2ae2f22a CG |
174 | |
175 | test2_enable_trace_stamps | |
176 | test2_disable_trace_stamps | |
177 | test2_trace_stamps_enabled | |
b4514920 | 178 | }; |
58818a66 | 179 | BEGIN { require Exporter; our @ISA = qw(Exporter) } |
b4514920 CG |
180 | |
181 | my $STACK = $INST->stack; | |
182 | my $CONTEXTS = $INST->contexts; | |
183 | my $INIT_CBS = $INST->context_init_callbacks; | |
184 | my $ACQUIRE_CBS = $INST->context_acquire_callbacks; | |
185 | ||
07bc328a SH |
186 | my $STDOUT = clone_io(\*STDOUT); |
187 | my $STDERR = clone_io(\*STDERR); | |
188 | sub test2_stdout { $STDOUT ||= clone_io(\*STDOUT) } | |
189 | sub test2_stderr { $STDERR ||= clone_io(\*STDERR) } | |
190 | ||
191 | sub test2_post_preload_reset { | |
192 | test2_reset_io(); | |
193 | $INST->post_preload_reset; | |
194 | } | |
195 | ||
196 | sub test2_reset_io { | |
197 | $STDOUT = clone_io(\*STDOUT); | |
198 | $STDERR = clone_io(\*STDERR); | |
199 | } | |
200 | ||
b4514920 CG |
201 | sub test2_init_done { $INST->finalized } |
202 | sub test2_load_done { $INST->loaded } | |
203 | ||
07bc328a SH |
204 | sub test2_load { $INST->load } |
205 | sub test2_start_preload { $ENV{T2_IN_PRELOAD} = 1; $INST->start_preload } | |
206 | sub test2_stop_preload { $ENV{T2_IN_PRELOAD} = 0; $INST->stop_preload } | |
207 | sub test2_in_preload { $INST->preload } | |
208 | ||
e26b661b SH |
209 | sub test2_pid { $INST->pid } |
210 | sub test2_tid { $INST->tid } | |
211 | sub test2_stack { $INST->stack } | |
212 | sub test2_ipc_wait_enable { $INST->set_no_wait(0) } | |
213 | sub test2_ipc_wait_disable { $INST->set_no_wait(1) } | |
214 | sub test2_ipc_wait_enabled { !$INST->no_wait } | |
215 | ||
2ae2f22a CG |
216 | sub test2_enable_trace_stamps { $INST->test2_enable_trace_stamps } |
217 | sub test2_disable_trace_stamps { $INST->test2_disable_trace_stamps } | |
218 | sub test2_trace_stamps_enabled { $INST->test2_trace_stamps_enabled } | |
219 | ||
00ea29f1 CG |
220 | sub test2_is_testing_done { |
221 | # No instance? VERY DONE! | |
222 | return 1 unless $INST; | |
223 | ||
224 | # No stack? tests must be done, it is created pretty early | |
225 | my $stack = $INST->stack or return 1; | |
226 | ||
227 | # Nothing on the stack, no root hub yet, likely have not started testing | |
228 | return 0 unless @$stack; | |
229 | ||
230 | # Stack has a slot for the root hub (see above) but it is undefined, likely | |
231 | # garbage collected, test is done | |
232 | my $root_hub = $stack->[0] or return 1; | |
233 | ||
234 | # If the root hub is ended than testing is done. | |
235 | return 1 if $root_hub->ended; | |
236 | ||
237 | # Looks like we are still testing! | |
238 | return 0; | |
239 | } | |
240 | ||
b4514920 CG |
241 | sub test2_no_wait { |
242 | $INST->set_no_wait(@_) if @_; | |
243 | $INST->no_wait; | |
244 | } | |
245 | ||
e82ffdf2 SH |
246 | sub test2_add_callback_testing_done { |
247 | my $cb = shift; | |
248 | ||
249 | test2_add_callback_post_load(sub { | |
250 | my $stack = test2_stack(); | |
2ae2f22a | 251 | $stack->top; # Ensure we have a hub |
e82ffdf2 SH |
252 | my ($hub) = Test2::API::test2_stack->all; |
253 | ||
254 | $hub->set_active(1); | |
255 | ||
256 | $hub->follow_up($cb); | |
257 | }); | |
258 | ||
259 | return; | |
260 | } | |
261 | ||
b4514920 CG |
262 | sub test2_add_callback_context_acquire { $INST->add_context_acquire_callback(@_) } |
263 | sub test2_add_callback_context_aquire { $INST->add_context_acquire_callback(@_) } | |
264 | sub test2_add_callback_context_init { $INST->add_context_init_callback(@_) } | |
265 | sub test2_add_callback_context_release { $INST->add_context_release_callback(@_) } | |
266 | sub test2_add_callback_exit { $INST->add_exit_callback(@_) } | |
267 | sub test2_add_callback_post_load { $INST->add_post_load_callback(@_) } | |
e26b661b | 268 | sub test2_add_callback_pre_subtest { $INST->add_pre_subtest_callback(@_) } |
b4514920 CG |
269 | sub test2_list_context_aquire_callbacks { @{$INST->context_acquire_callbacks} } |
270 | sub test2_list_context_acquire_callbacks { @{$INST->context_acquire_callbacks} } | |
271 | sub test2_list_context_init_callbacks { @{$INST->context_init_callbacks} } | |
272 | sub test2_list_context_release_callbacks { @{$INST->context_release_callbacks} } | |
273 | sub test2_list_exit_callbacks { @{$INST->exit_callbacks} } | |
274 | sub test2_list_post_load_callbacks { @{$INST->post_load_callbacks} } | |
e26b661b | 275 | sub test2_list_pre_subtest_callbacks { @{$INST->pre_subtest_callbacks} } |
b4514920 | 276 | |
43de38c4 TR |
277 | sub test2_add_uuid_via { |
278 | $INST->set_add_uuid_via(@_) if @_; | |
279 | $INST->add_uuid_via(); | |
280 | } | |
281 | ||
b4514920 | 282 | sub test2_ipc { $INST->ipc } |
e26b661b | 283 | sub test2_has_ipc { $INST->has_ipc } |
43de38c4 TR |
284 | sub test2_ipc_disable { $INST->ipc_disable } |
285 | sub test2_ipc_disabled { $INST->ipc_disabled } | |
b4514920 CG |
286 | sub test2_ipc_add_driver { $INST->add_ipc_driver(@_) } |
287 | sub test2_ipc_drivers { @{$INST->ipc_drivers} } | |
288 | sub test2_ipc_polling { $INST->ipc_polling } | |
289 | sub test2_ipc_enable_polling { $INST->enable_ipc_polling } | |
290 | sub test2_ipc_disable_polling { $INST->disable_ipc_polling } | |
291 | sub test2_ipc_get_pending { $INST->get_ipc_pending } | |
292 | sub test2_ipc_set_pending { $INST->set_ipc_pending(@_) } | |
07bc328a SH |
293 | sub test2_ipc_set_timeout { $INST->set_ipc_timeout(@_) } |
294 | sub test2_ipc_get_timeout { $INST->ipc_timeout() } | |
33951b79 | 295 | sub test2_ipc_enable_shm { 0 } |
b4514920 | 296 | |
07bc328a SH |
297 | sub test2_formatter { |
298 | if ($ENV{T2_FORMATTER} && $ENV{T2_FORMATTER} =~ m/^(\+)?(.*)$/) { | |
299 | my $formatter = $1 ? $2 : "Test2::Formatter::$2"; | |
300 | my $file = pkg_to_file($formatter); | |
301 | require $file; | |
302 | return $formatter; | |
303 | } | |
304 | ||
305 | return $INST->formatter; | |
306 | } | |
307 | ||
b4514920 CG |
308 | sub test2_formatters { @{$INST->formatters} } |
309 | sub test2_formatter_add { $INST->add_formatter(@_) } | |
310 | sub test2_formatter_set { | |
311 | my ($formatter) = @_; | |
312 | croak "No formatter specified" unless $formatter; | |
313 | croak "Global Formatter already set" if $INST->formatter_set; | |
314 | $INST->set_formatter($formatter); | |
315 | } | |
316 | ||
317 | # Private, for use in Test2::API::Context | |
318 | sub _contexts_ref { $INST->contexts } | |
319 | sub _context_acquire_callbacks_ref { $INST->context_acquire_callbacks } | |
320 | sub _context_init_callbacks_ref { $INST->context_init_callbacks } | |
321 | sub _context_release_callbacks_ref { $INST->context_release_callbacks } | |
43de38c4 | 322 | sub _add_uuid_via_ref { \($INST->{Test2::API::Instance::ADD_UUID_VIA()}) } |
b4514920 CG |
323 | |
324 | # Private, for use in Test2::IPC | |
325 | sub _set_ipc { $INST->set_ipc(@_) } | |
326 | ||
327 | sub context_do(&;@) { | |
328 | my $code = shift; | |
329 | my @args = @_; | |
330 | ||
331 | my $ctx = context(level => 1); | |
332 | ||
333 | my $want = wantarray; | |
334 | ||
335 | my @out; | |
336 | my $ok = eval { | |
337 | $want ? @out = $code->($ctx, @args) : | |
338 | defined($want) ? $out[0] = $code->($ctx, @args) : | |
339 | $code->($ctx, @args) ; | |
340 | 1; | |
341 | }; | |
342 | my $err = $@; | |
343 | ||
344 | $ctx->release; | |
345 | ||
346 | die $err unless $ok; | |
347 | ||
348 | return @out if $want; | |
349 | return $out[0] if defined $want; | |
350 | return; | |
351 | } | |
352 | ||
353 | sub no_context(&;$) { | |
354 | my ($code, $hid) = @_; | |
355 | $hid ||= $STACK->top->hid; | |
356 | ||
357 | my $ctx = $CONTEXTS->{$hid}; | |
358 | delete $CONTEXTS->{$hid}; | |
359 | my $ok = eval { $code->(); 1 }; | |
360 | my $err = $@; | |
361 | ||
362 | $CONTEXTS->{$hid} = $ctx; | |
363 | weaken($CONTEXTS->{$hid}); | |
364 | ||
365 | die $err unless $ok; | |
366 | ||
367 | return; | |
368 | }; | |
369 | ||
43de38c4 | 370 | my $UUID_VIA = _add_uuid_via_ref(); |
b4514920 CG |
371 | sub context { |
372 | # We need to grab these before anything else to ensure they are not | |
373 | # changed. | |
95db2efb | 374 | my ($errno, $eval_error, $child_error, $extended_error) = (0 + $!, $@, $?, $^E); |
b4514920 CG |
375 | |
376 | my %params = (level => 0, wrapped => 0, @_); | |
377 | ||
378 | # If something is getting a context then the sync system needs to be | |
379 | # considered loaded... | |
380 | $INST->load unless $INST->{loaded}; | |
381 | ||
382 | croak "context() called, but return value is ignored" | |
383 | unless defined wantarray; | |
384 | ||
385 | my $stack = $params{stack} || $STACK; | |
022600ce | 386 | my $hub = $params{hub} || (@$stack ? $stack->[-1] : $stack->top); |
1acbee7b CBW |
387 | |
388 | # Catch an edge case where we try to get context after the root hub has | |
389 | # been garbage collected resulting in a stack that has a single undef | |
390 | # hub | |
2ae2f22a CG |
391 | if (!($hub && $hub->{hid}) && !exists($params{hub}) && @$stack) { |
392 | my $msg; | |
393 | ||
394 | if ($hub && !$hub->{hid}) { | |
395 | $msg = Carp::longmess("$hub has no hid! (did you attempt a testing event after done_testing?). You may be relying on a tool or plugin that was based off an old Test2 that did not require hids."); | |
396 | } | |
397 | else { | |
398 | $msg = Carp::longmess("Attempt to get Test2 context after testing has completed (did you attempt a testing event after done_testing?)"); | |
399 | } | |
1acbee7b CBW |
400 | |
401 | # The error message is usually masked by the global destruction, so we have to print to STDER | |
402 | print STDERR $msg; | |
403 | ||
404 | # Make sure this is a failure, we are probably already in END, so set $? to change the exit code | |
405 | $? = 1; | |
406 | ||
407 | # Now we actually die to interrupt the program flow and avoid undefined his warnings | |
408 | die $msg; | |
409 | } | |
410 | ||
b4514920 CG |
411 | my $hid = $hub->{hid}; |
412 | my $current = $CONTEXTS->{$hid}; | |
413 | ||
414 | $_->(\%params) for @$ACQUIRE_CBS; | |
415 | map $_->(\%params), @{$hub->{_context_acquire}} if $hub->{_context_acquire}; | |
416 | ||
417 | # This is for https://github.com/Test-More/test-more/issues/16 | |
418 | # and https://rt.perl.org/Public/Bug/Display.html?id=127774 | |
419 | my $phase = ${^GLOBAL_PHASE} || 'NA'; | |
420 | my $end_phase = $ENDING || $phase eq 'END' || $phase eq 'DESTRUCT'; | |
421 | ||
422 | my $level = 1 + $params{level}; | |
18c72c39 | 423 | my ($pkg, $file, $line, $sub, @other) = $end_phase ? caller(0) : caller($level); |
b4514920 CG |
424 | unless ($pkg || $end_phase) { |
425 | confess "Could not find context at depth $level" unless $params{fudge}; | |
18c72c39 | 426 | ($pkg, $file, $line, $sub, @other) = caller(--$level) while ($level >= 0 && !$pkg); |
b4514920 CG |
427 | } |
428 | ||
429 | my $depth = $level; | |
430 | $depth++ while DO_DEPTH_CHECK && !$end_phase && (!$current || $depth <= $current->{_depth} + $params{wrapped}) && caller($depth + 1); | |
431 | $depth -= $params{wrapped}; | |
432 | my $depth_ok = !DO_DEPTH_CHECK || $end_phase || !$current || $current->{_depth} < $depth; | |
433 | ||
434 | if ($current && $params{on_release} && $depth_ok) { | |
435 | $current->{_on_release} ||= []; | |
436 | push @{$current->{_on_release}} => $params{on_release}; | |
437 | } | |
438 | ||
439 | # I know this is ugly.... | |
95db2efb | 440 | ($!, $@, $?, $^E) = ($errno, $eval_error, $child_error, $extended_error) and return bless( |
b4514920 CG |
441 | { |
442 | %$current, | |
443 | _is_canon => undef, | |
444 | errno => $errno, | |
445 | eval_error => $eval_error, | |
446 | child_error => $child_error, | |
447 | _is_spawn => [$pkg, $file, $line, $sub], | |
448 | }, | |
449 | 'Test2::API::Context' | |
450 | ) if $current && $depth_ok; | |
451 | ||
452 | # Handle error condition of bad level | |
453 | if ($current) { | |
454 | unless (${$current->{_aborted}}) { | |
455 | _canon_error($current, [$pkg, $file, $line, $sub, $depth]) | |
456 | unless $current->{_is_canon}; | |
457 | ||
458 | _depth_error($current, [$pkg, $file, $line, $sub, $depth]) | |
459 | unless $depth_ok; | |
460 | } | |
461 | ||
462 | $current->release if $current->{_is_canon}; | |
463 | ||
464 | delete $CONTEXTS->{$hid}; | |
465 | } | |
466 | ||
58818a66 | 467 | # Directly bless the object here, calling new is a noticeable performance |
b4514920 CG |
468 | # hit with how often this needs to be called. |
469 | my $trace = bless( | |
470 | { | |
43de38c4 TR |
471 | frame => [$pkg, $file, $line, $sub], |
472 | pid => $$, | |
473 | tid => get_tid(), | |
e82ffdf2 | 474 | cid => gen_uid(), |
43de38c4 TR |
475 | hid => $hid, |
476 | nested => $hub->{nested}, | |
07bc328a | 477 | buffered => $hub->{buffered}, |
43de38c4 | 478 | |
18c72c39 TR |
479 | full_caller => [$pkg, $file, $line, $sub, @other], |
480 | ||
2ae2f22a CG |
481 | $INST->{trace_stamps} ? (stamp => time()) : (), |
482 | ||
43de38c4 TR |
483 | $$UUID_VIA ? ( |
484 | huuid => $hub->{uuid}, | |
485 | uuid => ${$UUID_VIA}->('context'), | |
486 | ) : (), | |
b4514920 | 487 | }, |
07bc328a | 488 | 'Test2::EventFacet::Trace' |
b4514920 CG |
489 | ); |
490 | ||
58818a66 | 491 | # Directly bless the object here, calling new is a noticeable performance |
b4514920 CG |
492 | # hit with how often this needs to be called. |
493 | my $aborted = 0; | |
494 | $current = bless( | |
495 | { | |
496 | _aborted => \$aborted, | |
497 | stack => $stack, | |
498 | hub => $hub, | |
499 | trace => $trace, | |
500 | _is_canon => 1, | |
501 | _depth => $depth, | |
502 | errno => $errno, | |
503 | eval_error => $eval_error, | |
504 | child_error => $child_error, | |
505 | $params{on_release} ? (_on_release => [$params{on_release}]) : (), | |
506 | }, | |
507 | 'Test2::API::Context' | |
508 | ); | |
509 | ||
510 | $CONTEXTS->{$hid} = $current; | |
511 | weaken($CONTEXTS->{$hid}); | |
512 | ||
513 | $_->($current) for @$INIT_CBS; | |
514 | map $_->($current), @{$hub->{_context_init}} if $hub->{_context_init}; | |
515 | ||
516 | $params{on_init}->($current) if $params{on_init}; | |
517 | ||
95db2efb | 518 | ($!, $@, $?, $^E) = ($errno, $eval_error, $child_error, $extended_error); |
b4514920 CG |
519 | |
520 | return $current; | |
521 | } | |
522 | ||
523 | sub _depth_error { | |
524 | _existing_error(@_, <<" EOT"); | |
525 | context() was called to retrieve an existing context, however the existing | |
526 | context was created in a stack frame at the same, or deeper level. This usually | |
527 | means that a tool failed to release the context when it was finished. | |
528 | EOT | |
529 | } | |
530 | ||
531 | sub _canon_error { | |
532 | _existing_error(@_, <<" EOT"); | |
533 | context() was called to retrieve an existing context, however the existing | |
534 | context has an invalid internal state (!_canon_count). This should not normally | |
535 | happen unless something is mucking about with internals... | |
536 | EOT | |
537 | } | |
538 | ||
539 | sub _existing_error { | |
540 | my ($ctx, $details, $msg) = @_; | |
541 | my ($pkg, $file, $line, $sub, $depth) = @$details; | |
542 | ||
543 | my $oldframe = $ctx->{trace}->frame; | |
544 | my $olddepth = $ctx->{_depth}; | |
545 | ||
95db2efb SH |
546 | # Older versions of Carp do not export longmess() function, so it needs to be called with package name |
547 | my $mess = Carp::longmess(); | |
b4514920 CG |
548 | |
549 | warn <<" EOT"; | |
550 | $msg | |
551 | Old context details: | |
552 | File: $oldframe->[1] | |
553 | Line: $oldframe->[2] | |
554 | Tool: $oldframe->[3] | |
555 | Depth: $olddepth | |
556 | ||
557 | New context details: | |
558 | File: $file | |
559 | Line: $line | |
560 | Tool: $sub | |
561 | Depth: $depth | |
562 | ||
563 | Trace: $mess | |
564 | ||
565 | Removing the old context and creating a new one... | |
566 | EOT | |
567 | } | |
568 | ||
569 | sub release($;$) { | |
570 | $_[0]->release; | |
571 | return $_[1]; | |
572 | } | |
573 | ||
574 | sub intercept(&) { | |
575 | my $code = shift; | |
07bc328a SH |
576 | my $ctx = context(); |
577 | ||
578 | my $events = _intercept($code, deep => 0); | |
579 | ||
580 | $ctx->release; | |
581 | ||
582 | return $events; | |
583 | } | |
584 | ||
585 | sub intercept_deep(&) { | |
586 | my $code = shift; | |
587 | my $ctx = context(); | |
588 | ||
589 | my $events = _intercept($code, deep => 1); | |
b4514920 | 590 | |
07bc328a SH |
591 | $ctx->release; |
592 | ||
593 | return $events; | |
594 | } | |
595 | ||
596 | sub _intercept { | |
597 | my $code = shift; | |
598 | my %params = @_; | |
b4514920 CG |
599 | my $ctx = context(); |
600 | ||
601 | my $ipc; | |
602 | if (my $global_ipc = test2_ipc()) { | |
603 | my $driver = blessed($global_ipc); | |
604 | $ipc = $driver->new; | |
605 | } | |
606 | ||
607 | my $hub = Test2::Hub::Interceptor->new( | |
608 | ipc => $ipc, | |
609 | no_ending => 1, | |
610 | ); | |
611 | ||
612 | my @events; | |
07bc328a | 613 | $hub->listen(sub { push @events => $_[1] }, inherit => $params{deep}); |
b4514920 CG |
614 | |
615 | $ctx->stack->top; # Make sure there is a top hub before we begin. | |
616 | $ctx->stack->push($hub); | |
617 | ||
18c72c39 TR |
618 | my $trace = $ctx->trace; |
619 | my $state = {}; | |
620 | $hub->clean_inherited(trace => $trace, state => $state); | |
621 | ||
7aa7bbc7 SH |
622 | my ($ok, $err) = (1, undef); |
623 | T2_SUBTEST_WRAPPER: { | |
624 | # Do not use 'try' cause it localizes __DIE__ | |
b4514920 CG |
625 | $ok = eval { $code->(hub => $hub, context => $ctx->snapshot); 1 }; |
626 | $err = $@; | |
7aa7bbc7 SH |
627 | |
628 | # They might have done 'BEGIN { skip_all => "whatever" }' | |
629 | if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && $err->isa('Test2::Hub::Interceptor::Terminator'))) { | |
630 | $ok = 1; | |
631 | $err = undef; | |
632 | } | |
b4514920 CG |
633 | } |
634 | ||
635 | $hub->cull; | |
636 | $ctx->stack->pop($hub); | |
637 | ||
18c72c39 TR |
638 | $hub->restore_inherited(trace => $trace, state => $state); |
639 | ||
b4514920 CG |
640 | $ctx->release; |
641 | ||
7aa7bbc7 | 642 | die $err unless $ok; |
b4514920 CG |
643 | |
644 | $hub->finalize($trace, 1) | |
645 | if $ok | |
646 | && !$hub->no_ending | |
647 | && !$hub->ended; | |
648 | ||
18c72c39 TR |
649 | require Test2::API::InterceptResult; |
650 | return Test2::API::InterceptResult->new_from_ref(\@events); | |
b4514920 CG |
651 | } |
652 | ||
653 | sub run_subtest { | |
654 | my ($name, $code, $params, @args) = @_; | |
655 | ||
e26b661b SH |
656 | $_->($name,$code,@args) |
657 | for Test2::API::test2_list_pre_subtest_callbacks(); | |
658 | ||
35014935 | 659 | $params = {buffered => $params} unless ref $params; |
35014935 | 660 | my $inherit_trace = delete $params->{inherit_trace}; |
b4514920 CG |
661 | |
662 | my $ctx = context(); | |
663 | ||
b4514920 CG |
664 | my $parent = $ctx->hub; |
665 | ||
07bc328a SH |
666 | # If a parent is buffered then the child must be as well. |
667 | my $buffered = $params->{buffered} || $parent->{buffered}; | |
668 | ||
669 | $ctx->note($name) unless $buffered; | |
670 | ||
b4514920 CG |
671 | my $stack = $ctx->stack || $STACK; |
672 | my $hub = $stack->new_hub( | |
673 | class => 'Test2::Hub::Subtest', | |
674 | %$params, | |
07bc328a | 675 | buffered => $buffered, |
b4514920 CG |
676 | ); |
677 | ||
678 | my @events; | |
b4514920 CG |
679 | $hub->listen(sub { push @events => $_[1] }); |
680 | ||
681 | if ($buffered) { | |
682 | if (my $format = $hub->format) { | |
683 | my $hide = $format->can('hide_buffered') ? $format->hide_buffered : 1; | |
684 | $hub->format(undef) if $hide; | |
685 | } | |
686 | } | |
687 | ||
35014935 SH |
688 | if ($inherit_trace) { |
689 | my $orig = $code; | |
690 | $code = sub { | |
f9c0e2d5 SH |
691 | my $base_trace = $ctx->trace; |
692 | my $trace = $base_trace->snapshot(nested => 1 + $base_trace->nested); | |
35014935 | 693 | my $st_ctx = Test2::API::Context->new( |
f9c0e2d5 SH |
694 | trace => $trace, |
695 | hub => $hub, | |
35014935 SH |
696 | ); |
697 | $st_ctx->do_in_context($orig, @args); | |
698 | }; | |
699 | } | |
700 | ||
24893ef8 LT |
701 | my $start_stamp = time; |
702 | ||
b4514920 CG |
703 | my ($ok, $err, $finished); |
704 | T2_SUBTEST_WRAPPER: { | |
705 | # Do not use 'try' cause it localizes __DIE__ | |
706 | $ok = eval { $code->(@args); 1 }; | |
707 | $err = $@; | |
708 | ||
709 | # They might have done 'BEGIN { skip_all => "whatever" }' | |
58818a66 | 710 | if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && blessed($err) eq 'Test::Builder::Exception')) { |
b4514920 CG |
711 | $ok = undef; |
712 | $err = undef; | |
713 | } | |
714 | else { | |
715 | $finished = 1; | |
716 | } | |
717 | } | |
07bc328a | 718 | |
24893ef8 LT |
719 | my $stop_stamp = time; |
720 | ||
07bc328a SH |
721 | if ($params->{no_fork}) { |
722 | if ($$ != $ctx->trace->pid) { | |
723 | warn $ok ? "Forked inside subtest, but subtest never finished!\n" : $err; | |
724 | exit 255; | |
725 | } | |
726 | ||
727 | if (get_tid() != $ctx->trace->tid) { | |
728 | warn $ok ? "Started new thread inside subtest, but thread never finished!\n" : $err; | |
729 | exit 255; | |
730 | } | |
731 | } | |
732 | elsif (!$parent->is_local && !$parent->ipc) { | |
733 | warn $ok ? "A new process or thread was started inside subtest, but IPC is not enabled!\n" : $err; | |
734 | exit 255; | |
735 | } | |
736 | ||
b4514920 CG |
737 | $stack->pop($hub); |
738 | ||
739 | my $trace = $ctx->trace; | |
740 | ||
07bc328a SH |
741 | my $bailed = $hub->bailed_out; |
742 | ||
b4514920 | 743 | if (!$finished) { |
07bc328a | 744 | if ($bailed && !$buffered) { |
b4514920 CG |
745 | $ctx->bail($bailed->reason); |
746 | } | |
07bc328a SH |
747 | elsif ($bailed && $buffered) { |
748 | $ok = 1; | |
749 | } | |
750 | else { | |
751 | my $code = $hub->exit_code; | |
752 | $ok = !$code; | |
753 | $err = "Subtest ended with exit code $code" if $code; | |
754 | } | |
b4514920 CG |
755 | } |
756 | ||
43de38c4 | 757 | $hub->finalize($trace->snapshot(huuid => $hub->uuid, hid => $hub->hid, nested => $hub->nested, buffered => $buffered), 1) |
b4514920 CG |
758 | if $ok |
759 | && !$hub->no_ending | |
760 | && !$hub->ended; | |
761 | ||
762 | my $pass = $ok && $hub->is_passing; | |
763 | my $e = $ctx->build_event( | |
764 | 'Subtest', | |
43de38c4 TR |
765 | pass => $pass, |
766 | name => $name, | |
767 | subtest_id => $hub->id, | |
768 | subtest_uuid => $hub->uuid, | |
769 | buffered => $buffered, | |
770 | subevents => \@events, | |
24893ef8 LT |
771 | start_stamp => $start_stamp, |
772 | stop_stamp => $stop_stamp, | |
b4514920 CG |
773 | ); |
774 | ||
775 | my $plan_ok = $hub->check_plan; | |
776 | ||
777 | $ctx->hub->send($e); | |
778 | ||
779 | $ctx->failure_diag($e) unless $e->pass; | |
780 | ||
781 | $ctx->diag("Caught exception in subtest: $err") unless $ok; | |
782 | ||
783 | $ctx->diag("Bad subtest plan, expected " . $hub->plan . " but ran " . $hub->count) | |
784 | if defined($plan_ok) && !$plan_ok; | |
785 | ||
07bc328a SH |
786 | $ctx->bail($bailed->reason) if $bailed && $buffered; |
787 | ||
b4514920 CG |
788 | $ctx->release; |
789 | return $pass; | |
790 | } | |
791 | ||
58818a66 CG |
792 | # There is a use-cycle between API and API/Context. Context needs to use some |
793 | # API functions as the package is compiling. Test2::API::context() needs | |
794 | # Test2::API::Context to be loaded, but we cannot 'require' the module there as | |
795 | # it causes a very noticeable performance impact with how often context() is | |
796 | # called. | |
797 | require Test2::API::Context; | |
798 | ||
b4514920 CG |
799 | 1; |
800 | ||
801 | __END__ | |
802 | ||
803 | =pod | |
804 | ||
805 | =encoding UTF-8 | |
806 | ||
807 | =head1 NAME | |
808 | ||
809 | Test2::API - Primary interface for writing Test2 based testing tools. | |
810 | ||
811 | =head1 ***INTERNALS NOTE*** | |
812 | ||
813 | B<The internals of this package are subject to change at any time!> The public | |
58818a66 | 814 | methods provided will not change in backwards-incompatible ways (once there is |
b4514920 CG |
815 | a stable release), but the underlying implementation details might. |
816 | B<Do not break encapsulation here!> | |
817 | ||
818 | Currently the implementation is to create a single instance of the | |
819 | L<Test2::API::Instance> Object. All class methods defer to the single | |
820 | instance. There is no public access to the singleton, and that is intentional. | |
821 | The class methods provided by this package provide the only functionality | |
822 | publicly exposed. | |
823 | ||
824 | This is done primarily to avoid the problems Test::Builder had by exposing its | |
825 | singleton. We do not want anyone to replace this singleton, rebless it, or | |
e7e8a349 SH |
826 | directly muck with its internals. If you need to do something and cannot |
827 | because of the restrictions placed here, then please report it as an issue. If | |
828 | possible, we will create a way for you to implement your functionality without | |
b4514920 CG |
829 | exposing things that should not be exposed. |
830 | ||
831 | =head1 DESCRIPTION | |
832 | ||
833 | This package exports all the functions necessary to write and/or verify testing | |
834 | tools. Using these building blocks you can begin writing test tools very | |
835 | quickly. You are also provided with tools that help you to test the tools you | |
836 | write. | |
837 | ||
58818a66 | 838 | =head1 SYNOPSIS |
b4514920 CG |
839 | |
840 | =head2 WRITING A TOOL | |
841 | ||
842 | The C<context()> method is your primary interface into the Test2 framework. | |
843 | ||
844 | package My::Ok; | |
845 | use Test2::API qw/context/; | |
846 | ||
847 | our @EXPORT = qw/my_ok/; | |
848 | use base 'Exporter'; | |
849 | ||
850 | # Just like ok() from Test::More | |
851 | sub my_ok($;$) { | |
852 | my ($bool, $name) = @_; | |
853 | my $ctx = context(); # Get a context | |
854 | $ctx->ok($bool, $name); | |
855 | $ctx->release; # Release the context | |
856 | return $bool; | |
857 | } | |
858 | ||
58818a66 | 859 | See L<Test2::API::Context> for a list of methods available on the context object. |
b4514920 CG |
860 | |
861 | =head2 TESTING YOUR TOOLS | |
862 | ||
863 | The C<intercept { ... }> tool lets you temporarily intercept all events | |
864 | generated by the test system: | |
865 | ||
866 | use Test2::API qw/intercept/; | |
867 | ||
868 | use My::Ok qw/my_ok/; | |
869 | ||
870 | my $events = intercept { | |
871 | # These events are not displayed | |
872 | my_ok(1, "pass"); | |
873 | my_ok(0, "fail"); | |
874 | }; | |
875 | ||
18c72c39 TR |
876 | As of version 1.302178 this now returns an arrayref that is also an instance of |
877 | L<Test2::API::InterceptResult>. See the L<Test2::API::InterceptResult> | |
878 | documentation for details on how to best use it. | |
07bc328a | 879 | |
b4514920 CG |
880 | =head2 OTHER API FUNCTIONS |
881 | ||
882 | use Test2::API qw{ | |
883 | test2_init_done | |
884 | test2_stack | |
885 | test2_set_is_end | |
886 | test2_get_is_end | |
887 | test2_ipc | |
888 | test2_formatter_set | |
889 | test2_formatter | |
00ea29f1 | 890 | test2_is_testing_done |
b4514920 CG |
891 | }; |
892 | ||
893 | my $init = test2_init_done(); | |
894 | my $stack = test2_stack(); | |
895 | my $ipc = test2_ipc(); | |
896 | ||
897 | test2_formatter_set($FORMATTER) | |
898 | my $formatter = test2_formatter(); | |
899 | ||
900 | ... And others ... | |
901 | ||
902 | =head1 MAIN API EXPORTS | |
903 | ||
e7e8a349 | 904 | All exports are optional. You must specify subs to import. |
b4514920 CG |
905 | |
906 | use Test2::API qw/context intercept run_subtest/; | |
907 | ||
908 | This is the list of exports that are most commonly needed. If you are simply | |
e7e8a349 SH |
909 | writing a tool, then this is probably all you need. If you need something and |
910 | you cannot find it here, then you can also look at L</OTHER API EXPORTS>. | |
b4514920 CG |
911 | |
912 | These exports lack the 'test2_' prefix because of how important/common they | |
913 | are. Exports in the L</OTHER API EXPORTS> section have the 'test2_' prefix to | |
914 | ensure they stand out. | |
915 | ||
916 | =head2 context(...) | |
917 | ||
918 | Usage: | |
919 | ||
920 | =over 4 | |
921 | ||
922 | =item $ctx = context() | |
923 | ||
924 | =item $ctx = context(%params) | |
925 | ||
926 | =back | |
927 | ||
e7e8a349 SH |
928 | The C<context()> function will always return the current context. If |
929 | there is already a context active, it will be returned. If there is not an | |
930 | active context, one will be generated. When a context is generated it will | |
b4514920 CG |
931 | default to using the file and line number where the currently running sub was |
932 | called from. | |
933 | ||
934 | Please see L<Test2::API::Context/"CRITICAL DETAILS"> for important rules about | |
935 | what you can and cannot do with a context once it is obtained. | |
936 | ||
937 | B<Note> This function will throw an exception if you ignore the context object | |
938 | it returns. | |
939 | ||
2ae2f22a | 940 | B<Note> On perls 5.14+ a depth check is used to ensure there are no context |
b4514920 CG |
941 | leaks. This cannot be safely done on older perls due to |
942 | L<https://rt.perl.org/Public/Bug/Display.html?id=127774> | |
943 | You can forcefully enable it either by setting C<$ENV{T2_CHECK_DEPTH} = 1> or | |
944 | C<$Test2::API::DO_DEPTH_CHECK = 1> B<BEFORE> loading L<Test2::API>. | |
945 | ||
946 | =head3 OPTIONAL PARAMETERS | |
947 | ||
948 | All parameters to C<context> are optional. | |
949 | ||
950 | =over 4 | |
951 | ||
952 | =item level => $int | |
953 | ||
58818a66 | 954 | If you must obtain a context in a sub deeper than your entry point you can use |
b4514920 CG |
955 | this to tell it how many EXTRA stack frames to look back. If this option is not |
956 | provided the default of C<0> is used. | |
957 | ||
958 | sub third_party_tool { | |
959 | my $sub = shift; | |
960 | ... # Does not obtain a context | |
961 | $sub->(); | |
962 | ... | |
963 | } | |
964 | ||
965 | third_party_tool(sub { | |
966 | my $ctx = context(level => 1); | |
967 | ... | |
968 | $ctx->release; | |
969 | }); | |
970 | ||
971 | =item wrapped => $int | |
972 | ||
973 | Use this if you need to write your own tool that wraps a call to C<context()> | |
974 | with the intent that it should return a context object. | |
975 | ||
976 | sub my_context { | |
977 | my %params = ( wrapped => 0, @_ ); | |
978 | $params{wrapped}++; | |
979 | my $ctx = context(%params); | |
980 | ... | |
981 | return $ctx; | |
982 | } | |
983 | ||
984 | sub my_tool { | |
985 | my $ctx = my_context(); | |
986 | ... | |
987 | $ctx->release; | |
988 | } | |
989 | ||
e7e8a349 | 990 | If you do not do this, then tools you call that also check for a context will |
b4514920 CG |
991 | notice that the context they grabbed was created at the same stack depth, which |
992 | will trigger protective measures that warn you and destroy the existing | |
993 | context. | |
994 | ||
995 | =item stack => $stack | |
996 | ||
997 | Normally C<context()> looks at the global hub stack. If you are maintaining | |
998 | your own L<Test2::API::Stack> instance you may pass it in to be used | |
999 | instead of the global one. | |
1000 | ||
1001 | =item hub => $hub | |
1002 | ||
1003 | Use this parameter if you want to obtain the context for a specific hub instead | |
1004 | of whatever one happens to be at the top of the stack. | |
1005 | ||
1006 | =item on_init => sub { ... } | |
1007 | ||
1008 | This lets you provide a callback sub that will be called B<ONLY> if your call | |
1009 | to C<context()> generated a new context. The callback B<WILL NOT> be called if | |
1010 | C<context()> is returning an existing context. The only argument passed into | |
1011 | the callback will be the context object itself. | |
1012 | ||
1013 | sub foo { | |
1014 | my $ctx = context(on_init => sub { 'will run' }); | |
1015 | ||
1016 | my $inner = sub { | |
1017 | # This callback is not run since we are getting the existing | |
1018 | # context from our parent sub. | |
1019 | my $ctx = context(on_init => sub { 'will NOT run' }); | |
1020 | $ctx->release; | |
1021 | } | |
1022 | $inner->(); | |
1023 | ||
1024 | $ctx->release; | |
1025 | } | |
1026 | ||
1027 | =item on_release => sub { ... } | |
1028 | ||
1029 | This lets you provide a callback sub that will be called when the context | |
1030 | instance is released. This callback will be added to the returned context even | |
e7e8a349 | 1031 | if an existing context is returned. If multiple calls to context add callbacks, |
b4514920 CG |
1032 | then all will be called in reverse order when the context is finally released. |
1033 | ||
1034 | sub foo { | |
1035 | my $ctx = context(on_release => sub { 'will run second' }); | |
1036 | ||
1037 | my $inner = sub { | |
1038 | my $ctx = context(on_release => sub { 'will run first' }); | |
1039 | ||
1040 | # Neither callback runs on this release | |
1041 | $ctx->release; | |
1042 | } | |
1043 | $inner->(); | |
1044 | ||
1045 | # Both callbacks run here. | |
1046 | $ctx->release; | |
1047 | } | |
1048 | ||
1049 | =back | |
1050 | ||
1051 | =head2 release($;$) | |
1052 | ||
1053 | Usage: | |
1054 | ||
1055 | =over 4 | |
1056 | ||
1057 | =item release $ctx; | |
1058 | ||
1059 | =item release $ctx, ...; | |
1060 | ||
1061 | =back | |
1062 | ||
1063 | This is intended as a shortcut that lets you release your context and return a | |
1064 | value in one statement. This function will get your context, and an optional | |
1065 | return value. It will release your context, then return your value. Scalar | |
1066 | context is always assumed. | |
1067 | ||
1068 | sub tool { | |
1069 | my $ctx = context(); | |
1070 | ... | |
1071 | ||
1072 | return release $ctx, 1; | |
1073 | } | |
1074 | ||
1075 | This tool is most useful when you want to return the value you get from calling | |
1076 | a function that needs to see the current context: | |
1077 | ||
1078 | my $ctx = context(); | |
1079 | my $out = some_tool(...); | |
1080 | $ctx->release; | |
1081 | return $out; | |
1082 | ||
1083 | We can combine the last 3 lines of the above like so: | |
1084 | ||
1085 | my $ctx = context(); | |
1086 | release $ctx, some_tool(...); | |
1087 | ||
1088 | =head2 context_do(&;@) | |
1089 | ||
1090 | Usage: | |
1091 | ||
1092 | sub my_tool { | |
1093 | context_do { | |
1094 | my $ctx = shift; | |
1095 | ||
1096 | my (@args) = @_; | |
1097 | ||
1098 | $ctx->ok(1, "pass"); | |
1099 | ||
1100 | ... | |
1101 | ||
1102 | # No need to call $ctx->release, done for you on scope exit. | |
1103 | } @_; | |
1104 | } | |
1105 | ||
1106 | Using this inside your test tool takes care of a lot of boilerplate for you. It | |
1107 | will ensure a context is acquired. It will capture and rethrow any exception. It | |
2ae2f22a CG |
1108 | will ensure the context is released when you are done. It preserves the |
1109 | subroutine call context (list, scalar, void). | |
b4514920 | 1110 | |
e7e8a349 | 1111 | This is the safest way to write a test tool. The only two downsides to this are a |
b4514920 CG |
1112 | slight performance decrease, and some extra indentation in your source. If the |
1113 | indentation is a problem for you then you can take a peek at the next section. | |
1114 | ||
1115 | =head2 no_context(&;$) | |
1116 | ||
1117 | Usage: | |
1118 | ||
1119 | =over 4 | |
1120 | ||
1121 | =item no_context { ... }; | |
1122 | ||
1123 | =item no_context { ... } $hid; | |
1124 | ||
1125 | sub my_tool(&) { | |
1126 | my $code = shift; | |
1127 | my $ctx = context(); | |
1128 | ... | |
1129 | ||
1130 | no_context { | |
1131 | # Things in here will not see our current context, they get a new | |
1132 | # one. | |
1133 | ||
1134 | $code->(); | |
1135 | }; | |
1136 | ||
1137 | ... | |
1138 | $ctx->release; | |
1139 | }; | |
1140 | ||
1141 | =back | |
1142 | ||
1143 | This tool will hide a context for the provided block of code. This means any | |
1144 | tools run inside the block will get a completely new context if they acquire | |
1145 | one. The new context will be inherited by tools nested below the one that | |
1146 | acquired it. | |
1147 | ||
1148 | This will normally hide the current context for the top hub. If you need to | |
1149 | hide the context for a different hub you can pass in the optional C<$hid> | |
1150 | parameter. | |
1151 | ||
1152 | =head2 intercept(&) | |
1153 | ||
1154 | Usage: | |
1155 | ||
1156 | my $events = intercept { | |
1157 | ok(1, "pass"); | |
1158 | ok(0, "fail"); | |
1159 | ... | |
1160 | }; | |
1161 | ||
1162 | This function takes a codeblock as its only argument, and it has a prototype. | |
1163 | It will execute the codeblock, intercepting any generated events in the | |
1164 | process. It will return an array reference with all the generated event | |
1165 | objects. All events should be subclasses of L<Test2::Event>. | |
1166 | ||
18c72c39 TR |
1167 | As of version 1.302178 the events array that is returned is blssed as an |
1168 | L<Test2::API::InterceptResult> instance. L<Test2::API::InterceptResult> | |
1169 | Provides a helpful interface for filtering and/or inspecting the events list | |
1170 | overall, or individual events within the list. | |
1171 | ||
1172 | This is intended to help you test your test code. This is not intended for | |
1173 | people simply writing tests. | |
b4514920 CG |
1174 | |
1175 | =head2 run_subtest(...) | |
1176 | ||
1177 | Usage: | |
1178 | ||
1179 | run_subtest($NAME, \&CODE, $BUFFERED, @ARGS) | |
1180 | ||
1181 | # or | |
1182 | ||
1183 | run_subtest($NAME, \&CODE, \%PARAMS, @ARGS) | |
1184 | ||
1185 | This will run the provided codeblock with the args in C<@args>. This codeblock | |
1186 | will be run as a subtest. A subtest is an isolated test state that is condensed | |
1187 | into a single L<Test2::Event::Subtest> event, which contains all events | |
1188 | generated inside the subtest. | |
1189 | ||
1190 | =head3 ARGUMENTS: | |
1191 | ||
1192 | =over 4 | |
1193 | ||
1194 | =item $NAME | |
1195 | ||
1196 | The name of the subtest. | |
1197 | ||
1198 | =item \&CODE | |
1199 | ||
1200 | The code to run inside the subtest. | |
1201 | ||
1202 | =item $BUFFERED or \%PARAMS | |
1203 | ||
1204 | If this is a simple scalar then it will be treated as a boolean for the | |
58818a66 | 1205 | 'buffered' setting. If this is a hash reference then it will be used as a |
b4514920 | 1206 | parameters hash. The param hash will be used for hub construction (with the |
35014935 SH |
1207 | specified keys removed). |
1208 | ||
1209 | Keys that are removed and used by run_subtest: | |
1210 | ||
1211 | =over 4 | |
b4514920 | 1212 | |
35014935 SH |
1213 | =item 'buffered' => $bool |
1214 | ||
1215 | Toggle buffered status. | |
1216 | ||
1217 | =item 'inherit_trace' => $bool | |
1218 | ||
1219 | Normally the subtest hub is pushed and the sub is allowed to generate its own | |
1220 | root context for the hub. When this setting is turned on a root context will be | |
1221 | created for the hub that shares the same trace as the current context. | |
1222 | ||
1223 | Set this to true if your tool is producing subtests without user-specified | |
1224 | subs. | |
1225 | ||
07bc328a SH |
1226 | =item 'no_fork' => $bool |
1227 | ||
1228 | Defaults to off. Normally forking inside a subtest will actually fork the | |
1229 | subtest, resulting in 2 final subtest events. This parameter will turn off that | |
1230 | behavior, only the original process/thread will return a final subtest event. | |
1231 | ||
35014935 | 1232 | =back |
b4514920 CG |
1233 | |
1234 | =item @ARGS | |
1235 | ||
1236 | Any extra arguments you want passed into the subtest code. | |
1237 | ||
1238 | =back | |
1239 | ||
1240 | =head3 BUFFERED VS UNBUFFERED (OR STREAMED) | |
1241 | ||
1242 | Normally all events inside and outside a subtest are sent to the formatter | |
58818a66 | 1243 | immediately by the hub. Sometimes it is desirable to hold off sending events |
b4514920 CG |
1244 | within a subtest until the subtest is complete. This usually depends on the |
1245 | formatter being used. | |
1246 | ||
1247 | =over 4 | |
1248 | ||
2ae2f22a | 1249 | =item Things not affected by this flag |
b4514920 CG |
1250 | |
1251 | In both cases events are generated and stored in an array. This array is | |
1252 | eventually used to populate the C<subevents> attribute on the | |
1253 | L<Test2::Event::Subtest> event that is generated at the end of the subtest. | |
1254 | This flag has no effect on this part, it always happens. | |
1255 | ||
e7e8a349 | 1256 | At the end of the subtest, the final L<Test2::Event::Subtest> event is sent to |
b4514920 CG |
1257 | the formatter. |
1258 | ||
2ae2f22a | 1259 | =item Things that are affected by this flag |
b4514920 CG |
1260 | |
1261 | The C<buffered> attribute of the L<Test2::Event::Subtest> event will be set to | |
1262 | the value of this flag. This means any formatter, listener, etc which looks at | |
1263 | the event will know if it was buffered. | |
1264 | ||
2ae2f22a | 1265 | =item Things that are formatter dependent |
b4514920 CG |
1266 | |
1267 | Events within a buffered subtest may or may not be sent to the formatter as | |
1268 | they happen. If a formatter fails to specify then the default is to B<NOT SEND> | |
1269 | the events as they are generated, instead the formatter can pull them from the | |
1270 | C<subevents> attribute. | |
1271 | ||
1272 | A formatter can specify by implementing the C<hide_buffered()> method. If this | |
1273 | method returns true then events generated inside a buffered subtest will not be | |
58818a66 | 1274 | sent independently of the final subtest event. |
b4514920 CG |
1275 | |
1276 | =back | |
1277 | ||
1278 | An example of how this is used is the L<Test2::Formatter::TAP> formatter. For | |
1279 | unbuffered subtests the events are rendered as they are generated. At the end | |
e7e8a349 | 1280 | of the subtest, the final subtest event is rendered, but the C<subevents> |
b4514920 CG |
1281 | attribute is ignored. For buffered subtests the opposite occurs, the events are |
1282 | NOT rendered as they are generated, instead the C<subevents> attribute is used | |
1283 | to render them all at once. This is useful when running subtests tests in | |
e7e8a349 SH |
1284 | parallel, since without it the output from subtests would be interleaved |
1285 | together. | |
b4514920 CG |
1286 | |
1287 | =head1 OTHER API EXPORTS | |
1288 | ||
1289 | Exports in this section are not commonly needed. These all have the 'test2_' | |
1290 | prefix to help ensure they stand out. You should look at the L</MAIN API | |
1291 | EXPORTS> section before looking here. This section is one where "Great power | |
58818a66 | 1292 | comes with great responsibility". It is possible to break things badly if you |
b4514920 CG |
1293 | are not careful with these. |
1294 | ||
e7e8a349 | 1295 | All exports are optional. You need to list which ones you want at import time: |
b4514920 CG |
1296 | |
1297 | use Test2::API qw/test2_init_done .../; | |
1298 | ||
1299 | =head2 STATUS AND INITIALIZATION STATE | |
1300 | ||
1301 | These provide access to internal state and object instances. | |
1302 | ||
1303 | =over 4 | |
1304 | ||
1305 | =item $bool = test2_init_done() | |
1306 | ||
58818a66 | 1307 | This will return true if the stack and IPC instances have already been |
b4514920 | 1308 | initialized. It will return false if they have not. Init happens as late as |
e7e8a349 | 1309 | possible. It happens as soon as a tool requests the IPC instance, the |
b4514920 CG |
1310 | formatter, or the stack. |
1311 | ||
1312 | =item $bool = test2_load_done() | |
1313 | ||
1314 | This will simply return the boolean value of the loaded flag. If Test2 has | |
1315 | finished loading this will be true, otherwise false. Loading is considered | |
1316 | complete the first time a tool requests a context. | |
1317 | ||
1318 | =item test2_set_is_end() | |
1319 | ||
1320 | =item test2_set_is_end($bool) | |
1321 | ||
1322 | This is used to toggle Test2's belief that the END phase has already started. | |
1323 | With no arguments this will set it to true. With arguments it will set it to | |
1324 | the first argument's value. | |
1325 | ||
1326 | This is used to prevent the use of C<caller()> in END blocks which can cause | |
1327 | segfaults. This is only necessary in some persistent environments that may have | |
1328 | multiple END phases. | |
1329 | ||
1330 | =item $bool = test2_get_is_end() | |
1331 | ||
e7e8a349 | 1332 | Check if Test2 believes it is the END phase. |
b4514920 CG |
1333 | |
1334 | =item $stack = test2_stack() | |
1335 | ||
1336 | This will return the global L<Test2::API::Stack> instance. If this has not | |
1337 | yet been initialized it will be initialized now. | |
1338 | ||
00ea29f1 CG |
1339 | =item $bool = test2_is_testing_done() |
1340 | ||
1341 | This will return true if testing is complete and no other events should be | |
1342 | sent. This is useful in things like warning handlers where you might want to | |
1343 | turn warnings into events, but need them to start acting like normal warnings | |
1344 | when testing is done. | |
1345 | ||
1346 | $SIG{__WARN__} = sub { | |
1347 | my ($warning) = @_; | |
1348 | ||
1349 | if (test2_is_testing_done()) { | |
1350 | warn @_; | |
1351 | } | |
1352 | else { | |
1353 | my $ctx = context(); | |
1354 | ... | |
1355 | $ctx->release | |
1356 | } | |
1357 | } | |
1358 | ||
43de38c4 TR |
1359 | =item test2_ipc_disable |
1360 | ||
1361 | Disable IPC. | |
1362 | ||
1363 | =item $bool = test2_ipc_diabled | |
1364 | ||
1365 | Check if IPC is disabled. | |
1366 | ||
e26b661b SH |
1367 | =item test2_ipc_wait_enable() |
1368 | ||
1369 | =item test2_ipc_wait_disable() | |
1370 | ||
1371 | =item $bool = test2_ipc_wait_enabled() | |
1372 | ||
1373 | These can be used to turn IPC waiting on and off, or check the current value of | |
1374 | the flag. | |
1375 | ||
1376 | Waiting is turned on by default. Waiting will cause the parent process/thread | |
1377 | to wait until all child processes and threads are finished before exiting. You | |
1378 | will almost never want to turn this off. | |
1379 | ||
b4514920 CG |
1380 | =item $bool = test2_no_wait() |
1381 | ||
1382 | =item test2_no_wait($bool) | |
1383 | ||
e26b661b SH |
1384 | B<DISCOURAGED>: This is a confusing interface, it is better to use |
1385 | C<test2_ipc_wait_enable()>, C<test2_ipc_wait_disable()> and | |
1386 | C<test2_ipc_wait_enabled()>. | |
1387 | ||
b4514920 CG |
1388 | This can be used to get/set the no_wait status. Waiting is turned on by |
1389 | default. Waiting will cause the parent process/thread to wait until all child | |
1390 | processes and threads are finished before exiting. You will almost never want | |
1391 | to turn this off. | |
1392 | ||
1195d90a CBW |
1393 | =item $fh = test2_stdout() |
1394 | ||
1395 | =item $fh = test2_stderr() | |
1396 | ||
1397 | These functions return the filehandles that test output should be written to. | |
1398 | They are primarily useful when writing a custom formatter and code that turns | |
a6afdf72 | 1399 | events into actual output (TAP, etc.). They will return a dupe of the original |
1195d90a CBW |
1400 | filehandles that formatted output can be sent to regardless of whatever state |
1401 | the currently running test may have left STDOUT and STDERR in. | |
1402 | ||
1403 | =item test2_reset_io() | |
1404 | ||
1405 | Re-dupe the internal filehandles returned by C<test2_stdout()> and | |
1406 | C<test2_stderr()> from the current STDOUT and STDERR. You shouldn't need to do | |
1407 | this except in very peculiar situations (for example, you're testing a new | |
1408 | formatter and you need control over where the formatter is sending its output.) | |
1409 | ||
b4514920 CG |
1410 | =back |
1411 | ||
1412 | =head2 BEHAVIOR HOOKS | |
1413 | ||
1414 | These are hooks that allow you to add custom behavior to actions taken by Test2 | |
1415 | and tools built on top of it. | |
1416 | ||
1417 | =over 4 | |
1418 | ||
1419 | =item test2_add_callback_exit(sub { ... }) | |
1420 | ||
1421 | This can be used to add a callback that is called after all testing is done. This | |
1422 | is too late to add additional results, the main use of this callback is to set the | |
1423 | exit code. | |
1424 | ||
1425 | test2_add_callback_exit( | |
1426 | sub { | |
1427 | my ($context, $exit, \$new_exit) = @_; | |
1428 | ... | |
1429 | } | |
1430 | ); | |
1431 | ||
1432 | The C<$context> passed in will be an instance of L<Test2::API::Context>. The | |
1433 | C<$exit> argument will be the original exit code before anything modified it. | |
1434 | C<$$new_exit> is a reference to the new exit code. You may modify this to | |
1435 | change the exit code. Please note that C<$$new_exit> may already be different | |
1436 | from C<$exit> | |
1437 | ||
1438 | =item test2_add_callback_post_load(sub { ... }) | |
1439 | ||
1440 | Add a callback that will be called when Test2 is finished loading. This | |
1441 | means the callback will be run once, the first time a context is obtained. | |
58818a66 | 1442 | If Test2 has already finished loading then the callback will be run immediately. |
b4514920 | 1443 | |
e82ffdf2 SH |
1444 | =item test2_add_callback_testing_done(sub { ... }) |
1445 | ||
1446 | This adds your coderef as a follow-up to the root hub after Test2 is finished loading. | |
1447 | ||
1448 | This is essentially a helper to do the following: | |
1449 | ||
1450 | test2_add_callback_post_load(sub { | |
1451 | my $stack = test2_stack(); | |
2ae2f22a | 1452 | $stack->top; # Ensure we have a hub |
e82ffdf2 SH |
1453 | my ($hub) = Test2::API::test2_stack->all; |
1454 | ||
1455 | $hub->set_active(1); | |
1456 | ||
1457 | $hub->follow_up(sub { ... }); # <-- Your coderef here | |
1458 | }); | |
1459 | ||
b4514920 CG |
1460 | =item test2_add_callback_context_acquire(sub { ... }) |
1461 | ||
1462 | Add a callback that will be called every time someone tries to acquire a | |
1463 | context. This will be called on EVERY call to C<context()>. It gets a single | |
e7e8a349 | 1464 | argument, a reference to the hash of parameters being used the construct the |
b4514920 CG |
1465 | context. This is your chance to change the parameters by directly altering the |
1466 | hash. | |
1467 | ||
1468 | test2_add_callback_context_acquire(sub { | |
1469 | my $params = shift; | |
1470 | $params->{level}++; | |
1471 | }); | |
1472 | ||
1473 | This is a very scary API function. Please do not use this unless you need to. | |
1474 | This is here for L<Test::Builder> and backwards compatibility. This has you | |
1475 | directly manipulate the hash instead of returning a new one for performance | |
1476 | reasons. | |
1477 | ||
1478 | =item test2_add_callback_context_init(sub { ... }) | |
1479 | ||
1480 | Add a callback that will be called every time a new context is created. The | |
1481 | callback will receive the newly created context as its only argument. | |
1482 | ||
1483 | =item test2_add_callback_context_release(sub { ... }) | |
1484 | ||
1485 | Add a callback that will be called every time a context is released. The | |
1486 | callback will receive the released context as its only argument. | |
1487 | ||
e26b661b SH |
1488 | =item test2_add_callback_pre_subtest(sub { ... }) |
1489 | ||
1490 | Add a callback that will be called every time a subtest is going to be | |
1491 | run. The callback will receive the subtest name, coderef, and any | |
1492 | arguments. | |
1493 | ||
b4514920 CG |
1494 | =item @list = test2_list_context_acquire_callbacks() |
1495 | ||
1496 | Return all the context acquire callback references. | |
1497 | ||
1498 | =item @list = test2_list_context_init_callbacks() | |
1499 | ||
1500 | Returns all the context init callback references. | |
1501 | ||
1502 | =item @list = test2_list_context_release_callbacks() | |
1503 | ||
1504 | Returns all the context release callback references. | |
1505 | ||
1506 | =item @list = test2_list_exit_callbacks() | |
1507 | ||
1508 | Returns all the exit callback references. | |
1509 | ||
1510 | =item @list = test2_list_post_load_callbacks() | |
1511 | ||
1512 | Returns all the post load callback references. | |
1513 | ||
e26b661b SH |
1514 | =item @list = test2_list_pre_subtest_callbacks() |
1515 | ||
1516 | Returns all the pre-subtest callback references. | |
1517 | ||
43de38c4 TR |
1518 | =item test2_add_uuid_via(sub { ... }) |
1519 | ||
1520 | =item $sub = test2_add_uuid_via() | |
1521 | ||
1522 | This allows you to provide a UUID generator. If provided UUIDs will be attached | |
1523 | to all events, hubs, and contexts. This is useful for storing, tracking, and | |
1524 | linking these objects. | |
1525 | ||
1526 | The sub you provide should always return a unique identifier. Most things will | |
1527 | expect a proper UUID string, however nothing in Test2::API enforces this. | |
1528 | ||
1529 | The sub will receive exactly 1 argument, the type of thing being tagged | |
1530 | 'context', 'hub', or 'event'. In the future additional things may be tagged, in | |
1531 | which case new strings will be passed in. These are purely informative, you can | |
1532 | (and usually should) ignore them. | |
1533 | ||
b4514920 CG |
1534 | =back |
1535 | ||
1536 | =head2 IPC AND CONCURRENCY | |
1537 | ||
1538 | These let you access, or specify, the IPC system internals. | |
1539 | ||
1540 | =over 4 | |
1541 | ||
e26b661b SH |
1542 | =item $bool = test2_has_ipc() |
1543 | ||
1544 | Check if IPC is enabled. | |
1545 | ||
b4514920 CG |
1546 | =item $ipc = test2_ipc() |
1547 | ||
1548 | This will return the global L<Test2::IPC::Driver> instance. If this has not yet | |
1549 | been initialized it will be initialized now. | |
1550 | ||
1551 | =item test2_ipc_add_driver($DRIVER) | |
1552 | ||
1553 | Add an IPC driver to the list. This will add the driver to the start of the | |
1554 | list. | |
1555 | ||
1556 | =item @drivers = test2_ipc_drivers() | |
1557 | ||
1558 | Get the list of IPC drivers. | |
1559 | ||
1560 | =item $bool = test2_ipc_polling() | |
1561 | ||
1562 | Check if polling is enabled. | |
1563 | ||
1564 | =item test2_ipc_enable_polling() | |
1565 | ||
1566 | Turn on polling. This will cull events from other processes and threads every | |
1567 | time a context is created. | |
1568 | ||
1569 | =item test2_ipc_disable_polling() | |
1570 | ||
1571 | Turn off IPC polling. | |
1572 | ||
1573 | =item test2_ipc_enable_shm() | |
1574 | ||
33951b79 | 1575 | Legacy, this is currently a no-op that returns 0; |
b4514920 CG |
1576 | |
1577 | =item test2_ipc_set_pending($uniq_val) | |
1578 | ||
1579 | Tell other processes and events that an event is pending. C<$uniq_val> should | |
1580 | be a unique value no other thread/process will generate. | |
1581 | ||
1582 | B<Note:> After calling this C<test2_ipc_get_pending()> will return 1. This is | |
1583 | intentional, and not avoidable. | |
1584 | ||
1585 | =item $pending = test2_ipc_get_pending() | |
1586 | ||
1587 | This returns -1 if there is no way to check (assume yes) | |
1588 | ||
1589 | This returns 0 if there are (most likely) no pending events. | |
1590 | ||
1591 | This returns 1 if there are (likely) pending events. Upon return it will reset, | |
1592 | nothing else will be able to see that there were pending events. | |
1593 | ||
07bc328a SH |
1594 | =item $timeout = test2_ipc_get_timeout() |
1595 | ||
1596 | =item test2_ipc_set_timeout($timeout) | |
1597 | ||
1598 | Get/Set the timeout value for the IPC system. This timeout is how long the IPC | |
1599 | system will wait for child processes and threads to finish before aborting. | |
1600 | ||
1601 | The default value is C<30> seconds. | |
1602 | ||
b4514920 CG |
1603 | =back |
1604 | ||
1605 | =head2 MANAGING FORMATTERS | |
1606 | ||
1607 | These let you access, or specify, the formatters that can/should be used. | |
1608 | ||
1609 | =over 4 | |
1610 | ||
1611 | =item $formatter = test2_formatter | |
1612 | ||
1613 | This will return the global formatter class. This is not an instance. By | |
1614 | default the formatter is set to L<Test2::Formatter::TAP>. | |
1615 | ||
1616 | You can override this default using the C<T2_FORMATTER> environment variable. | |
1617 | ||
1618 | Normally 'Test2::Formatter::' is prefixed to the value in the | |
1619 | environment variable: | |
1620 | ||
1621 | $ T2_FORMATTER='TAP' perl test.t # Use the Test2::Formatter::TAP formatter | |
1622 | $ T2_FORMATTER='Foo' perl test.t # Use the Test2::Formatter::Foo formatter | |
1623 | ||
1624 | If you want to specify a full module name you use the '+' prefix: | |
1625 | ||
1626 | $ T2_FORMATTER='+Foo::Bar' perl test.t # Use the Foo::Bar formatter | |
1627 | ||
1628 | =item test2_formatter_set($class_or_instance) | |
1629 | ||
1630 | Set the global formatter class. This can only be set once. B<Note:> This will | |
1631 | override anything specified in the 'T2_FORMATTER' environment variable. | |
1632 | ||
1633 | =item @formatters = test2_formatters() | |
1634 | ||
1635 | Get a list of all loaded formatters. | |
1636 | ||
1637 | =item test2_formatter_add($class_or_instance) | |
1638 | ||
1639 | Add a formatter to the list. Last formatter added is used at initialization. If | |
1640 | this is called after initialization a warning will be issued. | |
1641 | ||
1642 | =back | |
1643 | ||
2ae2f22a CG |
1644 | =head2 TIME STAMPS |
1645 | ||
1646 | You can enable or disable timestamps in trace facets. They are disabled by | |
1647 | default for compatibility and performance reasons. | |
1648 | ||
1649 | =over 4 | |
1650 | ||
1651 | =item test2_enable_trace_stamps() | |
1652 | ||
1653 | Enable stamps in traces. | |
1654 | ||
1655 | =item test2_disable_trace_stamps() | |
1656 | ||
1657 | Disable stamps in traces. | |
1658 | ||
1659 | =item $bool = test2_trace_stamps_enabled() | |
1660 | ||
1661 | Check status of trace stamps. | |
1662 | ||
1663 | =back | |
1664 | ||
b4514920 CG |
1665 | =head1 OTHER EXAMPLES |
1666 | ||
1667 | See the C</Examples/> directory included in this distribution. | |
1668 | ||
1669 | =head1 SEE ALSO | |
1670 | ||
1671 | L<Test2::API::Context> - Detailed documentation of the context object. | |
1672 | ||
1673 | L<Test2::IPC> - The IPC system used for threading/fork support. | |
1674 | ||
1675 | L<Test2::Formatter> - Formatters such as TAP live here. | |
1676 | ||
1677 | L<Test2::Event> - Events live in this namespace. | |
1678 | ||
1679 | L<Test2::Hub> - All events eventually funnel through a hub. Custom hubs are how | |
1680 | C<intercept()> and C<run_subtest()> are implemented. | |
1681 | ||
1682 | =head1 MAGIC | |
1683 | ||
1684 | This package has an END block. This END block is responsible for setting the | |
1685 | exit code based on the test results. This end block also calls the callbacks that | |
1686 | can be added to this package. | |
1687 | ||
1688 | =head1 SOURCE | |
1689 | ||
1690 | The source code repository for Test2 can be found at | |
2ae2f22a | 1691 | L<https://github.com/Test-More/test-more/>. |
b4514920 CG |
1692 | |
1693 | =head1 MAINTAINERS | |
1694 | ||
1695 | =over 4 | |
1696 | ||
1697 | =item Chad Granum E<lt>exodist@cpan.orgE<gt> | |
1698 | ||
1699 | =back | |
1700 | ||
1701 | =head1 AUTHORS | |
1702 | ||
1703 | =over 4 | |
1704 | ||
1705 | =item Chad Granum E<lt>exodist@cpan.orgE<gt> | |
1706 | ||
1707 | =back | |
1708 | ||
1709 | =head1 COPYRIGHT | |
1710 | ||
18c72c39 | 1711 | Copyright 2020 Chad Granum E<lt>exodist@cpan.orgE<gt>. |
b4514920 CG |
1712 | |
1713 | This program is free software; you can redistribute it and/or | |
1714 | modify it under the same terms as Perl itself. | |
1715 | ||
2ae2f22a | 1716 | See L<https://dev.perl.org/licenses/> |
b4514920 CG |
1717 | |
1718 | =cut |