Initial Commit
This commit is contained in:
109
database/perl/lib/Test2/Event/Bail.pm
Normal file
109
database/perl/lib/Test2/Event/Bail.pm
Normal file
@@ -0,0 +1,109 @@
|
||||
package Test2::Event::Bail;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.302183';
|
||||
|
||||
|
||||
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 2020 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
|
||||
99
database/perl/lib/Test2/Event/Diag.pm
Normal file
99
database/perl/lib/Test2/Event/Diag.pm
Normal file
@@ -0,0 +1,99 @@
|
||||
package Test2::Event::Diag;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.302183';
|
||||
|
||||
|
||||
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 2020 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
|
||||
97
database/perl/lib/Test2/Event/Encoding.pm
Normal file
97
database/perl/lib/Test2/Event/Encoding.pm
Normal file
@@ -0,0 +1,97 @@
|
||||
package Test2::Event::Encoding;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.302183';
|
||||
|
||||
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 2020 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
|
||||
113
database/perl/lib/Test2/Event/Exception.pm
Normal file
113
database/perl/lib/Test2/Event/Exception.pm
Normal file
@@ -0,0 +1,113 @@
|
||||
package Test2::Event::Exception;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.302183';
|
||||
|
||||
|
||||
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 2020 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
|
||||
118
database/perl/lib/Test2/Event/Fail.pm
Normal file
118
database/perl/lib/Test2/Event/Fail.pm
Normal file
@@ -0,0 +1,118 @@
|
||||
package Test2::Event::Fail;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.302183';
|
||||
|
||||
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 2020 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
|
||||
280
database/perl/lib/Test2/Event/Generic.pm
Normal file
280
database/perl/lib/Test2/Event/Generic.pm
Normal file
@@ -0,0 +1,280 @@
|
||||
package Test2::Event::Generic;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Carp qw/croak/;
|
||||
use Scalar::Util qw/reftype/;
|
||||
|
||||
our $VERSION = '1.302183';
|
||||
|
||||
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 2020 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
|
||||
97
database/perl/lib/Test2/Event/Note.pm
Normal file
97
database/perl/lib/Test2/Event/Note.pm
Normal file
@@ -0,0 +1,97 @@
|
||||
package Test2::Event::Note;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.302183';
|
||||
|
||||
|
||||
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 2020 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
|
||||
169
database/perl/lib/Test2/Event/Ok.pm
Normal file
169
database/perl/lib/Test2/Event/Ok.pm
Normal file
@@ -0,0 +1,169 @@
|
||||
package Test2::Event::Ok;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.302183';
|
||||
|
||||
|
||||
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) {
|
||||
my %seen;
|
||||
|
||||
# It is possible the extra amnesty can be a duplicate, so filter it.
|
||||
$out->{amnesty} = [
|
||||
grep { !$seen{defined($_->{tag}) ? $_->{tag} : ''}->{defined($_->{details}) ? $_->{details} : ''}++ }
|
||||
@exra_amnesty,
|
||||
@{$out->{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 2020 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
|
||||
114
database/perl/lib/Test2/Event/Pass.pm
Normal file
114
database/perl/lib/Test2/Event/Pass.pm
Normal file
@@ -0,0 +1,114 @@
|
||||
package Test2::Event::Pass;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.302183';
|
||||
|
||||
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 2020 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
|
||||
169
database/perl/lib/Test2/Event/Plan.pm
Normal file
169
database/perl/lib/Test2/Event/Plan.pm
Normal file
@@ -0,0 +1,169 @@
|
||||
package Test2::Event::Plan;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.302183';
|
||||
|
||||
|
||||
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 2020 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
|
||||
127
database/perl/lib/Test2/Event/Skip.pm
Normal file
127
database/perl/lib/Test2/Event/Skip.pm
Normal file
@@ -0,0 +1,127 @@
|
||||
package Test2::Event::Skip;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.302183';
|
||||
|
||||
|
||||
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 2020 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
|
||||
160
database/perl/lib/Test2/Event/Subtest.pm
Normal file
160
database/perl/lib/Test2/Event/Subtest.pm
Normal file
@@ -0,0 +1,160 @@
|
||||
package Test2::Event::Subtest;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.302183';
|
||||
|
||||
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 2020 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
|
||||
101
database/perl/lib/Test2/Event/TAP/Version.pm
Normal file
101
database/perl/lib/Test2/Event/TAP/Version.pm
Normal file
@@ -0,0 +1,101 @@
|
||||
package Test2::Event::TAP::Version;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.302183';
|
||||
|
||||
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 2020 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
|
||||
239
database/perl/lib/Test2/Event/V2.pm
Normal file
239
database/perl/lib/Test2/Event/V2.pm
Normal file
@@ -0,0 +1,239 @@
|
||||
package Test2::Event::V2;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.302183';
|
||||
|
||||
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 ($self->{+ABOUT} && $self->{+ABOUT}->{uuid}) {
|
||||
$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} or next; # Key is there, but no facet
|
||||
my $is_list = 'ARRAY' eq (reftype($data) || '');
|
||||
$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 2020 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
|
||||
76
database/perl/lib/Test2/Event/Waiting.pm
Normal file
76
database/perl/lib/Test2/Event/Waiting.pm
Normal file
@@ -0,0 +1,76 @@
|
||||
package Test2::Event::Waiting;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
our $VERSION = '1.302183';
|
||||
|
||||
|
||||
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 2020 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
|
||||
Reference in New Issue
Block a user