summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Test2/Event/Subtest.pm
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2019-03-10 21:56:14 +0000
committerKarl Berry <karl@freefriends.org>2019-03-10 21:56:14 +0000
commite0a2a718e89f9700d627f1e6a8eea8f21d2fbeb8 (patch)
tree39972f65008b0d70f306a5f976494d29411bc41e /Master/tlpkg/tlperl/lib/Test2/Event/Subtest.pm
parentb206fdc77d81ed1600949062f08de5690a4bf66f (diff)
tl19 perl 5.28.1 for Windows, from Siep
git-svn-id: svn://tug.org/texlive/trunk@50322 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Test2/Event/Subtest.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Test2/Event/Subtest.pm107
1 files changed, 68 insertions, 39 deletions
diff --git a/Master/tlpkg/tlperl/lib/Test2/Event/Subtest.pm b/Master/tlpkg/tlperl/lib/Test2/Event/Subtest.pm
index 2b3c773bf67..3feb0f10ca7 100755
--- a/Master/tlpkg/tlperl/lib/Test2/Event/Subtest.pm
+++ b/Master/tlpkg/tlperl/lib/Test2/Event/Subtest.pm
@@ -2,50 +2,49 @@ package Test2::Event::Subtest;
use strict;
use warnings;
-our $VERSION = '1.302073';
-
+our $VERSION = '1.302133';
BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
-use Test2::Util::HashBase qw{subevents buffered subtest_id};
+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}};
- }
+ 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;
- }
+ 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 {
@@ -58,12 +57,42 @@ sub summary {
$name .= " (TODO: $todo)";
}
elsif (defined $todo) {
- $name .= " (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__
@@ -121,7 +150,7 @@ F<http://github.com/Test-More/test-more/>.
=head1 COPYRIGHT
-Copyright 2016 Chad Granum E<lt>exodist@cpan.orgE<gt>.
+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.