Had to run ./perl -Ilib regen/lib_cleanup.pl.
cpan/Test-Simple/lib/Test2/Event.pm
cpan/Test-Simple/lib/Test2/Event/Bail.pm
cpan/Test-Simple/lib/Test2/Event/Diag.pm
+cpan/Test-Simple/lib/Test2/Event/Encoding.pm
cpan/Test-Simple/lib/Test2/Event/Exception.pm
cpan/Test-Simple/lib/Test2/Event/Generic.pm
cpan/Test-Simple/lib/Test2/Event/Info.pm
cpan/Test-Simple/lib/Test2/Event/Plan.pm
cpan/Test-Simple/lib/Test2/Event/Skip.pm
cpan/Test-Simple/lib/Test2/Event/Subtest.pm
+cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm
cpan/Test-Simple/lib/Test2/Event/Waiting.pm
cpan/Test-Simple/lib/Test2/Formatter.pm
cpan/Test-Simple/lib/Test2/Formatter/TAP.pm
cpan/Test-Simple/t/Test2/behavior/Subtest_buffer_formatter.t
cpan/Test-Simple/t/Test2/behavior/Subtest_events.t
cpan/Test-Simple/t/Test2/behavior/Subtest_plan.t
+cpan/Test-Simple/t/Test2/behavior/Subtest_todo.t
cpan/Test-Simple/t/Test2/behavior/Taint.t
cpan/Test-Simple/t/Test2/legacy/TAP.t
cpan/Test-Simple/t/Test2/modules/API.t
-rmdir lib/Unicode/Collate/CJK lib/Unicode/Collate lib/Tie/Hash
-rmdir lib/Thread lib/Text lib/Test2/Util lib/Test2/IPC/Driver
-rmdir lib/Test2/IPC lib/Test2/Hub/Interceptor lib/Test2/Hub
- -rmdir lib/Test2/Formatter lib/Test2/Event lib/Test2/API lib/Test2
- -rmdir lib/Test/use lib/Test/Tester lib/Test/Builder/Tester
- -rmdir lib/Test/Builder/IO lib/Test/Builder lib/Test lib/Term
- -rmdir lib/TAP/Parser/YAMLish lib/TAP/Parser/SourceHandler
- -rmdir lib/TAP/Parser/Scheduler lib/TAP/Parser/Result
- -rmdir lib/TAP/Parser/Iterator lib/TAP/Parser lib/TAP/Harness
- -rmdir lib/TAP/Formatter/File lib/TAP/Formatter/Console
- -rmdir lib/TAP/Formatter lib/TAP lib/Sys/Syslog lib/Sys lib/Sub
- -rmdir lib/Search lib/Scalar lib/Pod/Text lib/Pod/Simple
- -rmdir lib/Pod/Perldoc lib/PerlIO/via lib/PerlIO lib/Perl
- -rmdir lib/Parse/CPAN lib/Parse lib/Params lib/Net/FTP lib/Module/Load
- -rmdir lib/Module/CoreList lib/Module lib/Memoize lib/Math/BigInt
- -rmdir lib/Math/BigFloat lib/Math lib/MIME lib/Locale/Maketext
- -rmdir lib/Locale/Codes lib/Locale lib/List/Util lib/List lib/JSON/PP
- -rmdir lib/JSON lib/IPC lib/IO/Uncompress/Adapter lib/IO/Uncompress
- -rmdir lib/IO/Socket lib/IO/Compress/Zlib lib/IO/Compress/Zip
- -rmdir lib/IO/Compress/Gzip lib/IO/Compress/Base
+ -rmdir lib/Test2/Formatter lib/Test2/Event/TAP lib/Test2/Event
+ -rmdir lib/Test2/API lib/Test2 lib/Test/use lib/Test/Tester
+ -rmdir lib/Test/Builder/Tester lib/Test/Builder/IO lib/Test/Builder
+ -rmdir lib/Test lib/Term lib/TAP/Parser/YAMLish
+ -rmdir lib/TAP/Parser/SourceHandler lib/TAP/Parser/Scheduler
+ -rmdir lib/TAP/Parser/Result lib/TAP/Parser/Iterator lib/TAP/Parser
+ -rmdir lib/TAP/Harness lib/TAP/Formatter/File
+ -rmdir lib/TAP/Formatter/Console lib/TAP/Formatter lib/TAP
+ -rmdir lib/Sys/Syslog lib/Sys lib/Sub lib/Search lib/Scalar
+ -rmdir lib/Pod/Text lib/Pod/Simple lib/Pod/Perldoc lib/PerlIO/via
+ -rmdir lib/PerlIO lib/Perl lib/Parse/CPAN lib/Parse lib/Params
+ -rmdir lib/Net/FTP lib/Module/Load lib/Module/CoreList lib/Module
+ -rmdir lib/Memoize lib/Math/BigInt lib/Math/BigFloat lib/Math lib/MIME
+ -rmdir lib/Locale/Maketext lib/Locale/Codes lib/Locale lib/List/Util
+ -rmdir lib/List lib/JSON/PP lib/JSON lib/IPC lib/IO/Uncompress/Adapter
+ -rmdir lib/IO/Uncompress lib/IO/Socket lib/IO/Compress/Zlib
+ -rmdir lib/IO/Compress/Zip lib/IO/Compress/Gzip lib/IO/Compress/Base
-rmdir lib/IO/Compress/Adapter lib/IO/Compress lib/IO
-rmdir lib/I18N/LangTags lib/I18N lib/Hash/Util lib/Hash lib/HTTP
-rmdir lib/Filter/Util lib/Filter lib/File/Spec lib/ExtUtils/Typemaps
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN {
if( $] < 5.008 ) {
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN { require Test2::Formatter::TAP; our @ISA = qw(Test2::Formatter::TAP) }
require Exporter;
our @ISA = qw(Exporter);
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
=head1 NAME
package Test::Builder::Tester;
use strict;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use Test::Builder;
use Symbol;
package Test::Builder::Tester::Color;
use strict;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
require Test::Builder::Tester;
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN { require Test2::Event::Diag; our @ISA = qw(Test2::Event::Diag) }
return warn @_, " at $file line $line\n";
}
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use Test::Builder::Module;
our @ISA = qw(Test::Builder::Module);
use strict;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use Test::Builder::Module;
our @ISA = qw(Test::Builder::Module);
use vars qw( @ISA @EXPORT );
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
@EXPORT = qw( run_tests check_tests check_test cmp_results show_space );
@ISA = qw( Exporter );
package Test::Tester::Capture;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use Test::Builder;
package Test::Tester::CaptureRunner;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use Test::Tester::Capture;
package Test::Tester::Delegate;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use Scalar::Util();
package Test::use::ok;
use 5.005;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
__END__
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
1;
$ENV{TEST2_ACTIVE} = 1;
}
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
my $INST;
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use Test2::Util qw/pkg_to_file/;
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use Carp qw/confess croak longmess/;
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
our @CARP_NOT = qw/Test2::API Test2::API::Instance Test2::IPC::Driver Test2::Formatter/;
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use Test2::Hub();
use strict;
use warnings;
-our $VERSION = '1.302067';
-
+our $VERSION = '1.302071';
use Test2::Util::HashBase qw/trace nested in_subtest subtest_id/;
use Test2::Util::ExternalMeta qw/meta get_meta set_meta delete_meta/;
+use Test2::Util qw(pkg_to_file);
+use Test2::Util::Trace;
sub causes_fail { 0 }
sub increments_count { 0 }
sub summary { ref($_[0]) }
+sub from_json {
+ my $class = shift;
+ my %p = @_;
+
+ my $event_pkg = delete $p{__PACKAGE__};
+ require(pkg_to_file($event_pkg));
+
+ if (exists $p{trace}) {
+ $p{trace} = Test2::Util::Trace->from_json(%{$p{trace}});
+ }
+
+ if (exists $p{subevents}) {
+ my @subevents;
+ for my $subevent (@{delete $p{subevents} || []}) {
+ push @subevents, Test2::Event->from_json(%$subevent);
+ }
+ $p{subevents} = \@subevents;
+ }
+
+ return $event_pkg->new(%p);
+}
+
+sub TO_JSON {
+ my $self = shift;
+ return {%$self, __PACKAGE__ => ref $self};
+}
+
1;
__END__
If the event is a final subtest event, this should contain the subtest ID.
+=item $hashref = $e->TO_JSON
+
+This returns a hashref suitable for passing to the C<< Test2::Event->from_json
+>> constructor. It is intended for use with the L<JSON> family of modules,
+which will look for a C<TO_JSON> method when C<convert_blessed> is true.
+
+=item $e = Test2::Event->from_json(%$hashref)
+
+Given the hash of data returned by C<< $e->TO_JSON >>, this method returns a
+new event object of the appropriate subclass.
+
=back
=head1 THIRD PARTY META-DATA
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
--- /dev/null
+package Test2::Event::Encoding;
+use strict;
+use warnings;
+
+our $VERSION = '1.302071';
+
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
+use Test2::Util::HashBase qw/encoding/;
+
+sub init {
+ my $self = shift;
+ defined $self->{+ENCODING} or $self->trace->throw("'encoding' is a required attribute");
+}
+
+sub summary { 'Encoding set to ' . $_[0]->{+ENCODING} }
+
+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 2016 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
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use Carp qw/croak/;
use Scalar::Util qw/reftype/;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use Test2::Util::HashBase;
use Scalar::Util qw/blessed/;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use Test2::Util::HashBase qw/diagnostics renderer/;
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
use Test2::Util::HashBase qw{subevents buffered subtest_id};
sub init {
- my $self = shift;
- $self->SUPER::init();
- $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;
+ }
}
sub summary {
--- /dev/null
+package Test2::Event::TAP::Version;
+use strict;
+use warnings;
+
+our $VERSION = '1.302071';
+
+BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
+use Test2::Util::HashBase qw/version/;
+
+sub init {
+ my $self = shift;
+ defined $self->{+VERSION} or $self->trace->throw("'version' is a required attribute");
+}
+
+sub summary { 'TAP version ' . $_[0]->{+VERSION} }
+
+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 2016 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
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
my %ADDED;
use warnings;
require PerlIO;
-our $VERSION = '1.302067';
-
+our $VERSION = '1.302071';
use Test2::Util::HashBase qw{
no_numbers handles _encoding
BEGIN { require Test2::Formatter; our @ISA = qw(Test2::Formatter) }
my %CONVERTERS = (
- 'Test2::Event::Ok' => 'event_ok',
- 'Test2::Event::Skip' => 'event_skip',
- 'Test2::Event::Note' => 'event_note',
- 'Test2::Event::Diag' => 'event_diag',
- 'Test2::Event::Bail' => 'event_bail',
- 'Test2::Event::Exception' => 'event_exception',
- 'Test2::Event::Subtest' => 'event_subtest',
- 'Test2::Event::Plan' => 'event_plan',
+ 'Test2::Event::Ok' => 'event_ok',
+ 'Test2::Event::Skip' => 'event_skip',
+ 'Test2::Event::Note' => 'event_note',
+ 'Test2::Event::Diag' => 'event_diag',
+ 'Test2::Event::Bail' => 'event_bail',
+ 'Test2::Event::Exception' => 'event_exception',
+ 'Test2::Event::Subtest' => 'event_subtest',
+ 'Test2::Event::Plan' => 'event_plan',
+ 'Test2::Event::TAP::Version' => 'event_version',
);
# Initial list of converters are safe for direct hash access cause we control them.
return [OUT_STD, "$plan\n"];
}
+sub event_version {
+ my $self = shift;
+ my ($e, $num) = @_;
+
+ my $version = $e->version;
+
+ return [OUT_STD, "TAP version $version\n"];
+}
+
sub event_other {
my $self = shift;
my ($e, $num) = @_;
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use Carp qw/carp croak confess/;
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use Test2::Hub::Interceptor::Terminator();
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
1;
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) }
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use Test2::API::Instance;
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use Carp qw/confess longmess/;
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
BEGIN { require Test2::IPC::Driver; our @ISA = qw(Test2::IPC::Driver) }
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use Config qw/%Config/;
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use Carp qw/croak/;
use strict;
use warnings;
-our $VERSION = '1.302067';
+#################################################################
+# #
+# This is a generated file! Do not modify this file directly! #
+# Use hashbase_inc.pl script to regenerate this file. #
+# The script is part of the Object::HashBase distribution. #
+# #
+#################################################################
+
+{
+ no warnings 'once';
+ $Test2::Util::HashBase::VERSION = '0.002';
+ *Test2::Util::HashBase::ATTR_SUBS = \%Object::HashBase::ATTR_SUBS;
+}
require Carp;
-$Carp::Internal{+__PACKAGE__} = 1;
-
-my %ATTR_SUBS;
+{
+ no warnings 'once';
+ $Carp::Internal{+__PACKAGE__} = 1;
+}
BEGIN {
# these are not strictly equivalent, but for out use we don't care
}
}
+my %STRIP = (
+ '^' => 1,
+ '-' => 1,
+);
+
sub import {
my $class = shift;
- my $into = caller;
+ my $into = caller;
- my $isa = _isa($into);
- my $attr_subs = $ATTR_SUBS{$into} ||= {};
- my %subs = (
+ my $isa = _isa($into);
+ my $attr_subs = $Test2::Util::HashBase::ATTR_SUBS{$into} ||= {};
+ my %subs = (
($into->can('new') ? () : (new => \&_new)),
- (map %{ $ATTR_SUBS{$_}||{} }, @{$isa}[1 .. $#$isa]),
- (map {
- my ($sub, $attr) = (uc $_, $_);
- $sub => ($attr_subs->{$sub} = sub() { $attr }),
- $attr => sub { $_[0]->{$attr} },
- "set_$attr" => sub { $_[0]->{$attr} = $_[1] },
- } @_),
+ (map %{$Test2::Util::HashBase::ATTR_SUBS{$_} || {}}, @{$isa}[1 .. $#$isa]),
+ (
+ map {
+ my $p = substr($_, 0, 1);
+ my $x = $_;
+ substr($x, 0, 1) = '' if $STRIP{$p};
+ my ($sub, $attr) = (uc $x, $x);
+ $sub => ($attr_subs->{$sub} = sub() { $attr }),
+ $attr => sub { $_[0]->{$attr} },
+ $p eq '-' ? ("set_$attr" => sub { Carp::croak("'$attr' is read-only") })
+ : $p eq '^' ? ("set_$attr" => sub { Carp::carp("set_$attr() is deprecated"); $_[0]->{$attr} = $_[1] })
+ : ("set_$attr" => sub { $_[0]->{$attr} = $_[1] }),
+ } @_
+ ),
);
no strict 'refs';
=head1 NAME
-Test2::Util::HashBase - Base class for classes that use a hashref
-of a hash.
+Test2::Util::HashBase - Build hash based classes.
=head1 SYNOPSIS
use warnings;
# Generate 3 accessors
- use Test2::Util::HashBase qw/foo bar baz/;
+ use Test2::Util::HashBase qw/foo -bar ^baz/;
# Chance to initialize defaults
sub init {
# We get the constants from the base class for free.
$self->{+FOO} ||= 'SubFoo';
- $self->{+BAT} || = 'bat';
+ $self->{+BAT} ||= 'bat';
$self->SUPER::init();
}
# Setters!
$one->set_foo('A Foo');
- $one->set_bar('A Bar');
+
+ #'-bar' means read-only, so the setter will throw an exception (but is defined).
+ $one->set_bar('A bar');
+
+ # '^baz' means deprecated setter, this will warn about the setter being
+ # deprecated.
$one->set_baz('A Baz');
$one->{+FOO} = 'xxx';
return the key into the hash for that accessor. Single inheritance is also
supported.
+=head1 THIS IS A BUNDLED COPY OF HASHBASE
+
+This is a bundled copy of L<Object::HashBase>. This file was generated using
+the
+C</home/exodist/perl5/perlbrew/perls/main/bin/hashbase_inc.pl>
+script.
+
=head1 METHODS
=head2 PROVIDED BY HASH BASE
=head1 SOURCE
-The source code repository for Test2 can be found at
-F<http://github.com/Test-More/test-more/>.
+The source code repository for HashBase can be found at
+F<http://github.com/Test-More/HashBase/>.
=head1 MAINTAINERS
use strict;
use warnings;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
-use Test2::Util qw/get_tid/;
+use Test2::Util qw/get_tid pkg_to_file/;
use Carp qw/confess/;
sub line { $_[0]->{+FRAME}->[2] }
sub subname { $_[0]->{+FRAME}->[3] }
+sub from_json {
+ my $class = shift;
+ my %p = @_;
+
+ my $trace_pkg = delete $p{__PACKAGE__};
+ require(pkg_to_file($trace_pkg));
+
+ return $trace_pkg->new(%p);
+}
+
+sub TO_JSON {
+ my $self = shift;
+ return {%$self, __PACKAGE__ => ref $self};
+}
+
1;
__END__
Get the debug-info subroutine name.
+=item $hashref = $t->TO_JSON
+
+This returns a hashref suitable for passing to the C<<
+Test2::Util::Trace->from_json >> constructor. It is intended for use with the
+L<JSON> family of modules, which will look for a C<TO_JSON> method when
+C<convert_blessed> is true.
+
+=item $t = Test2::Util::Trace->from_json(%$hashref)
+
+Given the hash of data returned by C<< $t->TO_JSON >>, this method returns a
+new trace object of the appropriate subclass.
+
=back
=head1 SOURCE
package ok;
-our $VERSION = '1.302067';
+our $VERSION = '1.302071';
use strict;
use Test::More ();
--- /dev/null
+use strict;
+use warnings;
+
+BEGIN { require "t/tools.pl" }
+
+use Test2::API qw/run_subtest intercept/;
+
+my $events = intercept {
+ todo 'testing todo', sub {
+ run_subtest(
+ 'fails in todo',
+ sub {
+ ok(1, 'first passes');
+ ok(0, 'second fails');
+ });
+ };
+};
+
+ok($events->[1], 'Test2::Event::Subtest', 'subtest ran');
+ok($events->[1]->effective_pass, 'Test2::Event::Subtest', 'subtest effective_pass is true');
+ok($events->[1]->todo, 'testing todo', 'subtest todo is set to expected value');
+my @oks = grep { $_->isa('Test2::Event::Ok') } @{$events->[1]->subevents};
+is(scalar @oks, 2, 'got 2 Ok events in the subtest');
+ok($oks[0]->pass, 'first event passed');
+ok($oks[0]->effective_pass, 'first event effective_pass is true');
+ok(!$oks[1]->pass, 'second event failed');
+ok($oks[1]->effective_pass, 'second event effective_pass is true');
+
+done_testing;
);
};
+tests version => sub {
+ require Test2::Event::TAP::Version;
+ my $ver = Test2::Event::TAP::Version->new(
+ trace => $trace,
+ version => '2',
+ );
+
+ is_deeply(
+ [$fmt->event_tap($ver, 1)],
+ [[OUT_STD, "TAP version 2\n"]],
+ "Got tap"
+ );
+};
+
+
done_testing;
use strict;
use warnings;
-BEGIN { require "t/tools.pl" };
+
+use Test::More;
+
+
+sub warnings(&) {
+ my $code = shift;
+ my @warnings;
+ local $SIG{__WARN__} = sub { push @warnings => @_ };
+ $code->();
+ return \@warnings;
+}
+
+sub exception(&) {
+ my $code = shift;
+ local ($@, $!, $SIG{__DIE__});
+ my $ok = eval { $code->(); 1 };
+ my $error = $@ || 'SQUASHED ERROR';
+ return $ok ? undef : $error;
+}
+
BEGIN {
- $INC{'My/HBase.pm'} = __FILE__;
+ $INC{'Object/HashBase/Test/HBase.pm'} = __FILE__;
- package My::HBase;
+ package
+ main::HBase;
use Test2::Util::HashBase qw/foo bar baz/;
main::is(FOO, 'foo', "FOO CONSTANT");
}
BEGIN {
- package My::HBaseSub;
- use base 'My::HBase';
+ package
+ main::HBaseSub;
+ use base 'main::HBase';
use Test2::Util::HashBase qw/apple pear/;
main::is(FOO, 'foo', "FOO CONSTANT");
main::is(PEAR, 'pear', "PEAR CONSTANT");
}
-my $one = My::HBase->new(foo => 'a', bar => 'b', baz => 'c');
+my $one = main::HBase->new(foo => 'a', bar => 'b', baz => 'c');
is($one->foo, 'a', "Accessor");
is($one->bar, 'b', "Accessor");
is($one->baz, 'c', "Accessor");
);
BEGIN {
- package My::Const::Test;
+ package
+ main::Const::Test;
use Test2::Util::HashBase qw/foo/;
sub do_it {
}
}
-my $pkg = 'My::Const::Test';
+my $pkg = 'main::Const::Test';
is($pkg->do_it, 'const', "worked as expected");
{
local $SIG{__WARN__} = sub { };
- *My::Const::Test::FOO = sub { 0 };
+ *main::Const::Test::FOO = sub { 0 };
}
ok(!$pkg->FOO, "overrode const sub");
is($pkg->do_it, 'const', "worked as expected, const was constant");
BEGIN {
- $INC{'My/HBase/Wrapped.pm'} = __FILE__;
+ $INC{'Object/HashBase/Test/HBase/Wrapped.pm'} = __FILE__;
- package My::HBase::Wrapped;
+ package
+ main::HBase::Wrapped;
use Test2::Util::HashBase qw/foo bar/;
my $foo = __PACKAGE__->can('foo');
}
BEGIN {
- $INC{'My/HBase/Wrapped/Inherit.pm'} = __FILE__;
+ $INC{'Object/HashBase/Test/HBase/Wrapped/Inherit.pm'} = __FILE__;
- package My::HBase::Wrapped::Inherit;
- use base 'My::HBase::Wrapped';
+ package
+ main::HBase::Wrapped::Inherit;
+ use base 'main::HBase::Wrapped';
use Test2::Util::HashBase;
}
-my $o = My::HBase::Wrapped::Inherit->new(foo => 1);
+my $o = main::HBase::Wrapped::Inherit->new(foo => 1);
my $foo = $o->foo;
is($o->bar, 1, 'parent attribute sub not overridden');
{
- package Foo;
+ package
+ Foo;
sub new;
is(Foo->new, 'foo', "Did not override existing 'new' method");
+BEGIN {
+ $INC{'Object/HashBase/Test/HBase2.pm'} = __FILE__;
+
+ package
+ main::HBase2;
+ use Test2::Util::HashBase qw/foo -bar ^baz/;
+
+ main::is(FOO, 'foo', "FOO CONSTANT");
+ main::is(BAR, 'bar', "BAR CONSTANT");
+ main::is(BAZ, 'baz', "BAZ CONSTANT");
+}
+
+my $ro = main::HBase2->new(foo => 'foo', bar => 'bar', baz => 'baz');
+is($ro->foo, 'foo', "got foo");
+is($ro->bar, 'bar', "got bar");
+is($ro->baz, 'baz', "got baz");
+
+is($ro->set_foo('xxx'), 'xxx', "Can set foo");
+is($ro->foo, 'xxx', "got foo");
+
+like(exception { $ro->set_bar('xxx') }, qr/'bar' is read-only/, "Cannot set bar");
+
+my $warnings = warnings { is($ro->set_baz('xxx'), 'xxx', 'set baz') };
+like($warnings->[0], qr/set_baz\(\) is deprecated/, "Deprecation warning");
+
done_testing;
+
+1;
$ctx->release if $ctx;
}
+sub todo {
+ my ($reason, $sub) = @_;
+ my $ctx = context();
+
+ # This code is mostly copied from Test2::Todo in the Test2-Suite
+ # distribution.
+ my $hub = test2_stack->top;
+ my $filter = $hub->pre_filter(
+ sub {
+ my ($active_hub, $event) = @_;
+
+ # Turn a diag into a note
+ return Test2::Event::Note->new(%$event) if ref($event) eq 'Test2::Event::Diag';
+
+ # Set todo on ok's
+ if ($hub == $active_hub && $event->isa('Test2::Event::Ok')) {
+ $event->set_todo($reason);
+ $event->set_effective_pass(1);
+ }
+
+ return $event;
+ },
+ inherit => 1,
+ todo => $reason,
+ );
+ $sub->();
+ $hub->pre_unfilter($filter);
+
+ $ctx->release if $ctx;
+}
+
sub plan {
my ($max) = @_;
my $ctx = context();
https://perl5.git.perl.org / perl5.git / commitdiff