diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event |
Initial commit
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event')
15 files changed, 2060 insertions, 0 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Bail.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Bail.pm new file mode 100644 index 0000000000..bfd99ee3aa --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Bail.pm @@ -0,0 +1,109 @@ +package Test2::Event::Bail; +use strict; +use warnings; + +our $VERSION = '1.302133'; + + +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } +use Test2::Util::HashBase qw{reason buffered}; + +# Make sure the tests terminate +sub terminate { 255 }; + +sub global { 1 }; + +sub causes_fail { 1 } + +sub summary { + my $self = shift; + return "Bail out! " . $self->{+REASON} + if $self->{+REASON}; + + return "Bail out!"; +} + +sub diagnostics { 1 } + +sub facet_data { + my $self = shift; + my $out = $self->common_facet_data; + + $out->{control} = { + global => 1, + halt => 1, + details => $self->{+REASON}, + terminate => 255, + }; + + return $out; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::Bail - Bailout! + +=head1 DESCRIPTION + +The bailout event is generated when things go horribly wrong and you need to +halt all testing in the current file. + +=head1 SYNOPSIS + + use Test2::API qw/context/; + use Test2::Event::Bail; + + my $ctx = context(); + my $event = $ctx->bail('Stuff is broken'); + +=head1 METHODS + +Inherits from L<Test2::Event>. Also defines: + +=over 4 + +=item $reason = $e->reason + +The reason for the bailout. + +=back + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://dev.perl.org/licenses/> + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Diag.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Diag.pm new file mode 100644 index 0000000000..f5d3a6a49e --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Diag.pm @@ -0,0 +1,99 @@ +package Test2::Event::Diag; +use strict; +use warnings; + +our $VERSION = '1.302133'; + + +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } +use Test2::Util::HashBase qw/message/; + +sub init { + $_[0]->{+MESSAGE} = 'undef' unless defined $_[0]->{+MESSAGE}; +} + +sub summary { $_[0]->{+MESSAGE} } + +sub diagnostics { 1 } + +sub facet_data { + my $self = shift; + + my $out = $self->common_facet_data; + + $out->{info} = [ + { + tag => 'DIAG', + debug => 1, + details => $self->{+MESSAGE}, + } + ]; + + return $out; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::Diag - Diag event type + +=head1 DESCRIPTION + +Diagnostics messages, typically rendered to STDERR. + +=head1 SYNOPSIS + + use Test2::API qw/context/; + use Test2::Event::Diag; + + my $ctx = context(); + my $event = $ctx->diag($message); + +=head1 ACCESSORS + +=over 4 + +=item $diag->message + +The message for the diag. + +=back + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://dev.perl.org/licenses/> + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Encoding.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Encoding.pm new file mode 100644 index 0000000000..cd4b28dcbe --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Encoding.pm @@ -0,0 +1,97 @@ +package Test2::Event::Encoding; +use strict; +use warnings; + +our $VERSION = '1.302133'; + +use Carp qw/croak/; + +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } +use Test2::Util::HashBase qw/encoding/; + +sub init { + my $self = shift; + defined $self->{+ENCODING} or croak "'encoding' is a required attribute"; +} + +sub summary { 'Encoding set to ' . $_[0]->{+ENCODING} } + +sub facet_data { + my $self = shift; + my $out = $self->common_facet_data; + $out->{control}->{encoding} = $self->{+ENCODING}; + $out->{about}->{details} = $self->summary; + return $out; +} + + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::Encoding - Set the encoding for the output stream + +=head1 DESCRIPTION + +The encoding event is generated when a test file wants to specify the encoding +to be used when formatting its output. This event is intended to be produced +by formatter classes and used for interpreting test names, message contents, +etc. + +=head1 SYNOPSIS + + use Test2::API qw/context/; + use Test2::Event::Encoding; + + my $ctx = context(); + my $event = $ctx->send_event('Encoding', encoding => 'UTF-8'); + +=head1 METHODS + +Inherits from L<Test2::Event>. Also defines: + +=over 4 + +=item $encoding = $e->encoding + +The encoding being specified. + +=back + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://dev.perl.org/licenses/> + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Exception.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Exception.pm new file mode 100644 index 0000000000..4ec36c57fa --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Exception.pm @@ -0,0 +1,113 @@ +package Test2::Event::Exception; +use strict; +use warnings; + +our $VERSION = '1.302133'; + + +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } +use Test2::Util::HashBase qw{error}; + +sub init { + my $self = shift; + $self->{+ERROR} = "$self->{+ERROR}"; +} + +sub causes_fail { 1 } + +sub summary { + my $self = shift; + chomp(my $msg = "Exception: " . $self->{+ERROR}); + return $msg; +} + +sub diagnostics { 1 } + +sub facet_data { + my $self = shift; + my $out = $self->common_facet_data; + + $out->{errors} = [ + { + tag => 'ERROR', + fail => 1, + details => $self->{+ERROR}, + } + ]; + + return $out; +} + + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::Exception - Exception event + +=head1 DESCRIPTION + +An exception event will display to STDERR, and will prevent the overall test +file from passing. + +=head1 SYNOPSIS + + use Test2::API qw/context/; + use Test2::Event::Exception; + + my $ctx = context(); + my $event = $ctx->send_event('Exception', error => 'Stuff is broken'); + +=head1 METHODS + +Inherits from L<Test2::Event>. Also defines: + +=over 4 + +=item $reason = $e->error + +The reason for the exception. + +=back + +=head1 CAVEATS + +Be aware that all exceptions are stringified during construction. + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://dev.perl.org/licenses/> + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Fail.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Fail.pm new file mode 100644 index 0000000000..f243918627 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Fail.pm @@ -0,0 +1,118 @@ +package Test2::Event::Fail; +use strict; +use warnings; + +our $VERSION = '1.302133'; + +use Test2::EventFacet::Info; + +BEGIN { + require Test2::Event; + our @ISA = qw(Test2::Event); + *META_KEY = \&Test2::Util::ExternalMeta::META_KEY; +} + +use Test2::Util::HashBase qw{ -name -info }; + +############# +# Old API +sub summary { "fail" } +sub increments_count { 1 } +sub diagnostics { 0 } +sub no_display { 0 } +sub subtest_id { undef } +sub terminate { () } +sub global { () } +sub sets_plan { () } + +sub causes_fail { + my $self = shift; + return 0 if $self->{+AMNESTY} && @{$self->{+AMNESTY}}; + return 1; +} + +############# +# New API + +sub add_info { + my $self = shift; + + for my $in (@_) { + $in = {%$in} if ref($in) ne 'ARRAY'; + $in = Test2::EventFacet::Info->new($in); + + push @{$self->{+INFO}} => $in; + } +} + +sub facet_data { + my $self = shift; + my $out = $self->common_facet_data; + + $out->{about}->{details} = 'fail'; + + $out->{assert} = {pass => 0, details => $self->{+NAME}}; + + $out->{info} = [map {{ %{$_} }} @{$self->{+INFO}}] if $self->{+INFO}; + + return $out; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::Fail - Event for a simple failed assertion + +=head1 DESCRIPTION + +This is an optimal representation of a failed assertion. + +=head1 SYNOPSIS + + use Test2::API qw/context/; + + sub fail { + my ($name) = @_; + my $ctx = context(); + $ctx->fail($name); + $ctx->release; + } + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://dev.perl.org/licenses/> + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Generic.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Generic.pm new file mode 100644 index 0000000000..b5bf934135 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Generic.pm @@ -0,0 +1,280 @@ +package Test2::Event::Generic; +use strict; +use warnings; + +use Carp qw/croak/; +use Scalar::Util qw/reftype/; + +our $VERSION = '1.302133'; + +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } +use Test2::Util::HashBase; + +my @FIELDS = qw{ + causes_fail increments_count diagnostics no_display callback terminate + global sets_plan summary facet_data +}; +my %DEFAULTS = ( + causes_fail => 0, + increments_count => 0, + diagnostics => 0, + no_display => 0, +); + +sub init { + my $self = shift; + + for my $field (@FIELDS) { + my $val = defined $self->{$field} ? delete $self->{$field} : $DEFAULTS{$field}; + next unless defined $val; + + my $set = "set_$field"; + $self->$set($val); + } +} + +for my $field (@FIELDS) { + no strict 'refs'; + + *$field = sub { exists $_[0]->{$field} ? $_[0]->{$field} : () } + unless exists &{$field}; + + *{"set_$field"} = sub { $_[0]->{$field} = $_[1] } + unless exists &{"set_$field"}; +} + +sub can { + my $self = shift; + my ($name) = @_; + return $self->SUPER::can($name) unless $name eq 'callback'; + return $self->{callback} || \&Test2::Event::callback; +} + +sub facet_data { + my $self = shift; + return $self->{facet_data} || $self->SUPER::facet_data(); +} + +sub summary { + my $self = shift; + return $self->{summary} if defined $self->{summary}; + $self->SUPER::summary(); +} + +sub sets_plan { + my $self = shift; + return unless $self->{sets_plan}; + return @{$self->{sets_plan}}; +} + +sub callback { + my $self = shift; + my $cb = $self->{callback} || return; + $self->$cb(@_); +} + +sub set_global { + my $self = shift; + my ($bool) = @_; + + if(!defined $bool) { + delete $self->{global}; + return undef; + } + + $self->{global} = $bool; +} + +sub set_callback { + my $self = shift; + my ($cb) = @_; + + if(!defined $cb) { + delete $self->{callback}; + return undef; + } + + croak "callback must be a code reference" + unless ref($cb) && reftype($cb) eq 'CODE'; + + $self->{callback} = $cb; +} + +sub set_terminate { + my $self = shift; + my ($exit) = @_; + + if(!defined $exit) { + delete $self->{terminate}; + return undef; + } + + croak "terminate must be a positive integer" + unless $exit =~ m/^\d+$/; + + $self->{terminate} = $exit; +} + +sub set_sets_plan { + my $self = shift; + my ($plan) = @_; + + if(!defined $plan) { + delete $self->{sets_plan}; + return undef; + } + + croak "'sets_plan' must be an array reference" + unless ref($plan) && reftype($plan) eq 'ARRAY'; + + $self->{sets_plan} = $plan; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::Generic - Generic event type. + +=head1 DESCRIPTION + +This is a generic event that lets you customize all fields in the event API. +This is useful if you have need for a custom event that does not make sense as +a published reusable event subclass. + +=head1 SYNOPSIS + + use Test2::API qw/context/; + + sub send_custom_fail { + my $ctx = shift; + + $ctx->send_event('Generic', causes_fail => 1, summary => 'The sky is falling'); + + $ctx->release; + } + + send_custom_fail(); + +=head1 METHODS + +=over 4 + +=item $e->facet_data($data) + +=item $data = $e->facet_data + +Get or set the facet data (see L<Test2::Event>). If no facet_data is set then +C<< Test2::Event->facet_data >> will be called to produce facets from the other +data. + +=item $e->callback($hub) + +Call the custom callback if one is set, otherwise this does nothing. + +=item $e->set_callback(sub { ... }) + +Set the custom callback. The custom callback must be a coderef. The first +argument to your callback will be the event itself, the second will be the +L<Test2::Event::Hub> that is using the callback. + +=item $bool = $e->causes_fail + +=item $e->set_causes_fail($bool) + +Get/Set the C<causes_fail> attribute. This defaults to C<0>. + +=item $bool = $e->diagnostics + +=item $e->set_diagnostics($bool) + +Get/Set the C<diagnostics> attribute. This defaults to C<0>. + +=item $bool_or_undef = $e->global + +=item @bool_or_empty = $e->global + +=item $e->set_global($bool_or_undef) + +Get/Set the C<diagnostics> attribute. This defaults to an empty list which is +undef in scalar context. + +=item $bool = $e->increments_count + +=item $e->set_increments_count($bool) + +Get/Set the C<increments_count> attribute. This defaults to C<0>. + +=item $bool = $e->no_display + +=item $e->set_no_display($bool) + +Get/Set the C<no_display> attribute. This defaults to C<0>. + +=item @plan = $e->sets_plan + +Get the plan if this event sets one. The plan is a list of up to 3 items: +C<($count, $directive, $reason)>. C<$count> must be defined, the others may be +undef, or may not exist at all. + +=item $e->set_sets_plan(\@plan) + +Set the plan. You must pass in an arrayref with up to 3 elements. + +=item $summary = $e->summary + +=item $e->set_summary($summary_or_undef) + +Get/Set the summary. This will default to the event package +C<'Test2::Event::Generic'>. You can set it to any value. Setting this to +C<undef> will reset it to the default. + +=item $int_or_undef = $e->terminate + +=item @int_or_empty = $e->terminate + +=item $e->set_terminate($int_or_undef) + +This will get/set the C<terminate> attribute. This defaults to undef in scalar +context, or an empty list in list context. Setting this to undef will clear it +completely. This must be set to a positive integer (0 or larger). + +=back + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://dev.perl.org/licenses/> + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Note.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Note.pm new file mode 100644 index 0000000000..2fb1d0d6b9 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Note.pm @@ -0,0 +1,97 @@ +package Test2::Event::Note; +use strict; +use warnings; + +our $VERSION = '1.302133'; + + +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } +use Test2::Util::HashBase qw/message/; + +sub init { + $_[0]->{+MESSAGE} = 'undef' unless defined $_[0]->{+MESSAGE}; +} + +sub summary { $_[0]->{+MESSAGE} } + +sub facet_data { + my $self = shift; + + my $out = $self->common_facet_data; + + $out->{info} = [ + { + tag => 'NOTE', + debug => 0, + details => $self->{+MESSAGE}, + } + ]; + + return $out; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::Note - Note event type + +=head1 DESCRIPTION + +Notes, typically rendered to STDOUT. + +=head1 SYNOPSIS + + use Test2::API qw/context/; + use Test2::Event::Note; + + my $ctx = context(); + my $event = $ctx->Note($message); + +=head1 ACCESSORS + +=over 4 + +=item $note->message + +The message for the note. + +=back + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://dev.perl.org/licenses/> + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Ok.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Ok.pm new file mode 100644 index 0000000000..fb9a8db529 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Ok.pm @@ -0,0 +1,162 @@ +package Test2::Event::Ok; +use strict; +use warnings; + +our $VERSION = '1.302133'; + + +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } +use Test2::Util::HashBase qw{ + pass effective_pass name todo +}; + +sub init { + my $self = shift; + + # Do not store objects here, only true or false + $self->{+PASS} = $self->{+PASS} ? 1 : 0; + $self->{+EFFECTIVE_PASS} = $self->{+PASS} || (defined($self->{+TODO}) ? 1 : 0); +} + +{ + no warnings 'redefine'; + sub set_todo { + my $self = shift; + my ($todo) = @_; + $self->{+TODO} = $todo; + $self->{+EFFECTIVE_PASS} = defined($todo) ? 1 : $self->{+PASS}; + } +} + +sub increments_count { 1 }; + +sub causes_fail { !$_[0]->{+EFFECTIVE_PASS} } + +sub summary { + my $self = shift; + + my $name = $self->{+NAME} || "Nameless Assertion"; + + my $todo = $self->{+TODO}; + if ($todo) { + $name .= " (TODO: $todo)"; + } + elsif (defined $todo) { + $name .= " (TODO)" + } + + return $name; +} + +sub extra_amnesty { + my $self = shift; + return unless defined($self->{+TODO}) || ($self->{+EFFECTIVE_PASS} && !$self->{+PASS}); + return { + tag => 'TODO', + details => $self->{+TODO}, + }; +} + +sub facet_data { + my $self = shift; + + my $out = $self->common_facet_data; + + $out->{assert} = { + no_debug => 1, # Legacy behavior + pass => $self->{+PASS}, + details => $self->{+NAME}, + }; + + if (my @exra_amnesty = $self->extra_amnesty) { + unshift @{$out->{amnesty}} => @exra_amnesty; + } + + return $out; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::Ok - Ok event type + +=head1 DESCRIPTION + +Ok events are generated whenever you run a test that produces a result. +Examples are C<ok()>, and C<is()>. + +=head1 SYNOPSIS + + use Test2::API qw/context/; + use Test2::Event::Ok; + + my $ctx = context(); + my $event = $ctx->ok($bool, $name, \@diag); + +or: + + my $ctx = context(); + my $event = $ctx->send_event( + 'Ok', + pass => $bool, + name => $name, + ); + +=head1 ACCESSORS + +=over 4 + +=item $rb = $e->pass + +The original true/false value of whatever was passed into the event (but +reduced down to 1 or 0). + +=item $name = $e->name + +Name of the test. + +=item $b = $e->effective_pass + +This is the true/false value of the test after TODO and similar modifiers are +taken into account. + +=back + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://dev.perl.org/licenses/> + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Pass.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Pass.pm new file mode 100644 index 0000000000..78fe1b2f3f --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Pass.pm @@ -0,0 +1,114 @@ +package Test2::Event::Pass; +use strict; +use warnings; + +our $VERSION = '1.302133'; + +use Test2::EventFacet::Info; + +BEGIN { + require Test2::Event; + our @ISA = qw(Test2::Event); + *META_KEY = \&Test2::Util::ExternalMeta::META_KEY; +} + +use Test2::Util::HashBase qw{ -name -info }; + +############## +# Old API +sub summary { "pass" } +sub increments_count { 1 } +sub causes_fail { 0 } +sub diagnostics { 0 } +sub no_display { 0 } +sub subtest_id { undef } +sub terminate { () } +sub global { () } +sub sets_plan { () } + +############## +# New API + +sub add_info { + my $self = shift; + + for my $in (@_) { + $in = {%$in} if ref($in) ne 'ARRAY'; + $in = Test2::EventFacet::Info->new($in); + + push @{$self->{+INFO}} => $in; + } +} + +sub facet_data { + my $self = shift; + + my $out = $self->common_facet_data; + + $out->{about}->{details} = 'pass'; + + $out->{assert} = {pass => 1, details => $self->{+NAME}}; + + $out->{info} = [map {{ %{$_} }} @{$self->{+INFO}}] if $self->{+INFO}; + + return $out; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::Pass - Event for a simple passing assertion + +=head1 DESCRIPTION + +This is an optimal representation of a passing assertion. + +=head1 SYNOPSIS + + use Test2::API qw/context/; + + sub pass { + my ($name) = @_; + my $ctx = context(); + $ctx->pass($name); + $ctx->release; + } + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://dev.perl.org/licenses/> + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Plan.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Plan.pm new file mode 100644 index 0000000000..a75e14d687 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Plan.pm @@ -0,0 +1,169 @@ +package Test2::Event::Plan; +use strict; +use warnings; + +our $VERSION = '1.302133'; + + +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } +use Test2::Util::HashBase qw{max directive reason}; + +use Carp qw/confess/; + +my %ALLOWED = ( + 'SKIP' => 1, + 'NO PLAN' => 1, +); + +sub init { + if ($_[0]->{+DIRECTIVE}) { + $_[0]->{+DIRECTIVE} = 'SKIP' if $_[0]->{+DIRECTIVE} eq 'skip_all'; + $_[0]->{+DIRECTIVE} = 'NO PLAN' if $_[0]->{+DIRECTIVE} eq 'no_plan'; + + confess "'" . $_[0]->{+DIRECTIVE} . "' is not a valid plan directive" + unless $ALLOWED{$_[0]->{+DIRECTIVE}}; + } + else { + confess "Cannot have a reason without a directive!" + if defined $_[0]->{+REASON}; + + confess "No number of tests specified" + unless defined $_[0]->{+MAX}; + + confess "Plan test count '" . $_[0]->{+MAX} . "' does not appear to be a valid positive integer" + unless $_[0]->{+MAX} =~ m/^\d+$/; + + $_[0]->{+DIRECTIVE} = ''; + } +} + +sub sets_plan { + my $self = shift; + return ( + $self->{+MAX}, + $self->{+DIRECTIVE}, + $self->{+REASON}, + ); +} + +sub terminate { + my $self = shift; + # On skip_all we want to terminate the hub + return 0 if $self->{+DIRECTIVE} && $self->{+DIRECTIVE} eq 'SKIP'; + return undef; +} + +sub summary { + my $self = shift; + my $max = $self->{+MAX}; + my $directive = $self->{+DIRECTIVE}; + my $reason = $self->{+REASON}; + + return "Plan is $max assertions" + if $max || !$directive; + + return "Plan is '$directive', $reason" + if $reason; + + return "Plan is '$directive'"; +} + +sub facet_data { + my $self = shift; + + my $out = $self->common_facet_data; + + $out->{control}->{terminate} = $self->{+DIRECTIVE} eq 'SKIP' ? 0 : undef + unless defined $out->{control}->{terminate}; + + $out->{plan} = {count => $self->{+MAX}}; + $out->{plan}->{details} = $self->{+REASON} if defined $self->{+REASON}; + + if (my $dir = $self->{+DIRECTIVE}) { + $out->{plan}->{skip} = 1 if $dir eq 'SKIP'; + $out->{plan}->{none} = 1 if $dir eq 'NO PLAN'; + } + + return $out; +} + + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::Plan - The event of a plan + +=head1 DESCRIPTION + +Plan events are fired off whenever a plan is declared, done testing is called, +or a subtext completes. + +=head1 SYNOPSIS + + use Test2::API qw/context/; + use Test2::Event::Plan; + + my $ctx = context(); + + # Plan for 10 tests to run + my $event = $ctx->plan(10); + + # Plan to skip all tests (will exit 0) + $ctx->plan(0, skip_all => "These tests need to be skipped"); + +=head1 ACCESSORS + +=over 4 + +=item $num = $plan->max + +Get the number of expected tests + +=item $dir = $plan->directive + +Get the directive (such as TODO, skip_all, or no_plan). + +=item $reason = $plan->reason + +Get the reason for the directive. + +=back + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://dev.perl.org/licenses/> + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Skip.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Skip.pm new file mode 100644 index 0000000000..7a2e660f51 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Skip.pm @@ -0,0 +1,127 @@ +package Test2::Event::Skip; +use strict; +use warnings; + +our $VERSION = '1.302133'; + + +BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) } +use Test2::Util::HashBase qw{reason}; + +sub init { + my $self = shift; + $self->SUPER::init; + $self->{+EFFECTIVE_PASS} = 1; +} + +sub causes_fail { 0 } + +sub summary { + my $self = shift; + my $out = $self->SUPER::summary(@_); + + if (my $reason = $self->reason) { + $out .= " (SKIP: $reason)"; + } + else { + $out .= " (SKIP)"; + } + + return $out; +} + +sub extra_amnesty { + my $self = shift; + + my @out; + + push @out => { + tag => 'TODO', + details => $self->{+TODO}, + } if defined $self->{+TODO}; + + push @out => { + tag => 'skip', + details => $self->{+REASON}, + inherited => 0, + }; + + return @out; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::Skip - Skip event type + +=head1 DESCRIPTION + +Skip events bump test counts just like L<Test2::Event::Ok> events, but +they can never fail. + +=head1 SYNOPSIS + + use Test2::API qw/context/; + use Test2::Event::Skip; + + my $ctx = context(); + my $event = $ctx->skip($name, $reason); + +or: + + my $ctx = context(); + my $event = $ctx->send_event( + 'Skip', + name => $name, + reason => $reason, + ); + +=head1 ACCESSORS + +=over 4 + +=item $reason = $e->reason + +The original true/false value of whatever was passed into the event (but +reduced down to 1 or 0). + +=back + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://www.perl.com/perl/misc/Artistic.html> + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Subtest.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Subtest.pm new file mode 100644 index 0000000000..3feb0f10ca --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Subtest.pm @@ -0,0 +1,160 @@ +package Test2::Event::Subtest; +use strict; +use warnings; + +our $VERSION = '1.302133'; + +BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) } +use Test2::Util::HashBase qw{subevents buffered subtest_id subtest_uuid}; + +sub init { + my $self = shift; + $self->SUPER::init(); + $self->{+SUBEVENTS} ||= []; + if ($self->{+EFFECTIVE_PASS}) { + $_->set_effective_pass(1) for grep { $_->can('effective_pass') } @{$self->{+SUBEVENTS}}; + } +} + +{ + no warnings 'redefine'; + + sub set_subevents { + my $self = shift; + my @subevents = @_; + + if ($self->{+EFFECTIVE_PASS}) { + $_->set_effective_pass(1) for grep { $_->can('effective_pass') } @subevents; + } + + $self->{+SUBEVENTS} = \@subevents; + } + + sub set_effective_pass { + my $self = shift; + my ($pass) = @_; + + if ($pass) { + $_->set_effective_pass(1) for grep { $_->can('effective_pass') } @{$self->{+SUBEVENTS}}; + } + elsif ($self->{+EFFECTIVE_PASS} && !$pass) { + for my $s (grep { $_->can('effective_pass') } @{$self->{+SUBEVENTS}}) { + $_->set_effective_pass(0) unless $s->can('todo') && defined $s->todo; + } + } + + $self->{+EFFECTIVE_PASS} = $pass; + } +} + +sub summary { + my $self = shift; + + my $name = $self->{+NAME} || "Nameless Subtest"; + + my $todo = $self->{+TODO}; + if ($todo) { + $name .= " (TODO: $todo)"; + } + elsif (defined $todo) { + $name .= " (TODO)"; + } + + return $name; +} + +sub facet_data { + my $self = shift; + + my $out = $self->SUPER::facet_data(); + + $out->{parent} = { + hid => $self->subtest_id, + children => [map {$_->facet_data} @{$self->{+SUBEVENTS}}], + buffered => $self->{+BUFFERED}, + }; + + return $out; +} + +sub add_amnesty { + my $self = shift; + + for my $am (@_) { + $am = {%$am} if ref($am) ne 'ARRAY'; + $am = Test2::EventFacet::Amnesty->new($am); + + push @{$self->{+AMNESTY}} => $am; + + for my $e (@{$self->{+SUBEVENTS}}) { + $e->add_amnesty($am->clone(inherited => 1)); + } + } +} + + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::Subtest - Event for subtest types + +=head1 DESCRIPTION + +This class represents a subtest. This class is a subclass of +L<Test2::Event::Ok>. + +=head1 ACCESSORS + +This class inherits from L<Test2::Event::Ok>. + +=over 4 + +=item $arrayref = $e->subevents + +Returns the arrayref containing all the events from the subtest + +=item $bool = $e->buffered + +True if the subtest is buffered, that is all subevents render at once. If this +is false it means all subevents render as they are produced. + +=back + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://dev.perl.org/licenses/> + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/TAP/Version.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/TAP/Version.pm new file mode 100644 index 0000000000..03f2621c0e --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/TAP/Version.pm @@ -0,0 +1,101 @@ +package Test2::Event::TAP::Version; +use strict; +use warnings; + +our $VERSION = '1.302133'; + +use Carp qw/croak/; + +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } +use Test2::Util::HashBase qw/version/; + +sub init { + my $self = shift; + defined $self->{+VERSION} or croak "'version' is a required attribute"; +} + +sub summary { 'TAP version ' . $_[0]->{+VERSION} } + +sub facet_data { + my $self = shift; + + my $out = $self->common_facet_data; + + $out->{about}->{details} = $self->summary; + + push @{$out->{info}} => { + tag => 'INFO', + debug => 0, + details => $self->summary, + }; + + return $out; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::TAP::Version - Event for TAP version. + +=head1 DESCRIPTION + +This event is used if a TAP formatter wishes to set a version. + +=head1 SYNOPSIS + + use Test2::API qw/context/; + use Test2::Event::Encoding; + + my $ctx = context(); + my $event = $ctx->send_event('TAP::Version', version => 42); + +=head1 METHODS + +Inherits from L<Test2::Event>. Also defines: + +=over 4 + +=item $version = $e->version + +The TAP version being parsed. + +=back + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://dev.perl.org/licenses/> + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/V2.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/V2.pm new file mode 100644 index 0000000000..86a44d4c28 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/V2.pm @@ -0,0 +1,238 @@ +package Test2::Event::V2; +use strict; +use warnings; + +our $VERSION = '1.302133'; + +use Scalar::Util qw/reftype/; +use Carp qw/croak/; + +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } + +use Test2::Util::Facets2Legacy qw{ + causes_fail diagnostics global increments_count no_display sets_plan + subtest_id summary terminate +}; + +use Test2::Util::HashBase qw/-about/; + +sub non_facet_keys { + return ( + +UUID, + Test2::Util::ExternalMeta::META_KEY(), + ); +} + +sub init { + my $self = shift; + + my $uuid; + if ($uuid = $self->{+UUID}) { + croak "uuid '$uuid' passed to constructor, but uuid '$self->{+ABOUT}->{uuid}' is already set in the 'about' facet" + if $self->{+ABOUT}->{uuid} && $self->{+ABOUT}->{uuid} ne $uuid; + + $self->{+ABOUT}->{uuid} = $uuid; + } + elsif ($uuid = $self->{+ABOUT}->{uuid}) { + $self->SUPER::set_uuid($uuid); + } + + # Clone the trace, make sure it is blessed + if (my $trace = $self->{+TRACE}) { + $self->{+TRACE} = Test2::EventFacet::Trace->new(%$trace); + } +} + +sub set_uuid { + my $self = shift; + my ($uuid) = @_; + $self->{+ABOUT}->{uuid} = $uuid; + $self->SUPER::set_uuid($uuid); +} + +sub facet_data { + my $self = shift; + my $f = { %{$self} }; + + delete $f->{$_} for $self->non_facet_keys; + + my %out; + for my $k (keys %$f) { + next if substr($k, 0, 1) eq '_'; + + my $data = $f->{$k}; + my $is_list = reftype($data) eq 'ARRAY'; + $out{$k} = $is_list ? [ map { {%{$_}} } @$data ] : {%$data}; + } + + if (my $meta = $self->meta_facet_data) { + $out{meta} = {%$meta, %{$out{meta} || {}}}; + } + + return \%out; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::V2 - Second generation event. + +=head1 DESCRIPTION + +This is the event type that should be used instead of L<Test2::Event> or its +legacy subclasses. + +=head1 SYNOPSIS + +=head2 USING A CONTEXT + + use Test2::API qw/context/; + + sub my_tool { + my $ctx = context(); + + my $event = $ctx->send_ev2(info => [{tag => 'NOTE', details => "This is a note"}]); + + $ctx->release; + + return $event; + } + +=head2 USING THE CONSTRUCTOR + + use Test2::Event::V2; + + my $e = Test2::Event::V2->new( + trace => {frame => [$PKG, $FILE, $LINE, $SUBNAME]}, + info => [{tag => 'NOTE', details => "This is a note"}], + ); + +=head1 METHODS + +This class inherits from L<Test2::Event>. + +=over 4 + +=item $fd = $e->facet_data() + +This will return a hashref of facet data. Each facet hash will be a shallow +copy of the original. + +=item $about = $e->about() + +This will return the 'about' facet hashref. + +B<NOTE:> This will return the internal hashref, not a copy. + +=item $trace = $e->trace() + +This will return the 'trace' facet, normally blessed (but this is not enforced +when the trace is set using C<set_trace()>. + +B<NOTE:> This will return the internal trace, not a copy. + +=back + +=head2 MUTATION + +=over 4 + +=item $e->add_amnesty({...}) + +Inherited from L<Test2::Event>. This can be used to add 'amnesty' facets to an +existing event. Each new item is added to the B<END> of the list. + +B<NOTE:> Items B<ARE> blessed when added. + +=item $e->add_hub({...}) + +Inherited from L<Test2::Event>. This is used by hubs to stamp events as they +pass through. New items are added to the B<START> of the list. + +B<NOTE:> Items B<ARE NOT> blessed when added. + +=item $e->set_uuid($UUID) + +Inherited from L<Test2::Event>, overridden to also vivify/mutate the 'about' +facet. + +=item $e->set_trace($trace) + +Inherited from L<Test2::Event> which allows you to change the trace. + +B<Note:> This method does not bless/clone the trace for you. Many things will +expect the trace to be blessed, so you should probably do that. + +=back + +=head2 LEGACY SUPPORT METHODS + +These are all imported from L<Test2::Util::Facets2Legacy>, see that module or +L<Test2::Event> for documentation on what they do. + +=over 4 + +=item causes_fail + +=item diagnostics + +=item global + +=item increments_count + +=item no_display + +=item sets_plan + +=item subtest_id + +=item summary + +=item terminate + +=back + +=head1 THIRD PARTY META-DATA + +This object consumes L<Test2::Util::ExternalMeta> which provides a consistent +way for you to attach meta-data to instances of this class. This is useful for +tools, plugins, and other extensions. + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://dev.perl.org/licenses/> + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Waiting.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Waiting.pm new file mode 100644 index 0000000000..58b583fd5e --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Test2/Event/Waiting.pm @@ -0,0 +1,76 @@ +package Test2::Event::Waiting; +use strict; +use warnings; + +our $VERSION = '1.302133'; + + +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } +use Test2::Util::HashBase; + +sub global { 1 }; + +sub summary { "IPC is waiting for children to finish..." } + +sub facet_data { + my $self = shift; + + my $out = $self->common_facet_data; + + push @{$out->{info}} => { + tag => 'INFO', + debug => 0, + details => $self->summary, + }; + + return $out; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Test2::Event::Waiting - Tell all procs/threads it is time to be done + +=head1 DESCRIPTION + +This event has no data of its own. This event is sent out by the IPC system +when the main process/thread is ready to end. + +=head1 SOURCE + +The source code repository for Test2 can be found at +F<http://github.com/Test-More/test-more/>. + +=head1 MAINTAINERS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 AUTHORS + +=over 4 + +=item Chad Granum E<lt>exodist@cpan.orgE<gt> + +=back + +=head1 COPYRIGHT + +Copyright 2018 Chad Granum E<lt>exodist@cpan.orgE<gt>. + +This program is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +See F<http://dev.perl.org/licenses/> + +=cut |