5 our $VERSION = '1.302097';
8 use Carp qw/carp croak confess/;
9 use Test2::Util qw/get_tid ipc_separator/;
11 use Scalar::Util qw/weaken/;
12 use List::Util qw/first/;
14 use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/;
15 use Test2::Util::HashBase qw{
43 $self->{+TID} = get_tid();
44 $self->{+HID} = join ipc_separator, $self->{+PID}, $self->{+TID}, $ID_POSTFIX++;
46 $self->{+NESTED} = 0 unless defined $self->{+NESTED};
47 $self->{+BUFFERED} = 0 unless defined $self->{+BUFFERED};
51 $self->{+_PASSING} = 1;
53 if (my $formatter = delete $self->{formatter}) {
54 $self->format($formatter);
57 if (my $ipc = $self->{+IPC}) {
58 $ipc->add_hub($self->{+HID});
68 return if $self->{+PID} == $$ && $self->{+TID} == get_tid();
71 $self->{+TID} = get_tid();
72 $self->{+HID} = join ipc_separator, $self->{+PID}, $self->{+TID}, $ID_POSTFIX++;
74 if (my $ipc = $self->{+IPC}) {
75 $ipc->add_hub($self->{+HID});
84 $self->{+_PASSING} = 1;
86 delete $self->{+_PLAN};
87 delete $self->{+ENDED};
88 delete $self->{+BAILED_OUT};
89 delete $self->{+SKIP_REASON};
94 my ($from, %params) = @_;
96 $self->{+NESTED} ||= 0;
98 $self->{+_FORMATTER} = $from->{+_FORMATTER}
99 unless $self->{+_FORMATTER} || exists($params{formatter});
101 if ($from->{+IPC} && !$self->{+IPC} && !exists($params{ipc})) {
102 my $ipc = $from->{+IPC};
103 $self->{+IPC} = $ipc;
104 $ipc->add_hub($self->{+HID});
107 if (my $ls = $from->{+_LISTENERS}) {
108 push @{$self->{+_LISTENERS}} => grep { $_->{inherit} } @$ls;
111 if (my $pfs = $from->{+_PRE_FILTERS}) {
112 push @{$self->{+_PRE_FILTERS}} => grep { $_->{inherit} } @$pfs;
115 if (my $fs = $from->{+_FILTERS}) {
116 push @{$self->{+_FILTERS}} => grep { $_->{inherit} } @$fs;
123 my $old = $self->{+_FORMATTER};
124 ($self->{+_FORMATTER}) = @_ if @_;
131 return $$ == $self->{+PID}
132 && get_tid() == $self->{+TID};
137 my ($sub, %params) = @_;
139 carp "Useless addition of a listener in a child process or thread!"
140 if $$ != $self->{+PID} || get_tid() != $self->{+TID};
142 croak "listen only takes coderefs for arguments, got '$sub'"
143 unless ref $sub && ref $sub eq 'CODE';
145 push @{$self->{+_LISTENERS}} => { %params, code => $sub };
147 $sub; # Intentional return.
153 carp "Useless removal of a listener in a child process or thread!"
154 if $$ != $self->{+PID} || get_tid() != $self->{+TID};
156 my %subs = map {$_ => $_} @_;
158 @{$self->{+_LISTENERS}} = grep { !$subs{$_->{code}} } @{$self->{+_LISTENERS}};
163 my ($sub, %params) = @_;
165 carp "Useless addition of a filter in a child process or thread!"
166 if $$ != $self->{+PID} || get_tid() != $self->{+TID};
168 croak "filter only takes coderefs for arguments, got '$sub'"
169 unless ref $sub && ref $sub eq 'CODE';
171 push @{$self->{+_FILTERS}} => { %params, code => $sub };
173 $sub; # Intentional Return
178 carp "Useless removal of a filter in a child process or thread!"
179 if $$ != $self->{+PID} || get_tid() != $self->{+TID};
180 my %subs = map {$_ => $_} @_;
181 @{$self->{+_FILTERS}} = grep { !$subs{$_->{code}} } @{$self->{+_FILTERS}};
186 my ($sub, %params) = @_;
188 croak "pre_filter only takes coderefs for arguments, got '$sub'"
189 unless ref $sub && ref $sub eq 'CODE';
191 push @{$self->{+_PRE_FILTERS}} => { %params, code => $sub };
193 $sub; # Intentional Return
198 my %subs = map {$_ => $_} @_;
199 @{$self->{+_PRE_FILTERS}} = grep { !$subs{$_->{code}} } @{$self->{+_PRE_FILTERS}};
206 carp "Useless addition of a follow-up in a child process or thread!"
207 if $$ != $self->{+PID} || get_tid() != $self->{+TID};
209 croak "follow_up only takes coderefs for arguments, got '$sub'"
210 unless ref $sub && ref $sub eq 'CODE';
212 push @{$self->{+_FOLLOW_UPS}} => $sub;
215 *add_context_aquire = \&add_context_acquire;
216 sub add_context_acquire {
220 croak "add_context_acquire only takes coderefs for arguments, got '$sub'"
221 unless ref $sub && ref $sub eq 'CODE';
223 push @{$self->{+_CONTEXT_ACQUIRE}} => $sub;
225 $sub; # Intentional return.
228 *remove_context_aquire = \&remove_context_acquire;
229 sub remove_context_acquire {
231 my %subs = map {$_ => $_} @_;
232 @{$self->{+_CONTEXT_ACQUIRE}} = grep { !$subs{$_} == $_ } @{$self->{+_CONTEXT_ACQUIRE}};
235 sub add_context_init {
239 croak "add_context_init only takes coderefs for arguments, got '$sub'"
240 unless ref $sub && ref $sub eq 'CODE';
242 push @{$self->{+_CONTEXT_INIT}} => $sub;
244 $sub; # Intentional return.
247 sub remove_context_init {
249 my %subs = map {$_ => $_} @_;
250 @{$self->{+_CONTEXT_INIT}} = grep { !$subs{$_} == $_ } @{$self->{+_CONTEXT_INIT}};
253 sub add_context_release {
257 croak "add_context_release only takes coderefs for arguments, got '$sub'"
258 unless ref $sub && ref $sub eq 'CODE';
260 push @{$self->{+_CONTEXT_RELEASE}} => $sub;
262 $sub; # Intentional return.
265 sub remove_context_release {
267 my %subs = map {$_ => $_} @_;
268 @{$self->{+_CONTEXT_RELEASE}} = grep { !$subs{$_} == $_ } @{$self->{+_CONTEXT_RELEASE}};
275 if ($self->{+_PRE_FILTERS}) {
276 for (@{$self->{+_PRE_FILTERS}}) {
277 $e = $_->{code}->($self, $e);
282 my $ipc = $self->{+IPC} || return $self->process($e);
285 $ipc->send($self->{+HID}, $e, 'GLOBAL');
286 return $self->process($e);
289 return $ipc->send($self->{+HID}, $e)
290 if $$ != $self->{+PID} || get_tid() != $self->{+TID};
299 if ($self->{+_FILTERS}) {
300 for (@{$self->{+_FILTERS}}) {
301 $e = $_->{code}->($self, $e);
306 # Optimize the most common case
308 if ($type eq 'Test2::Event::Pass' || ($type eq 'Test2::Event::Ok' && $e->{pass})) {
309 my $count = ++($self->{+COUNT});
310 $self->{+_FORMATTER}->write($e, $count) if $self->{+_FORMATTER};
312 if ($self->{+_LISTENERS}) {
313 $_->{code}->($self, $e, $count) for @{$self->{+_LISTENERS}};
319 my $f = $e->facet_data;
322 $fail = 1 if $f->{assert} && !$f->{assert}->{pass};
323 $fail = 1 if $f->{errors} && grep { $_->{fail} } @{$f->{errors}};
324 $fail = 0 if $f->{amnesty};
326 $self->{+COUNT}++ if $f->{assert};
327 $self->{+FAILED}++ if $fail && $f->{assert};
328 $self->{+_PASSING} = 0 if $fail;
330 my $code = $f->{control}->{terminate};
331 my $count = $self->{+COUNT};
333 if (my $plan = $f->{plan}) {
336 $self->set_skip_reason($plan->{details} || 1);
339 elsif ($plan->{none}) {
340 $self->plan('NO PLAN');
343 $self->plan($plan->{count});
347 $e->callback($self) if $f->{control}->{has_callback};
349 $self->{+_FORMATTER}->write($e, $count, $f) if $self->{+_FORMATTER};
351 if ($self->{+_LISTENERS}) {
352 $_->{code}->($self, $e, $count, $f) for @{$self->{+_LISTENERS}};
355 if ($f->{control}->{halt}) {
357 $self->set_bailed_out($e);
361 $self->{+_FORMATTER}->terminate($e, $f) if $self->{+_FORMATTER};
362 $self->terminate($code, $e, $f);
377 my $ipc = $self->{+IPC} || return;
378 return if $self->{+PID} != $$ || $self->{+TID} != get_tid();
380 # No need to do IPC checks on culled events
381 $self->process($_) for $ipc->cull($self->{+HID});
386 my ($trace, $do_plan) = @_;
390 my $plan = $self->{+_PLAN};
391 my $count = $self->{+COUNT};
392 my $failed = $self->{+FAILED};
393 my $active = $self->{+ACTIVE};
395 # return if NOTHING was done.
396 unless ($active || $do_plan || defined($plan) || $count || $failed) {
397 $self->{+_FORMATTER}->finalize($plan, $count, $failed, 0, $self->is_subtest) if $self->{+_FORMATTER};
401 unless ($self->{+ENDED}) {
402 if ($self->{+_FOLLOW_UPS}) {
403 $_->($trace, $self) for reverse @{$self->{+_FOLLOW_UPS}};
406 # These need to be refreshed now
407 $plan = $self->{+_PLAN};
408 $count = $self->{+COUNT};
409 $failed = $self->{+FAILED};
411 if (($plan && $plan eq 'NO PLAN') || ($do_plan && !$plan)) {
413 Test2::Event::Plan->new(
419 $plan = $self->{+_PLAN};
422 my $frame = $trace->frame;
423 if($self->{+ENDED}) {
424 my (undef, $ffile, $fline) = @{$self->{+ENDED}};
425 my (undef, $sfile, $sline) = @$frame;
429 First End: $ffile line $fline
430 Second End: $sfile line $sline
434 $self->{+ENDED} = $frame;
435 my $pass = $self->is_passing(); # Generate the final boolean.
437 $self->{+_FORMATTER}->finalize($plan, $count, $failed, $pass, $self->is_subtest) if $self->{+_FORMATTER};
445 ($self->{+_PASSING}) = @_ if @_;
447 # If we already failed just return 0.
448 my $pass = $self->{+_PASSING} or return 0;
449 return $self->{+_PASSING} = 0 if $self->{+FAILED};
451 my $count = $self->{+COUNT};
452 my $ended = $self->{+ENDED};
453 my $plan = $self->{+_PLAN};
455 return $pass if !$count && $plan && $plan =~ m/^SKIP$/;
457 return $self->{+_PASSING} = 0
458 if $ended && (!$count || !$plan);
460 return $pass unless $plan && $plan =~ m/^\d+$/;
463 return $self->{+_PASSING} = 0 if $count != $plan;
466 return $self->{+_PASSING} = 0 if $count > $plan;
475 return $self->{+_PLAN} unless @_;
479 confess "You cannot unset the plan"
480 unless defined $plan;
482 confess "You cannot change the plan"
483 if $self->{+_PLAN} && $self->{+_PLAN} !~ m/^NO PLAN$/;
485 confess "'$plan' is not a valid plan! Plan must be an integer greater than 0, 'NO PLAN', or 'SKIP'"
486 unless $plan =~ m/^(\d+|NO PLAN|SKIP)$/;
488 $self->{+_PLAN} = $plan;
494 return undef unless $self->{+ENDED};
495 my $plan = $self->{+_PLAN} || return undef;
497 return 1 if $plan !~ m/^\d+$/;
499 return 1 if $plan == $self->{+COUNT};
505 my $ipc = $self->{+IPC} || return;
506 return unless $$ == $self->{+PID};
507 return unless get_tid() == $self->{+TID};
508 $ipc->drop_hub($self->{+HID});
521 Test2::Hub - The conduit through which all events flow.
527 my $hub = Test2::Hub->new();
532 The hub is the place where all events get processed and handed off to the
533 formatter. The hub also tracks test state, and provides several hooks into the
538 =head2 SENDING EVENTS
542 The C<send()> method is used to issue an event to the hub. This method will
543 handle thread/fork sync, filters, listeners, TAP output, etc.
545 =head2 ALTERING OR REMOVING EVENTS
547 You can use either C<filter()> or C<pre_filter()>, depending on your
548 needs. Both have identical syntax, so only C<filter()> is shown here.
551 my ($hub, $event) = @_;
553 my $action = get_action($event);
555 # No action should be taken
556 return $event if $action eq 'none';
558 # You want your filter to remove the event
559 return undef if $action eq 'delete';
561 if ($action eq 'do_it') {
562 my $new_event = copy_event($event);
563 ... Change your copy of the event ...
567 die "Should not happen";
570 By default, filters are not inherited by child hubs. That means if you start a
571 subtest, the subtest will not inherit the filter. You can change this behavior
572 with the C<inherit> parameter:
574 $hub->filter(sub { ... }, inherit => 1);
576 =head2 LISTENING FOR EVENTS
579 my ($hub, $event, $number) = @_;
581 ... do whatever you want with the event ...
586 By default listeners are not inherited by child hubs. That means if you start a
587 subtest, the subtest will not inherit the listener. You can change this behavior
588 with the C<inherit> parameter:
590 $hub->listen(sub { ... }, inherit => 1);
593 =head2 POST-TEST BEHAVIORS
595 $hub->follow_up(sub {
596 my ($trace, $hub) = @_;
598 ... do whatever you need to ...
603 follow_up subs are called only once, either when done_testing is called, or in
606 =head2 SETTING THE FORMATTER
608 By default an instance of L<Test2::Formatter::TAP> is created and used.
610 my $old = $hub->format(My::Formatter->new);
612 Setting the formatter will REPLACE any existing formatter. You may set the
613 formatter to undef to prevent output. The old formatter will be returned if one
614 was already set. Only one formatter is allowed at a time.
620 =item $hub->send($event)
622 This is where all events enter the hub for processing.
624 =item $hub->process($event)
626 This is called by send after it does any IPC handling. You can use this to
627 bypass the IPC process, but in general you should avoid using this.
629 =item $old = $hub->format($formatter)
631 Replace the existing formatter instance with a new one. Formatters must be
632 objects that implement a C<< $formatter->write($event) >> method.
634 =item $sub = $hub->listen(sub { ... }, %optional_params)
636 You can use this to record all events AFTER they have been sent to the
637 formatter. No changes made here will be meaningful, except possibly to other
641 my ($hub, $event, $number) = @_;
643 ... do whatever you want with the event ...
648 Normally listeners are not inherited by child hubs such as subtests. You can
649 add the C<< inherit => 1 >> parameter to allow a listener to be inherited.
651 =item $hub->unlisten($sub)
653 You can use this to remove a listen callback. You must pass in the coderef
654 returned by the C<listen()> method.
656 =item $sub = $hub->filter(sub { ... }, %optional_params)
658 =item $sub = $hub->pre_filter(sub { ... }, %optional_params)
660 These can be used to add filters. Filters can modify, replace, or remove events
661 before anything else can see them.
665 my ($hub, $event) = @_;
667 return $event; # No Changes
668 return; # Remove the event
670 # Or you can modify an event before returning it.
676 If you are not using threads, forking, or IPC then the only difference between
677 a C<filter> and a C<pre_filter> is that C<pre_filter> subs run first. When you
678 are using threads, forking, or IPC, pre_filters happen to events before they
679 are sent to their destination proc/thread, ordinary filters happen only in the
680 destination hub/thread.
682 You cannot add a regular filter to a hub if the hub was created in another
683 process or thread. You can always add a pre_filter.
685 =item $hub->unfilter($sub)
687 =item $hub->pre_unfilter($sub)
689 These can be used to remove filters and pre_filters. The C<$sub> argument is
690 the reference returned by C<filter()> or C<pre_filter()>.
692 =item $hub->follow_op(sub { ... })
694 Use this to add behaviors that are called just before the hub is finalized. The
695 only argument to your codeblock will be a L<Test2::EventFacet::Trace> instance.
697 $hub->follow_up(sub {
698 my ($trace, $hub) = @_;
700 ... do whatever you need to ...
705 follow_up subs are called only once, ether when done_testing is called, or in
708 =item $sub = $hub->add_context_acquire(sub { ... });
710 Add a callback that will be called every time someone tries to acquire a
711 context. It gets a single argument, a reference of the hash of parameters
712 being used the construct the context. This is your chance to change the
713 parameters by directly altering the hash.
715 test2_add_callback_context_acquire(sub {
720 This is a very scary API function. Please do not use this unless you need to.
721 This is here for L<Test::Builder> and backwards compatibility. This has you
722 directly manipulate the hash instead of returning a new one for performance
725 B<Note> Using this hook could have a huge performance impact.
727 The coderef you provide is returned and can be used to remove the hook later.
729 =item $hub->remove_context_acquire($sub);
731 This can be used to remove a context acquire hook.
733 =item $sub = $hub->add_context_init(sub { ... });
735 This allows you to add callbacks that will trigger every time a new context is
736 created for the hub. The only argument to the sub will be the
737 L<Test2::API::Context> instance that was created.
739 B<Note> Using this hook could have a huge performance impact.
741 The coderef you provide is returned and can be used to remove the hook later.
743 =item $hub->remove_context_init($sub);
745 This can be used to remove a context init hook.
747 =item $sub = $hub->add_context_release(sub { ... });
749 This allows you to add callbacks that will trigger every time a context for
750 this hub is released. The only argument to the sub will be the
751 L<Test2::API::Context> instance that was released. These will run in reverse
754 B<Note> Using this hook could have a huge performance impact.
756 The coderef you provide is returned and can be used to remove the hook later.
758 =item $hub->remove_context_release($sub);
760 This can be used to remove a context release hook.
764 Cull any IPC events (and process them).
766 =item $pid = $hub->pid()
768 Get the process id under which the hub was created.
770 =item $tid = $hub->tid()
772 Get the thread id under which the hub was created.
774 =item $hud = $hub->hid()
776 Get the identifier string of the hub.
778 =item $ipc = $hub->ipc()
780 Get the IPC object used by the hub.
782 =item $hub->set_no_ending($bool)
784 =item $bool = $hub->no_ending
786 This can be used to disable auto-ending behavior for a hub. The auto-ending
787 behavior is triggered by an end block and is used to cull IPC events, and
788 output the final plan if the plan was 'no_plan'.
790 =item $bool = $hub->active
792 =item $hub->set_active($bool)
794 These are used to get/set the 'active' attribute. When true this attribute will
795 force C<< hub->finalize() >> to take action even if there is no plan, and no
796 tests have been run. This flag is useful for plugins that add follow-up
797 behaviors that need to run even if no events are seen.
805 =item $hub->reset_state()
807 Reset all state to the start. This sets the test count to 0, clears the plan,
808 removes the failures, etc.
810 =item $num = $hub->count
812 Get the number of tests that have been run.
814 =item $num = $hub->failed
816 Get the number of failures (Not all failures come from a test fail, so this
817 number can be larger than the count).
819 =item $bool = $hub->ended
821 True if the testing has ended. This MAY return the stack frame of the tool that
822 ended the test, but that is not guaranteed.
824 =item $bool = $hub->is_passing
826 =item $hub->is_passing($bool)
828 Check if the overall test run is a failure. Can also be used to set the
831 =item $hub->plan($plan)
833 =item $plan = $hub->plan
835 Get or set the plan. The plan must be an integer larger than 0, the string
836 'no_plan', or the string 'skip_all'.
838 =item $bool = $hub->check_plan
840 Check if the plan and counts match, but only if the tests have ended. If tests
841 have not ended this will return undef, otherwise it will be a true/false.
845 =head1 THIRD PARTY META-DATA
847 This object consumes L<Test2::Util::ExternalMeta> which provides a consistent
848 way for you to attach meta-data to instances of this class. This is useful for
849 tools, plugins, and other extensions.
853 The source code repository for Test2 can be found at
854 F<http://github.com/Test-More/test-more/>.
860 =item Chad Granum E<lt>exodist@cpan.orgE<gt>
868 =item Chad Granum E<lt>exodist@cpan.orgE<gt>
874 Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.
876 This program is free software; you can redistribute it and/or
877 modify it under the same terms as Perl itself.
879 See F<http://dev.perl.org/licenses/>