Your IP : 216.73.216.86
PK 1��\���4� � examples/indent.plnu �[��� #!/usr/bin/env perl
use strict;
use warnings;
use lib '../lib';
use Test::Builder;
=head1 NOTES
Must have explicit finalize
Must name nest
Trailing summary test
Pass chunk o'TAP
No builder may have more than one child active
What happens if you call ->finalize with open children
=cut
my $builder = Test::Builder->new;
$builder->plan(tests => 7);
for( 1 .. 3 ) {
$builder->ok( $_, "We're on $_" );
$builder->note("We ran $_");
}
{
my $indented = $builder->child;
$indented->plan('no_plan');
for( 1 .. 1+int(rand(5)) ) {
$indented->ok( 1, "We're on $_" );
}
$indented->finalize;
}
for( 7, 8, 9 ) {
$builder->ok( $_, "We're on $_" );
}
PK 1��\��W \ \ examples/subtest.tnu �[��� #!/usr/bin/env perl
use strict;
use warnings;
use lib '../lib';
use Test::More tests => 3;
ok 1;
subtest 'some name' => sub {
my $num_tests = 2 + int( rand(3) );
plan tests => $num_tests;
ok 1 for 1 .. $num_tests - 1;
subtest 'some name' => sub {
plan 'no_plan';
ok 1 for 1 .. 2 + int( rand(3) );
};
};
ok 1;
PK 1��\�w�Z� � examples/tools.plnu �[��� package Test2::Example;
use Scalar::Util qw/blessed/;
use Test2::Util qw/try/;
use Test2 qw/context run_subtest/;
use Test2::Hub::Interceptor();
use Test2::Hub::Interceptor::Terminator();
sub ok($;$@) {
my ($bool, $name, @diag) = @_;
my $ctx = context();
$ctx->ok($bool, $name, \@diag);
$ctx->release;
return $bool ? 1 : 0;
}
sub is($$;$@) {
my ($got, $want, $name, @diag) = @_;
my $ctx = context();
my $bool;
if (defined($got) && defined($want)) {
$bool = "$got" eq "$want";
}
elsif (defined($got) xor defined($want)) {
$bool = 0;
}
else { # Both are undef
$bool = 1;
}
unless ($bool) {
$got = '*NOT DEFINED*' unless defined $got;
$want = '*NOT DEFINED*' unless defined $want;
unshift @diag => (
"GOT: $got",
"EXPECTED: $want",
);
}
$ctx->ok($bool, $name, \@diag);
$ctx->release;
return $bool;
}
sub isnt($$;$@) {
my ($got, $want, $name, @diag) = @_;
my $ctx = context();
my $bool;
if (defined($got) && defined($want)) {
$bool = "$got" ne "$want";
}
elsif (defined($got) xor defined($want)) {
$bool = 1;
}
else { # Both are undef
$bool = 0;
}
unshift @diag => "Strings are the same (they should not be)"
unless $bool;
$ctx->ok($bool, $name, \@diag);
$ctx->release;
return $bool;
}
sub like($$;$@) {
my ($thing, $pattern, $name, @diag) = @_;
my $ctx = context();
my $bool;
if (defined($thing)) {
$bool = "$thing" =~ $pattern;
unshift @diag => (
"Value: $thing",
"Does not match: $pattern"
) unless $bool;
}
else {
$bool = 0;
unshift @diag => "Got an undefined value.";
}
$ctx->ok($bool, $name, \@diag);
$ctx->release;
return $bool;
}
sub unlike($$;$@) {
my ($thing, $pattern, $name, @diag) = @_;
my $ctx = context();
my $bool;
if (defined($thing)) {
$bool = "$thing" !~ $pattern;
unshift @diag => (
"Unexpected pattern match (it should not match)",
"Value: $thing",
"Matches: $pattern"
) unless $bool;
}
else {
$bool = 0;
unshift @diag => "Got an undefined value.";
}
$ctx->ok($bool, $name, \@diag);
$ctx->release;
return $bool;
}
sub diag {
my $ctx = context();
$ctx->diag( join '', @_ );
$ctx->release;
}
sub note {
my $ctx = context();
$ctx->note( join '', @_ );
$ctx->release;
}
sub skip_all {
my ($reason) = @_;
my $ctx = context();
$ctx->plan(0, SKIP => $reason);
$ctx->release if $ctx;
}
sub plan {
my ($max) = @_;
my $ctx = context();
$ctx->plan($max);
$ctx->release;
}
sub done_testing {
my $ctx = context();
$ctx->done_testing;
$ctx->release;
}
sub subtest {
my ($name, $code) = @_;
my $ctx = context();
my $bool = run_subtest($name, $code, 1);
$ctx->release;
return $bool;
}
1;
PK 1��\� \: : examples/tools.tnu �[��� use strict;
use warnings;
use Test2::IPC;
BEGIN { require "t/tools.pl" };
use Test2::API qw/context intercept test2_stack/;
ok(__PACKAGE__->can($_), "imported '$_\()'") for qw{
ok
is isnt
like unlike
diag note
is_deeply
warnings
exception
plan
skip_all
done_testing
};
ok(1, "'ok' Test");
is("foo", "foo", "'is' test");
is(undef, undef, "'is' undef test");
isnt("foo", "bar", "'isnt' test");
isnt("foo", undef, "'isnt' undef test 1");
isnt(undef, "foo", "'isnt' undef test 2");
like("foo", qr/o/, "'like' test");
unlike("foo", qr/a/, "'unlike' test");
diag("Testing Diag");
note("Testing Note");
my $str = "abc";
is_deeply(
{ a => 1, b => 2, c => { ref => \$str, obj => bless({x => 1}, 'XXX'), array => [1, 2, 3]}},
{ a => 1, b => 2, c => { ref => \$str, obj => {x => 1}, array => [1, 2, 3]}},
"'is_deeply' test"
);
is_deeply(
warnings { warn "aaa\n"; warn "bbb\n" },
[ "aaa\n", "bbb\n" ],
"Got warnings"
);
is_deeply(
warnings { 1 },
[],
"no warnings"
);
is(exception { die "foo\n" }, "foo\n", "got exception");
is(exception { 1 }, undef, "no exception");
my $events = intercept {
plan 8;
ok(0, "'ok' Test");
is("foo", "bar", "'is' test");
isnt("foo", "foo", "'isnt' test");
like("foo", qr/a/, "'like' test");
unlike("foo", qr/o/, "'unlike' test");
diag("Testing Diag");
note("Testing Note");
is_deeply(
{ a => 1, b => 2, c => {}},
{ a => 1, b => 2, c => []},
"'is_deeply' test"
);
};
is(@$events, 9, "got 9 events");
my ($plan, $ok, $is, $isnt, $like, $unlike, $diag, $note, $is_deeply) = @$events;
ok($plan->isa('Test2::Event::Plan'), "got plan");
is($plan->max, 8, "planned for 8 oks");
ok($ok->isa('Test2::Event::Ok'), "got 'ok' result");
is($ok->pass, 0, "'ok' test failed");
ok($is->isa('Test2::Event::Ok'), "got 'is' result");
is($is->pass, 0, "'is' test failed");
ok($isnt->isa('Test2::Event::Ok'), "got 'isnt' result");
is($isnt->pass, 0, "'isnt' test failed");
ok($like->isa('Test2::Event::Ok'), "got 'like' result");
is($like->pass, 0, "'like' test failed");
ok($unlike->isa('Test2::Event::Ok'), "got 'unlike' result");
is($unlike->pass, 0, "'unlike' test failed");
ok($is_deeply->isa('Test2::Event::Ok'), "got 'is_deeply' result");
is($is_deeply->pass, 0, "'is_deeply' test failed");
ok($diag->isa('Test2::Event::Diag'), "got 'diag' result");
is($diag->message, "Testing Diag", "got diag message");
ok($note->isa('Test2::Event::Note'), "got 'note' result");
is($note->message, "Testing Note", "got note message");
$events = intercept {
skip_all 'because';
ok(0, "should not see me");
die "should not happen";
};
is(@$events, 1, "1 event");
ok($events->[0]->isa('Test2::Event::Plan'), "got plan");
is($events->[0]->directive, 'SKIP', "plan is skip");
is($events->[0]->reason, 'because', "skip reason");
$events = intercept {
is(undef, "");
is("", undef);
isnt(undef, undef);
like(undef, qr//);
unlike(undef, qr//);
};
is(@$events, 5, "5 events");
ok(!$_->pass, "undef test - should not pass") for @$events;
sub tool { context() };
my %params;
my $ctx = context(level => -1);
my $ictx;
$events = intercept {
%params = @_;
$ictx = tool();
$ictx->ok(1, 'pass');
$ictx->ok(0, 'fail');
my $trace = Test2::Context::Trace->new(
frame => [ __PACKAGE__, __FILE__, __LINE__],
);
$ictx->hub->finalize($trace, 1);
};
is_deeply(
\%params,
{
context => $ctx,
hub => $ictx->hub,
},
"Passed in some useful params"
);
ok($ctx != $ictx, "Different context inside intercept");
is(@$events, 3, "got 3 events");
$ctx->release;
$ictx->release;
# Test that a bail-out in an intercept does not exit.
$events = intercept {
$ictx = tool();
$ictx->bail("The world ends");
$ictx->ok(0, "Should not see this");
};
is(@$events, 1, "got 1 event");
ok($events->[0]->isa('Test2::Event::Bail'), "got the bail");
$events = intercept {
$ictx = tool();
};
$ictx->release;
like(
exception { intercept { die 'foo' } },
qr/foo/,
"Exception was propogated"
);
$events = intercept {
test2_stack()->top->set_no_ending(0);
ok(1);
};
is(@$events, 2, "2 events");
ok($events->[0]->isa('Test2::Event::Ok'), "got ok");
ok($events->[1]->isa('Test2::Event::Plan'), "finalize was called");
$events = intercept {
test2_stack()->top->set_no_ending(0);
ok(1);
done_testing;
};
is(@$events, 2, "2 events");
ok($events->[0]->isa('Test2::Event::Ok'), "got ok");
ok($events->[1]->isa('Test2::Event::Plan'), "finalize was called (only 1 plan)");
done_testing;
PK 1��\
��nl l t/Legacy/Bugs/600.tnu �[��� use Test2::API qw/intercept/;
use Test::More;
my $TEST = Test::Builder->new();
sub fake {
$TEST->use_numbers(0);
$TEST->no_ending(1);
$TEST->done_testing(1); # a computed number of tests from its deferred magic
}
my $events = intercept { fake() };
is(@$events, 1, "only 1 event");
is($events->[0]->max, 1, "Plan set to 1, not 0");
done_testing;
PK 1��\,�nC� � t/Legacy/Bugs/629.tnu �[��� use strict;
use warnings;
use Test::More;
use Test2::API qw/intercept/;
my @warnings;
intercept {
SKIP: {
local $SIG{__WARN__} = sub { @warnings = @_ };
skip 'Skipping this test' if 1;
my $var = 'abc';
is $var, 'abc';
}
};
ok(!@warnings, "did not warn when waiting for done_testing");
intercept {
SKIP: {
local $SIG{__WARN__} = sub { @warnings = @_ };
plan 'no_plan';
skip 'Skipping this test' if 1;
my $var = 'abc';
is $var, 'abc';
}
};
ok(!@warnings, "did not warn with 'no_plan'");
intercept {
SKIP: {
local $SIG{__WARN__} = sub { @warnings = @_ };
plan tests => 1;
skip 'Skipping this test' if 1;
my $var = 'abc';
is $var, 'abc';
}
};
is(@warnings, 1, "warned with static plan");
like(
$warnings[0],
qr/skip\(\) needs to know \$how_many tests are in the block/,
"Got expected warning"
);
done_testing;
PK 1��\� �͏ � t/Legacy/Builder/Builder.tnu �[��� #!/usr/bin/perl -w
# HARNESS-NO-STREAM
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::Builder;
my $Test = Test::Builder->new;
$Test->plan( tests => 7 );
my $default_lvl = $Test->level;
$Test->level(0);
$Test->ok( 1, 'compiled and new()' );
$Test->ok( $default_lvl == 1, 'level()' );
$Test->is_eq('foo', 'foo', 'is_eq');
$Test->is_num('23.0', '23', 'is_num');
$Test->is_num( $Test->current_test, 4, 'current_test() get' );
my $test_num = $Test->current_test + 1;
$Test->current_test( $test_num );
print "ok $test_num - current_test() set\n";
$Test->ok( 1, 'counter still good' );
PK 1��\�
|VK K t/Legacy/Builder/carp.tnu �[��� #!/usr/bin/perl
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::More tests => 3;
use Test::Builder;
my $tb = Test::Builder->create;
sub foo { $tb->croak("foo") }
sub bar { $tb->carp("bar") }
eval { foo() };
is $@, sprintf "foo at %s line %s.\n", $0, __LINE__ - 1;
eval { $tb->croak("this") };
is $@, sprintf "this at %s line %s.\n", $0, __LINE__ - 1;
{
my $warning = '';
local $SIG{__WARN__} = sub {
$warning .= join '', @_;
};
bar();
is $warning, sprintf "bar at %s line %s.\n", $0, __LINE__ - 1;
}
PK 1��\دL�2 2 t/Legacy/Builder/create.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use Test::More tests => 7;
use Test::Builder;
use Test::Builder::NoOutput;
my $more_tb = Test::More->builder;
isa_ok $more_tb, 'Test::Builder';
is $more_tb, Test::More->builder, 'create does not interfere with ->builder';
is $more_tb, Test::Builder->new, ' does not interfere with ->new';
{
my $new_tb = Test::Builder::NoOutput->create;
isa_ok $new_tb, 'Test::Builder';
isnt $more_tb, $new_tb, 'Test::Builder->create makes a new object';
$new_tb->plan(tests => 1);
$new_tb->ok(1, "a test");
is $new_tb->read, <<'OUT';
1..1
ok 1 - a test
OUT
}
pass("Changing output() of new TB doesn't interfere with singleton");
PK 1��\R��F t/Legacy/Builder/current_test.tnu �[��� #!/usr/bin/perl -w
# Dave Rolsky found a bug where if current_test() is used and no
# tests are run via Test::Builder it will blow up.
use Test::Builder;
$TB = Test::Builder->new;
$TB->plan(tests => 2);
print "ok 1\n";
print "ok 2\n";
$TB->current_test(2);
PK 1��\�p�*� � , t/Legacy/Builder/current_test_without_plan.tnu �[��� #!/usr/bin/perl -w
# Test that current_test() will work without a declared plan.
use Test::Builder;
my $tb = Test::Builder->new;
$tb->current_test(2);
print <<'END';
ok 1
ok 2
END
$tb->ok(1, "Third test");
$tb->done_testing(3);
PK 1��\ �|� � t/Legacy/Builder/details.tnu �[��� #!/usr/bin/perl -w
# HARNESS-NO-STREAM
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use Test::More;
use Test::Builder;
my $Test = Test::Builder->new;
$Test->plan( tests => 9 );
$Test->level(0);
my @Expected_Details;
$Test->is_num( scalar $Test->summary(), 0, 'no tests yet, no summary' );
push @Expected_Details, { 'ok' => 1,
actual_ok => 1,
name => 'no tests yet, no summary',
type => '',
reason => ''
};
# Inline TODO tests will confuse pre 1.20 Test::Harness, so we
# should just avoid the problem and not print it out.
my $start_test = $Test->current_test + 1;
my $output = '';
$Test->output(\$output);
$Test->todo_output(\$output);
SKIP: {
$Test->skip( 'just testing skip' );
}
push @Expected_Details, { 'ok' => 1,
actual_ok => 1,
name => '',
type => 'skip',
reason => 'just testing skip',
};
TODO: {
local $TODO = 'i need a todo';
$Test->ok( 0, 'a test to todo!' );
push @Expected_Details, { 'ok' => 1,
actual_ok => 0,
name => 'a test to todo!',
type => 'todo',
reason => 'i need a todo',
};
$Test->todo_skip( 'i need both' );
}
push @Expected_Details, { 'ok' => 1,
actual_ok => 0,
name => '',
type => 'todo_skip',
reason => 'i need both'
};
for ($start_test..$Test->current_test) { print "ok $_\n" }
$Test->reset_outputs;
$Test->is_num( scalar $Test->summary(), 4, 'summary' );
push @Expected_Details, { 'ok' => 1,
actual_ok => 1,
name => 'summary',
type => '',
reason => '',
};
$Test->current_test(6);
print "ok 6 - current_test incremented\n";
push @Expected_Details, { 'ok' => 1,
actual_ok => undef,
name => undef,
type => 'unknown',
reason => 'incrementing test number',
};
my @details = $Test->details();
$Test->is_num( scalar @details, 6,
'details() should return a list of all test details');
$Test->level(1);
is_deeply( \@details, \@Expected_Details );
# This test has to come last because it thrashes the test details.
{
my $curr_test = $Test->current_test;
$Test->current_test(4);
my @details = $Test->details();
$Test->current_test($curr_test);
$Test->is_num( scalar @details, 4 );
}
PK 1��\ �I�� � t/Legacy/Builder/done_testing.tnu �[��� #!/usr/bin/perl -w
use strict;
use Test::Builder;
my $tb = Test::Builder->new;
$tb->level(0);
$tb->ok(1, "testing done_testing() with no arguments");
$tb->ok(1, " another test so we're not testing just one");
$tb->done_testing();
PK 1��\+x � � & t/Legacy/Builder/done_testing_double.tnu �[��� #!/usr/bin/perl -w
use strict;
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use Test::Builder;
use Test::Builder::NoOutput;
my $tb = Test::Builder::NoOutput->create;
# $tb methods expect to be wrapped in at least 1 sub
sub done_testing { $tb->done_testing(@_) }
sub ok { $tb->ok(@_) }
{
# Normalize test output
local $ENV{HARNESS_ACTIVE};
ok(1);
ok(1);
ok(1);
#line 24
done_testing(3);
done_testing;
done_testing;
}
my $Test = Test::Builder->new;
$Test->plan( tests => 1 );
$Test->level(0);
$Test->is_eq($tb->read, <<"END", "multiple done_testing");
ok 1
ok 2
ok 3
1..3
not ok 4 - done_testing() was already called at $0 line 24
# Failed test 'done_testing() was already called at $0 line 24'
# at $0 line 25.
not ok 5 - done_testing() was already called at $0 line 24
# Failed test 'done_testing() was already called at $0 line 24'
# at $0 line 26.
END
PK 1��\�,^�z z - t/Legacy/Builder/done_testing_plan_mismatch.tnu �[��� #!/usr/bin/perl -w
# What if there's a plan and done_testing but they don't match?
use strict;
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use Test::Builder;
use Test::Builder::NoOutput;
my $tb = Test::Builder::NoOutput->create;
# TB methods expect to be wrapped
sub ok { $tb->ok(@_) }
sub plan { $tb->plan(@_) }
sub done_testing { $tb->done_testing(@_) }
{
# Normalize test output
local $ENV{HARNESS_ACTIVE};
plan( tests => 3 );
ok(1);
ok(1);
ok(1);
#line 24
done_testing(2);
}
my $Test = Test::Builder->new;
$Test->plan( tests => 1 );
$Test->level(0);
$Test->is_eq($tb->read, <<"END");
1..3
ok 1
ok 2
ok 3
not ok 4 - planned to run 3 but done_testing() expects 2
# Failed test 'planned to run 3 but done_testing() expects 2'
# at $0 line 24.
END
PK 1��\�VN�� � , t/Legacy/Builder/done_testing_with_no_plan.tnu �[��� #!/usr/bin/perl -w
use strict;
use Test::Builder;
my $tb = Test::Builder->new;
$tb->plan( "no_plan" );
$tb->ok(1);
$tb->ok(1);
$tb->done_testing(2);
PK 1��\���W� � + t/Legacy/Builder/done_testing_with_number.tnu �[��� #!/usr/bin/perl -w
use strict;
use Test::Builder;
my $tb = Test::Builder->new;
$tb->level(0);
$tb->ok(1, "testing done_testing() with no arguments");
$tb->ok(1, " another test so we're not testing just one");
$tb->done_testing(2);
PK 1��\1�|#� � ) t/Legacy/Builder/done_testing_with_plan.tnu �[��� #!/usr/bin/perl -w
use strict;
use Test::Builder;
my $tb = Test::Builder->new;
$tb->plan( tests => 2 );
$tb->ok(1);
$tb->ok(1);
$tb->done_testing(2);
PK 1��\����< < ' t/Legacy/Builder/fork_with_new_stdout.tnu �[��� #!perl -w
use strict;
use warnings;
use Test2::Util qw/CAN_FORK/;
BEGIN {
unless (CAN_FORK) {
require Test::More;
Test::More->import(skip_all => "fork is not supported");
}
}
use IO::Pipe;
use Test::Builder;
use Config;
my $b = Test::Builder->new;
$b->reset;
$b->plan('tests' => 2);
my $pipe = IO::Pipe->new;
if (my $pid = fork) {
$pipe->reader;
my ($one, $two) = <$pipe>;
$b->like($one, qr/ok 1/, "ok 1 from child");
$b->like($two, qr/1\.\.1/, "1..1 from child");
waitpid($pid, 0);
}
else {
require Test::Builder::Formatter;
$b->{Stack}->top->format(Test::Builder::Formatter->new());
$pipe->writer;
$b->reset;
$b->no_plan;
$b->output($pipe);
$b->ok(1);
$b->done_testing;
}
=pod
#actual
1..2
ok 1
1..1
ok 1
ok 2
#expected
1..2
ok 1
ok 2
=cut
PK 1��\x#��n n t/Legacy/Builder/has_plan.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib');
}
}
use strict;
use Test::Builder;
my $unplanned;
BEGIN {
$unplanned = 'oops';
$unplanned = Test::Builder->new->has_plan;
};
use Test::More tests => 2;
is($unplanned, undef, 'no plan yet defined');
is(Test::Builder->new->has_plan, 2, 'has fixed plan');
PK 1��\3I�c c t/Legacy/Builder/has_plan2.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::More;
BEGIN {
if( !$ENV{HARNESS_ACTIVE} && $ENV{PERL_CORE} ) {
plan skip_all => "Won't work with t/TEST";
}
}
use strict;
use Test::Builder;
plan 'no_plan';
is(Test::Builder->new->has_plan, 'no_plan', 'has no_plan');
PK 1��\����� � t/Legacy/Builder/is_fh.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use Test::More tests => 11;
use TieOut;
ok( !Test::Builder->is_fh("foo"), 'string is not a filehandle' );
ok( !Test::Builder->is_fh(''), 'empty string' );
ok( !Test::Builder->is_fh(undef), 'undef' );
ok( open(FILE, '>foo') );
END { close FILE; 1 while unlink 'foo' }
ok( Test::Builder->is_fh(*FILE) );
ok( Test::Builder->is_fh(\*FILE) );
ok( Test::Builder->is_fh(*FILE{IO}) );
tie *OUT, 'TieOut';
ok( Test::Builder->is_fh(*OUT) );
ok( Test::Builder->is_fh(\*OUT) );
SKIP: {
skip "*TIED_HANDLE{IO} doesn't work in this perl", 1
unless defined *OUT{IO};
ok( Test::Builder->is_fh(*OUT{IO}) );
}
package Lying::isa;
sub isa {
my $self = shift;
my $parent = shift;
return 1 if $parent eq 'IO::Handle';
}
::ok( Test::Builder->is_fh(bless {}, "Lying::isa"));
PK 1��\��v�� � t/Legacy/Builder/is_passing.tnu �[��� #!/usr/bin/perl -w
use strict;
use lib 't/lib';
# We're going to need to override exit() later
BEGIN {
require Test2::Hub;
no warnings 'redefine';
*Test2::Hub::terminate = sub {
my $status = @_ ? 0 : shift;
CORE::exit $status;
};
}
use Test::More;
use Test::Builder;
use Test::Builder::NoOutput;
{
my $tb = Test::Builder::NoOutput->create;
ok $tb->is_passing, "a fresh TB object is passing";
$tb->ok(1);
ok $tb->is_passing, " still passing after a test";
$tb->ok(0);
ok !$tb->is_passing, " not passing after a failing test";
$tb->ok(1);
ok !$tb->is_passing, " a passing test doesn't resurrect it";
$tb->done_testing(3);
ok !$tb->is_passing, " a successful plan doesn't help either";
}
# See if is_passing() notices a plan overrun
{
my $tb = Test::Builder::NoOutput->create;
$tb->plan( tests => 1 );
$tb->ok(1);
ok $tb->is_passing, "Passing with a plan";
$tb->ok(1);
ok !$tb->is_passing, " passing test, but it overran the plan";
}
# is_passing() vs no_plan
{
my $tb = Test::Builder::NoOutput->create;
$tb->plan( "no_plan" );
ok $tb->is_passing, "Passing with no_plan";
$tb->ok(1);
ok $tb->is_passing, " still passing after a test";
$tb->ok(1);
ok $tb->is_passing, " and another test";
$tb->_ending;
ok $tb->is_passing, " and after the ending";
}
# is_passing() vs skip_all
{
my $tb = Test::Builder::NoOutput->create;
{
no warnings 'redefine';
local *Test2::Hub::terminate = sub { 1 };
$tb->plan( "skip_all" );
}
ok $tb->is_passing, "Passing with skip_all";
}
# is_passing() vs done_testing(#)
{
my $tb = Test::Builder::NoOutput->create;
$tb->ok(1);
$tb->done_testing(2);
ok !$tb->is_passing, "All tests passed but done_testing() does not match";
}
# is_passing() with no tests run vs done_testing()
{
my $tb = Test::Builder::NoOutput->create;
$tb->done_testing();
ok !$tb->is_passing, "No tests run with done_testing()";
}
# is_passing() with no tests run vs done_testing()
{
my $tb = Test::Builder::NoOutput->create;
$tb->ok(1);
$tb->done_testing();
ok $tb->is_passing, "All tests passed with done_testing()";
}
done_testing();
PK 1��\ �Hc" " t/Legacy/Builder/maybe_regex.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use Test::More tests => 16;
use Test::Builder;
my $Test = Test::Builder->new;
my $r = $Test->maybe_regex(qr/^FOO$/i);
ok(defined $r, 'qr// detected');
ok(('foo' =~ /$r/), 'qr// good match');
ok(('bar' !~ /$r/), 'qr// bad match');
SKIP: {
skip "blessed regex checker added in 5.10", 3 if $] < 5.010;
my $obj = bless qr/foo/, 'Wibble';
my $re = $Test->maybe_regex($obj);
ok( defined $re, "blessed regex detected" );
ok( ('foo' =~ /$re/), 'blessed qr/foo/ good match' );
ok( ('bar' !~ /$re/), 'blessed qr/foo/ bad math' );
}
{
my $r = $Test->maybe_regex('/^BAR$/i');
ok(defined $r, '"//" detected');
ok(('bar' =~ m/$r/), '"//" good match');
ok(('foo' !~ m/$r/), '"//" bad match');
};
{
my $r = $Test->maybe_regex('not a regex');
ok(!defined $r, 'non-regex detected');
};
{
my $r = $Test->maybe_regex('/0/');
ok(defined $r, 'non-regex detected');
ok(('f00' =~ m/$r/), '"//" good match');
ok(('b4r' !~ m/$r/), '"//" bad match');
};
{
my $r = $Test->maybe_regex('m,foo,i');
ok(defined $r, 'm,, detected');
ok(('fOO' =~ m/$r/), '"//" good match');
ok(('bar' !~ m/$r/), '"//" bad match');
};
PK 1��\�Q 6 6 t/Legacy/Builder/no_diag.tnu �[��� #!/usr/bin/perl -w
use Test::More 'no_diag';
plan 'skip_all' => "This test cannot be run with the current formatter"
unless Test::Builder->new->{Stack}->top->format->isa('Test::Builder::Formatter');
pass('foo');
diag('This should not be displayed');
is(Test::More->builder->no_diag, 1);
done_testing;
PK 1��\ȣ�Lm m t/Legacy/Builder/no_ending.tnu �[��� use Test::Builder;
# HARNESS-NO-STREAM
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
BEGIN {
my $t = Test::Builder->new;
$t->no_ending(1);
}
use Test::More tests => 3;
# Normally, Test::More would yell that we ran too few tests, but we
# suppressed the ending diagnostics.
pass;
print "ok 2\n";
print "ok 3\n";
PK 1��\�� �* * t/Legacy/Builder/no_header.tnu �[��� BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::Builder;
# STDOUT must be unbuffered else our prints might come out after
# Test::More's.
$| = 1;
BEGIN {
Test::Builder->new->no_header(1);
}
use Test::More tests => 1;
print "1..1\n";
pass;
PK 1��\���� � ! t/Legacy/Builder/no_plan_at_all.tnu �[��� #!/usr/bin/perl -w
# Test what happens when no plan is declared and done_testing() is not seen
use strict;
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use Test::Builder;
use Test::Builder::NoOutput;
my $Test = Test::Builder->new;
$Test->level(0);
$Test->plan( tests => 1 );
my $tb = Test::Builder::NoOutput->create;
{
$tb->level(0);
$tb->ok(1, "just a test");
$tb->ok(1, " and another");
$tb->_ending;
}
$Test->is_eq($tb->read, <<'END', "proper behavior when no plan is seen");
ok 1 - just a test
ok 2 - and another
# Tests were run but no plan was declared and done_testing() was not seen.
END
PK 1��\3�ݽ� � t/Legacy/Builder/ok_obj.tnu �[��� #!/usr/bin/perl -w
# Testing to make sure Test::Builder doesn't accidentally store objects
# passed in as test arguments.
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::More tests => 4;
package Foo;
my $destroyed = 0;
sub new { bless {}, shift }
sub DESTROY {
$destroyed++;
}
package main;
for (1..3) {
ok(my $foo = Foo->new, 'created Foo object');
}
is $destroyed, 3, "DESTROY called 3 times";
PK 1��\a�k�� � t/Legacy/Builder/output.tnu �[��� #!perl -w
use strict;
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
chdir 't';
use Test::Builder;
# The real Test::Builder
my $Test = Test::Builder->new;
$Test->plan( tests => 6 );
# The one we're going to test.
my $tb = Test::Builder->create();
my $tmpfile = 'foo.tmp';
END { 1 while unlink($tmpfile) }
# Test output to a file
{
my $out = $tb->output($tmpfile);
$Test->ok( defined $out );
print $out "hi!\n";
close *$out;
undef $out;
open(IN, $tmpfile) or die $!;
chomp(my $line = <IN>);
close IN;
$Test->is_eq($line, 'hi!');
}
# Test output to a filehandle
{
open(FOO, ">>$tmpfile") or die $!;
my $out = $tb->output(\*FOO);
my $old = select *$out;
print "Hello!\n";
close *$out;
undef $out;
select $old;
open(IN, $tmpfile) or die $!;
my @lines = <IN>;
close IN;
$Test->like($lines[1], qr/Hello!/);
}
# Test output to a scalar ref
{
my $scalar = '';
my $out = $tb->output(\$scalar);
print $out "Hey hey hey!\n";
$Test->is_eq($scalar, "Hey hey hey!\n");
}
# Test we can output to the same scalar ref
{
my $scalar = '';
my $out = $tb->output(\$scalar);
my $err = $tb->failure_output(\$scalar);
print $out "To output ";
print $err "and beyond!";
$Test->is_eq($scalar, "To output and beyond!", "One scalar, two filehandles");
}
# Ensure stray newline in name escaping works.
{
my $fakeout = '';
my $out = $tb->output(\$fakeout);
$tb->exported_to(__PACKAGE__);
$tb->no_ending(1);
$tb->plan(tests => 5);
$tb->ok(1, "ok");
$tb->ok(1, "ok\n");
$tb->ok(1, "ok, like\nok");
$tb->skip("wibble\nmoof");
$tb->todo_skip("todo\nskip\n");
$Test->is_eq( $fakeout, <<OUTPUT ) || print STDERR $fakeout;
1..5
ok 1 - ok
ok 2 - ok
#
ok 3 - ok, like
# ok
ok 4 # skip wibble
# moof
not ok 5 # TODO & SKIP todo
# skip
#
OUTPUT
}
PK 1��\��� t/Legacy/Builder/reset.tnu �[��� #!/usr/bin/perl -w
# HARNESS-NO-STREAM
# Test Test::Builder->reset;
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
chdir 't';
use Test::Builder;
my $Test = Test::Builder->new;
my $tb = Test::Builder->create;
# We'll need this later to know the outputs were reset
my %Original_Output;
$Original_Output{$_} = $tb->$_ for qw(output failure_output todo_output);
# Alter the state of Test::Builder as much as possible.
my $output = '';
$tb->output(\$output);
$tb->failure_output(\$output);
$tb->todo_output(\$output);
$tb->plan(tests => 14);
$tb->level(0);
$tb->ok(1, "Running a test to alter TB's state");
# This won't print since we just sent output off to oblivion.
$tb->ok(0, "And a failure for fun");
$Test::Builder::Level = 3;
$tb->exported_to('Foofer');
$tb->use_numbers(0);
$tb->no_header(1);
$tb->no_ending(1);
$tb->done_testing; # make sure done_testing gets reset
# Now reset it.
$tb->reset;
# Test the state of the reset builder
$Test->ok( !defined $tb->exported_to, 'exported_to' );
$Test->is_eq( $tb->expected_tests, 0, 'expected_tests' );
$Test->is_eq( $tb->level, 1, 'level' );
$Test->is_eq( $tb->use_numbers, 1, 'use_numbers' );
$Test->is_eq( $tb->no_header, 0, 'no_header' );
$Test->is_eq( $tb->no_ending, 0, 'no_ending' );
$Test->is_eq( $tb->current_test, 0, 'current_test' );
$Test->is_eq( scalar $tb->summary, 0, 'summary' );
$Test->is_eq( scalar $tb->details, 0, 'details' );
$Test->is_eq( fileno $tb->output,
fileno $Original_Output{output}, 'output' );
$Test->is_eq( fileno $tb->failure_output,
fileno $Original_Output{failure_output}, 'failure_output' );
$Test->is_eq( fileno $tb->todo_output,
fileno $Original_Output{todo_output}, 'todo_output' );
# The reset Test::Builder will take over from here.
$Test->no_ending(1);
$tb->current_test($Test->current_test);
$tb->level(0);
$tb->ok(1, 'final test to make sure output was reset');
$tb->done_testing;
PK 1��\� �z t/Legacy/Builder/reset_outputs.tnu �[��� #!perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use Test::Builder;
use Test::More 'no_plan';
{
my $tb = Test::Builder->create();
# Store the original output filehandles and change them all.
my %original_outputs;
open my $fh, ">", "dummy_file.tmp";
END { 1 while unlink "dummy_file.tmp"; }
for my $method (qw(output failure_output todo_output)) {
$original_outputs{$method} = $tb->$method();
$tb->$method($fh);
is $tb->$method(), $fh;
}
$tb->reset_outputs;
for my $method (qw(output failure_output todo_output)) {
is $tb->$method(), $original_outputs{$method}, "reset_outputs() resets $method";
}
}
PK 1��\��QX� � t/Legacy/Builder/try.tnu �[��� #!perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use Test::More 'no_plan';
require Test::Builder;
my $tb = Test::Builder->new;
# Test that _try() has no effect on $@ and $! and is not effected by
# __DIE__
{
local $SIG{__DIE__} = sub { fail("DIE handler called: @_") };
local $@ = 42;
local $! = 23;
is $tb->_try(sub { 2 }), 2;
is $tb->_try(sub { return '' }), '';
is $tb->_try(sub { die; }), undef;
is_deeply [$tb->_try(sub { die "Foo\n" })], [undef, "Foo\n"];
is $@, 42;
cmp_ok $!, '==', 23;
}
ok !eval {
$tb->_try(sub { die "Died\n" }, die_on_fail => 1);
};
is $@, "Died\n";
PK 1��\��� � � t/Legacy/Regression/637.tnu �[��� use strict;
use warnings;
# HARNESS-NO-STREAM
use Test2::Util qw/CAN_THREAD/;
BEGIN {
unless(CAN_THREAD) {
print "1..0 # Skip threads are not supported.\n";
exit 0;
}
}
BEGIN {
unless ( $ENV{AUTHOR_TESTING} ) {
print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n";
exit 0;
}
}
use Test2::IPC;
use threads;
use Test::More;
plan 'skip_all' => "This test cannot be run with the current formatter"
unless Test::Builder->new->{Stack}->top->format->isa('Test::Builder::Formatter');
ok 1 for (1 .. 2);
# used to reset the counter after thread finishes
my $ct_num = Test::More->builder->current_test;
my $subtest_out = async {
my $out = '';
#simulate a subtest to not confuse the parent TAP emission
my $tb = Test::More->builder;
$tb->reset;
for (qw/output failure_output todo_output/) {
close $tb->$_;
open($tb->$_, '>', \$out);
}
ok 1 for (1 .. 3);
done_testing;
close $tb->$_ for (qw/output failure_output todo_output/);
$out;
}
->join;
$subtest_out =~ s/^/ /gm;
print $subtest_out;
# reset as if the thread never "said" anything
Test::More->builder->current_test($ct_num);
ok 1 for (1 .. 4);
done_testing;
PK 1��\4I�b� � % t/Legacy/Regression/683_thread_todo.tnu �[��� use strict;
use warnings;
use Test2::Util qw/CAN_THREAD/;
BEGIN {
unless(CAN_THREAD) {
require Test::More;
Test::More->import(skip_all => "threads are not supported");
}
}
use threads;
use Test::More;
my $t = threads->create(
sub {
local $TODO = "Some good reason";
fail "Crap";
42;
}
);
is(
$t->join,
42,
"Thread exitted successfully"
);
done_testing;
PK 1��\ �^� t/Legacy/Regression/6_cmp_ok.tnu �[��� use Test::More;
use Test2::API qw/intercept/;
my $events = intercept {
local $SIG{__WARN__} = sub { 1 };
my $foo = undef;
cmp_ok($foo, "ne", "");
};
is($events->[-1]->message, <<EOT, "Got useful diag");
undef
ne
''
EOT
done_testing;
PK 1��\n�� t/Legacy/Regression/736_use_ok.tnu �[��� use warnings;
use strict;
use Test::More;
BEGIN {
$INC{'MyWarner.pm'} = 1;
package MyWarner;
sub import {
warnings::warnif('deprecated', "Deprected! run for your lives!");
}
}
sub capture(&) {
my $warn;
local $SIG{__WARN__} = sub { $warn = shift };
$_[0]->();
return $warn || "";
}
{
local $TODO = "known to fail on $]" if $] le "5.006002";
my $file = __FILE__;
my $line = __LINE__ + 4;
like(
capture {
local $TODO; # localize $TODO to clear previous assignment, as following use_ok test is expected to pass
use_ok 'MyWarner';
},
qr/^Deprected! run for your lives! at \Q$file\E line $line/,
"Got the warning"
);
}
ok(!capture { no warnings 'deprecated'; use_ok 'MyWarner' }, "No warning");
done_testing;
PK 1��\�筠 � # t/Legacy/Regression/789-read-only.tnu �[��� use Test::More;
use strict;
use warnings;
# HARNESS-NO-STREAM
# See https://github.com/Test-More/test-more/issues/789
BEGIN {
plan skip_all => 'AUTHOR_TESTING not enabled'
unless $ENV{AUTHOR_TESTING};
plan skip_all => "This test requires Test::Class"
unless eval { require Test::Class; 1 };
plan skip_all => "This test requires Test::Script"
unless eval { require Test::Script; 1 };
}
package Test;
use base 'Test::Class';
use Test::More;
use Test::Script;
sub a_compilation_test : Test(startup => 1) {
script_compiles(__FILE__);
}
sub test : Test(1) {
ok(1);
}
package main;
use Test::Class;
Test::Class->runtests;
PK 1��\�S�� � t/Legacy/Simple/load.tnu �[��� #!/usr/bin/perl
# Because I broke "use Test::Simple", here's a test
use strict;
use warnings;
use Test::Simple;
print <<END;
1..1
ok 1 - use Test::Simple with no arguments
END
PK 1��\a+ n� � t/Legacy/Test2/Subtest.tnu �[��� use strict;
use warnings;
use Test::More;
use Test2::API qw/intercept/;
my $res = intercept {
subtest foo => sub {
ok(1, "check");
};
};
is(@$res, 2, "2 results");
isa_ok($res->[0], 'Test2::Event::Note');
is($res->[0]->message, 'Subtest: foo', "got subtest note");
isa_ok($res->[1], 'Test2::Event::Subtest');
ok($res->[1]->pass, "subtest passed");
my $subs = $res->[1]->subevents;
is(@$subs, 2, "got all subevents");
isa_ok($subs->[0], 'Test2::Event::Ok');
is($subs->[0]->pass, 1, "subtest ok passed");
is($subs->[0]->name, 'check', "subtest ok name");
isa_ok($subs->[1], 'Test2::Event::Plan');
is($subs->[1]->max, 1, "subtest plan is 1");
done_testing;
PK 1��\53�m� � t/Legacy/Tester/tbt_01basic.tnu �[��� #!/usr/bin/perl
use Test::Builder::Tester tests => 10;
use Test::More;
ok(1,"This is a basic test");
test_out("ok 1 - tested");
ok(1,"tested");
test_test("captured okay on basic");
test_out("ok 1 - tested");
ok(1,"tested");
test_test("captured okay again without changing number");
ok(1,"test unrelated to Test::Builder::Tester");
test_out("ok 1 - one");
test_out("ok 2 - two");
ok(1,"one");
ok(2,"two");
test_test("multiple tests");
test_out(qr/ok 1 - tested\n/);
ok(1,"tested");
test_test("regexp matching");
test_out("not ok 1 - should fail");
test_err("# Failed test ($0 at line 32)");
test_err("# got: 'foo'");
test_err("# expected: 'bar'");
is("foo","bar","should fail");
test_test("testing failing");
test_out("not ok 1");
test_out("not ok 2");
test_fail(+2);
test_fail(+1);
fail(); fail();
test_test("testing failing on the same line with no name");
test_out("not ok 1 - name");
test_out("not ok 2 - name");
test_fail(+2);
test_fail(+1);
fail("name"); fail("name");
test_test("testing failing on the same line with the same name");
test_out("not ok 1 - name # TODO Something");
test_out("# Failed (TODO) test ($0 at line 56)");
TODO: {
local $TODO = "Something";
fail("name");
}
test_test("testing failing with todo");
PK 1��\�$�R� � ! t/Legacy/Tester/tbt_02fhrestore.tnu �[��� #!/usr/bin/perl
use Test::Builder::Tester tests => 4;
use Test::More;
use Symbol;
# create temporary file handles that still point indirectly
# to the right place
my $orig_o = gensym;
my $orig_t = gensym;
my $orig_f = gensym;
tie *$orig_o, "My::Passthru", \*STDOUT;
tie *$orig_t, "My::Passthru", \*STDERR;
tie *$orig_f, "My::Passthru", \*STDERR;
# redirect the file handles to somewhere else for a mo
use Test::Builder;
my $t = Test::Builder->new();
$t->output($orig_o);
$t->failure_output($orig_f);
$t->todo_output($orig_t);
# run a test
test_out("ok 1 - tested");
ok(1,"tested");
test_test("standard test okay");
# now check that they were restored okay
ok($orig_o == $t->output(), "output file reconnected");
ok($orig_t == $t->todo_output(), "todo output file reconnected");
ok($orig_f == $t->failure_output(), "failure output file reconnected");
#####################################################################
package My::Passthru;
sub PRINT {
my $self = shift;
my $handle = $self->[0];
print $handle @_;
}
sub TIEHANDLE {
my $class = shift;
my $self = [shift()];
return bless $self, $class;
}
sub READ {}
sub READLINE {}
sub GETC {}
sub FILENO {}
PK 1��\a��q� � t/Legacy/Tester/tbt_03die.tnu �[��� #!/usr/bin/perl
use Test::Builder::Tester tests => 1;
use Test::More;
eval {
test_test("foo");
};
like($@,
"/Not testing\. You must declare output with a test function first\./",
"dies correctly on error");
PK 1��\I���� � t/Legacy/Tester/tbt_04line_num.tnu �[��� #!/usr/bin/perl
use Test::More tests => 3;
use Test::Builder::Tester;
is(line_num(),6,"normal line num");
is(line_num(-1),6,"line number minus one");
is(line_num(+2),10,"line number plus two");
PK 1��\[Ƥj8 8 t/Legacy/Tester/tbt_05faildiag.tnu �[��� #!/usr/bin/perl
use Test::Builder::Tester tests => 5;
use Test::More;
# test_fail
test_out("not ok 1 - one");
test_fail(+1);
ok(0,"one");
test_out("not ok 2 - two");
test_fail(+2);
ok(0,"two");
test_test("test fail");
test_fail(+2);
test_out("not ok 1 - one");
ok(0,"one");
test_test("test_fail first");
# test_diag
use Test::Builder;
my $test = new Test::Builder;
test_diag("this is a test string","so is this");
$test->diag("this is a test string\n", "so is this\n");
test_test("test diag");
test_diag("this is a test string","so is this");
$test->diag("this is a test string\n");
$test->diag("so is this\n");
test_test("test diag multi line");
test_diag("this is a test string");
test_diag("so is this");
$test->diag("this is a test string\n");
$test->diag("so is this\n");
test_test("test diag multiple");
PK 1��\j_ ! t/Legacy/Tester/tbt_06errormess.tnu �[��� #!/usr/bin/perl -w
use Test::More tests => 8;
use Symbol;
use Test::Builder;
use Test::Builder::Tester;
use strict;
# argh! now we need to test the thing we're testing. Basically we need
# to pretty much reimplement the whole code again. This is very
# annoying but can't be avoided. And onward with the cut and paste
# My brain is melting. My brain is melting. ETOOMANYLAYERSOFTESTING
# create some private file handles
my $output_handle = gensym;
my $error_handle = gensym;
# and tie them to this package
my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT";
my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR";
# ooooh, use the test suite
my $t = Test::Builder->new;
# remember the testing outputs
my $original_output_handle;
my $original_failure_handle;
my $original_todo_handle;
my $original_harness_env;
my $testing_num;
sub start_testing
{
# remember what the handles were set to
$original_output_handle = $t->output();
$original_failure_handle = $t->failure_output();
$original_todo_handle = $t->todo_output();
$original_harness_env = $ENV{HARNESS_ACTIVE};
# switch out to our own handles
$t->output($output_handle);
$t->failure_output($error_handle);
$t->todo_output($error_handle);
$ENV{HARNESS_ACTIVE} = 0;
# clear the expected list
$out->reset();
$err->reset();
# remember that we're testing
$testing_num = $t->current_test;
$t->current_test(0);
}
# each test test is actually two tests. This is bad and wrong
# but makes blood come out of my ears if I don't at least simplify
# it a little this way
sub my_test_test
{
my $text = shift;
local $^W = 0;
# reset the outputs
$t->output($original_output_handle);
$t->failure_output($original_failure_handle);
$t->todo_output($original_todo_handle);
$ENV{HARNESS_ACTIVE} = $original_harness_env;
# reset the number of tests
$t->current_test($testing_num);
# check we got the same values
my $got;
my $wanted;
# stdout
$t->ok($out->check, "STDOUT $text");
# stderr
$t->ok($err->check, "STDERR $text");
}
####################################################################
# Meta meta tests
####################################################################
# this is a quick test to check the hack that I've just implemented
# actually does a cut down version of Test::Builder::Tester
start_testing();
$out->expect("ok 1 - foo");
pass("foo");
my_test_test("basic meta meta test");
start_testing();
$out->expect("not ok 1 - foo");
$err->expect("# Failed test ($0 at line ".line_num(+1).")");
fail("foo");
my_test_test("basic meta meta test 2");
start_testing();
$out->expect("ok 1 - bar");
test_out("ok 1 - foo");
pass("foo");
test_test("bar");
my_test_test("meta meta test with tbt");
start_testing();
$out->expect("ok 1 - bar");
test_out("not ok 1 - foo");
test_err("# Failed test ($0 at line ".line_num(+1).")");
fail("foo");
test_test("bar");
my_test_test("meta meta test with tbt2 ");
####################################################################
PK 1��\d/�� � t/Legacy/Tester/tbt_07args.tnu �[��� #!/usr/bin/perl -w
use Test::More tests => 18;
use Symbol;
use Test::Builder;
use Test::Builder::Tester;
use strict;
# argh! now we need to test the thing we're testing. Basically we need
# to pretty much reimplement the whole code again. This is very
# annoying but can't be avoided. And onward with the cut and paste
# My brain is melting. My brain is melting. ETOOMANYLAYERSOFTESTING
# create some private file handles
my $output_handle = gensym;
my $error_handle = gensym;
# and tie them to this package
my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT";
my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR";
# ooooh, use the test suite
my $t = Test::Builder->new;
# remember the testing outputs
my $original_output_handle;
my $original_failure_handle;
my $original_todo_handle;
my $testing_num;
my $original_harness_env;
sub start_testing
{
# remember what the handles were set to
$original_output_handle = $t->output();
$original_failure_handle = $t->failure_output();
$original_todo_handle = $t->todo_output();
$original_harness_env = $ENV{HARNESS_ACTIVE};
# switch out to our own handles
$t->output($output_handle);
$t->failure_output($error_handle);
$t->todo_output($error_handle);
$ENV{HARNESS_ACTIVE} = 0;
# clear the expected list
$out->reset();
$err->reset();
# remember that we're testing
$testing_num = $t->current_test;
$t->current_test(0);
}
# each test test is actually two tests. This is bad and wrong
# but makes blood come out of my ears if I don't at least simplify
# it a little this way
sub my_test_test
{
my $text = shift;
local $^W = 0;
# reset the outputs
$t->output($original_output_handle);
$t->failure_output($original_failure_handle);
$t->todo_output($original_todo_handle);
$ENV{HARNESS_ACTIVE} = $original_harness_env;
# reset the number of tests
$t->current_test($testing_num);
# check we got the same values
my $got;
my $wanted;
# stdout
$t->ok($out->check, "STDOUT $text");
# stderr
$t->ok($err->check, "STDERR $text");
}
####################################################################
# Meta meta tests
####################################################################
# this is a quick test to check the hack that I've just implemented
# actually does a cut down version of Test::Builder::Tester
start_testing();
$out->expect("ok 1 - foo");
pass("foo");
my_test_test("basic meta meta test");
start_testing();
$out->expect("not ok 1 - foo");
$err->expect("# Failed test ($0 at line ".line_num(+1).")");
fail("foo");
my_test_test("basic meta meta test 2");
start_testing();
$out->expect("ok 1 - bar");
test_out("ok 1 - foo");
pass("foo");
test_test("bar");
my_test_test("meta meta test with tbt");
start_testing();
$out->expect("ok 1 - bar");
test_out("not ok 1 - foo");
test_err("# Failed test ($0 at line ".line_num(+1).")");
fail("foo");
test_test("bar");
my_test_test("meta meta test with tbt2 ");
####################################################################
# Actual meta tests
####################################################################
# set up the outer wrapper again
start_testing();
$out->expect("ok 1 - bar");
# set up what the inner wrapper expects
test_out("ok 1 - foo");
# the actual test function that we are testing
ok("1","foo");
# test the name
test_test(name => "bar");
# check that passed
my_test_test("meta test name");
####################################################################
# set up the outer wrapper again
start_testing();
$out->expect("ok 1 - bar");
# set up what the inner wrapper expects
test_out("ok 1 - foo");
# the actual test function that we are testing
ok("1","foo");
# test the name
test_test(title => "bar");
# check that passed
my_test_test("meta test title");
####################################################################
# set up the outer wrapper again
start_testing();
$out->expect("ok 1 - bar");
# set up what the inner wrapper expects
test_out("ok 1 - foo");
# the actual test function that we are testing
ok("1","foo");
# test the name
test_test(label => "bar");
# check that passed
my_test_test("meta test title");
####################################################################
# set up the outer wrapper again
start_testing();
$out->expect("ok 1 - bar");
# set up what the inner wrapper expects
test_out("not ok 1 - foo this is wrong");
test_fail(+3);
# the actual test function that we are testing
ok("0","foo");
# test that we got what we expect, ignoring our is wrong
test_test(skip_out => 1, name => "bar");
# check that that passed
my_test_test("meta test skip_out");
####################################################################
# set up the outer wrapper again
start_testing();
$out->expect("ok 1 - bar");
# set up what the inner wrapper expects
test_out("not ok 1 - foo");
test_err("this is wrong");
# the actual test function that we are testing
ok("0","foo");
# test that we got what we expect, ignoring err is wrong
test_test(skip_err => 1, name => "bar");
# diagnostics failing out
# check that that passed
my_test_test("meta test skip_err");
####################################################################
PK 1��\u�q t/Legacy/Tester/tbt_08subtest.tnu �[��� #!/usr/bin/env perl
# HARNESS-NO-STREAM
use strict;
use warnings;
use Test::Builder::Tester tests => 1;
use Test::More;
subtest 'foo' => sub {
plan tests => 1;
test_out("not ok 1 - foo");
test_fail(+1);
fail("foo");
test_test("fail works");
};
PK 1��\e�F F t/Legacy/Tester/tbt_09do.tnu �[��� #!/usr/bin/perl
use strict;
use warnings;
use Test::Builder::Tester tests => 3;
use Test::More;
use File::Basename qw(dirname);
use File::Spec qw();
my $file = File::Spec->join(dirname(__FILE__), 'tbt_09do_script.pl');
$file = File::Spec->catfile(File::Spec->curdir(), $file)
unless File::Spec->file_name_is_absolute($file);
my $done = do $file;
ok(defined($done), 'do succeeded') or do {
if ($@) {
diag qq( \$@ is '$@'\n);
} elsif ($!) {
diag qq( \$! is '$!'\n);
} else {
diag qq( file's last statement returned undef: $file)
}
};
PK 1��\�T�� � " t/Legacy/Tester/tbt_09do_script.plnu �[��� #!/usr/bin/perl
use strict;
use warnings;
isnt($0, __FILE__, 'code is not executing directly');
test_out("not ok 1 - one");
test_fail(+1);
ok(0,"one");
test_test('test_fail caught fail message inside a do');
1;
PK 1��\�&$�2 2 t/Legacy/eq_set.tnu �[��� #!perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
chdir 't';
use strict;
use Test::More;
plan tests => 4;
# RT 3747
ok( eq_set([1, 2, [3]], [[3], 1, 2]) );
ok( eq_set([1,2,[3]], [1,[3],2]) );
# bugs.perl.org 36354
my $ref = \2;
ok( eq_set( [$ref, "$ref", "$ref", $ref],
["$ref", $ref, $ref, "$ref"]
) );
TODO: {
local $TODO = q[eq_set() doesn't really handle references];
ok( eq_set( [\1, \2, \3], [\2, \3, \1] ) );
}
PK 1��\��(� � t/Legacy/exit.tnu �[��� #!/usr/bin/perl -w
# HARNESS-NO-STREAM
# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
require Test::Builder;
my $TB = Test::Builder->create();
$TB->level(0);
package main;
use Cwd;
use File::Spec;
my $Orig_Dir = cwd;
my $Perl = File::Spec->rel2abs($^X);
if( $^O eq 'VMS' ) {
# VMS can't use its own $^X in a system call until almost 5.8
$Perl = "MCR $^X" if $] < 5.007003;
# Quiet noisy 'SYS$ABORT'
$Perl .= q{ -"I../lib"} if $ENV{PERL_CORE};
$Perl .= q{ -"Mvmsish=hushed"};
} else {
$Perl = qq("$Perl"); # protect from shell if spaces
}
eval { require POSIX; &POSIX::WEXITSTATUS(0) };
if( $@ ) {
*exitstatus = sub { $_[0] >> 8 };
}
else {
*exitstatus = sub { POSIX::WEXITSTATUS($_[0]) }
}
# Some OS' will alter the exit code to their own native sense...
# sometimes. Rather than deal with the exception we'll just
# build up the mapping.
print "# Building up a map of exit codes. May take a while.\n";
my %Exit_Map;
open my $fh, ">", "exit_map_test" or die $!;
print $fh <<'DONE';
if ($^O eq 'VMS') {
require vmsish;
import vmsish qw(hushed);
}
my $exit = shift;
print "exit $exit\n";
END { $? = $exit };
DONE
close $fh;
END { 1 while unlink "exit_map_test" }
for my $exit (0..255) {
# This correctly emulates Test::Builder's behavior.
my $out = qx[$Perl exit_map_test $exit];
$TB->like( $out, qr/^exit $exit\n/, "exit map test for $exit" );
$Exit_Map{$exit} = exitstatus($?);
}
print "# Done.\n";
my %Tests = (
# File Exit Code
'success.plx' => 0,
'one_fail.plx' => 1,
'two_fail.plx' => 2,
'five_fail.plx' => 5,
'extras.plx' => 2,
'too_few.plx' => 255,
'too_few_fail.plx' => 2,
'death.plx' => 255,
'last_minute_death.plx' => 255,
'pre_plan_death.plx' => 'not zero',
'death_in_eval.plx' => 0,
'require.plx' => 0,
'death_with_handler.plx' => 255,
'exit.plx' => 1,
'one_fail_without_plan.plx' => 1,
'missing_done_testing.plx' => 254,
);
chdir 't';
my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests));
while( my($test_name, $exit_code) = each %Tests ) {
my $file = File::Spec->catfile($lib, $test_name);
my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file});
my $actual_exit = exitstatus($wait_stat);
if( $exit_code eq 'not zero' ) {
$TB->isnt_num( $actual_exit, $Exit_Map{0},
"$test_name exited with $actual_exit ".
"(expected non-zero)");
}
else {
$TB->is_num( $actual_exit, $Exit_Map{$exit_code},
"$test_name exited with $actual_exit ".
"(expected $Exit_Map{$exit_code})");
}
}
$TB->done_testing( scalar keys(%Tests) + 256 );
# So any END block file cleanup works.
chdir $Orig_Dir;
PK 1��\)� �F F t/Legacy/explain.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use warnings;
use Test::More tests => 5;
can_ok "main", "explain";
is_deeply [explain("foo")], ["foo"];
is_deeply [explain("foo", "bar")], ["foo", "bar"];
# Avoid future dump formatting changes from breaking tests by just eval'ing
# the dump
is_deeply [map { eval $_ } explain([], {})], [[], {}];
is_deeply [map { eval $_ } explain(23, [42,91], 99)], [23, [42, 91], 99];
PK 1��\Wr�z z t/Legacy/explain_err_vars.tnu �[��� use strict;
use warnings;
use Test::More;
$@ = 'foo';
explain { 1 => 1 };
is($@, 'foo', "preserved \$@");
done_testing;
PK 1��\�xL�r r t/Legacy/extra.tnu �[��� #!perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use Test::Builder;
use Test::Builder::NoOutput;
use Test::Simple;
# TB methods expect to be wrapped
my $ok = sub { shift->ok(@_) };
my $plan = sub { shift->plan(@_) };
my $done_testing = sub { shift->done_testing(@_) };
my $TB = Test::Builder->new;
my $test = Test::Builder::NoOutput->create;
$test->$plan( tests => 3 );
local $ENV{HARNESS_ACTIVE} = 0;
$test->$ok(1, 'Foo');
$TB->is_eq($test->read(), <<END);
1..3
ok 1 - Foo
END
#line 30
$test->$ok(0, 'Bar');
$TB->is_eq($test->read(), <<END);
not ok 2 - Bar
# Failed test 'Bar'
# at $0 line 30.
END
$test->$ok(1, 'Yar');
$test->$ok(1, 'Car');
$TB->is_eq($test->read(), <<END);
ok 3 - Yar
ok 4 - Car
END
#line 45
$test->$ok(0, 'Sar');
$TB->is_eq($test->read(), <<END);
not ok 5 - Sar
# Failed test 'Sar'
# at $0 line 45.
END
$test->_ending();
$TB->is_eq($test->read(), <<END);
# Looks like you planned 3 tests but ran 5.
# Looks like you failed 2 tests of 5 run.
END
$TB->$done_testing(5);
PK 1��\�
� � t/Legacy/extra_one.tnu �[��� #!/usr/bin/perl -w
# HARNESS-NO-STREAM
# HARNESS-NO-PRELOAD
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
# This has to be a require or else the END block below runs before
# Test::Builder's own and the ending diagnostics don't come out right.
require Test::Builder;
my $TB = Test::Builder->create;
$TB->plan(tests => 2);
sub is { $TB->is_eq(@_) }
package main;
require Test::Simple;
Test::Simple->import(tests => 1);
ok(1);
ok(1);
ok(1);
END {
My::Test::is($$out, <<OUT);
1..1
ok 1
ok 2
ok 3
OUT
My::Test::is($$err, <<ERR);
# Looks like you planned 1 test but ran 3.
ERR
# Prevent Test::Simple from existing with non-zero
exit 0;
}
PK 1��\7:E; ; t/Legacy/fail-like.tnu �[��� #!/usr/bin/perl -w
# HARNESS-NO-STREAM
# HARNESS-NO-PRELOAD
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
# There was a bug with like() involving a qr// not failing properly.
# This tests against that.
use strict;
# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
# This has to be a require or else the END block below runs before
# Test::Builder's own and the ending diagnostics don't come out right.
require Test::Builder;
my $TB = Test::Builder->create;
$TB->plan(tests => 4);
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
local $ENV{HARNESS_ACTIVE} = 0;
package main;
require Test::More;
Test::More->import(tests => 1);
{
eval q{ like( "foo", qr/that/, 'is foo like that' ); };
$TB->is_eq($out->read, <<OUT, 'failing output');
1..1
not ok 1 - is foo like that
OUT
# Accept both old and new-style stringification
my $modifiers = (qr/foobar/ =~ /\Q(?^/) ? '\\^' : '-xism';
my $err_re = <<ERR;
# Failed test 'is foo like that'
# at .* line 1\.
# 'foo'
# doesn't match '\\(\\?$modifiers:that\\)'
ERR
$TB->like($err->read, qr/^$err_re$/, 'failing errors');
}
{
# line 62
like("foo", "not a regex");
$TB->is_eq($out->read, <<OUT);
not ok 2
OUT
$TB->is_eq($err->read, <<OUT);
# Failed test at $0 line 62.
# 'not a regex' doesn't look much like a regex to me.
OUT
}
END {
# Test::More thinks it failed. Override that.
$? = scalar grep { !$_ } $TB->summary;
}
PK 1��\�&�4* 4* t/Legacy/fail-more.tnu �[��� #!perl -w
# HARNESS-NO-STREAM
# HARNESS-NO-PRELOAD
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
local $ENV{HARNESS_ACTIVE} = 0;
# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
# This has to be a require or else the END block below runs before
# Test::Builder's own and the ending diagnostics don't come out right.
require Test::Builder;
my $TB = Test::Builder->create;
$TB->plan(tests => 80);
sub like ($$;$) {
$TB->like(@_);
}
sub is ($$;$) {
$TB->is_eq(@_);
}
sub main::out_ok ($$) {
$TB->is_eq( $out->read, shift );
$TB->is_eq( $err->read, shift );
}
sub main::out_like ($$) {
my($output, $failure) = @_;
$TB->like( $out->read, qr/$output/ );
$TB->like( $err->read, qr/$failure/ );
}
package main;
require Test::More;
our $TODO;
my $Total = 38;
Test::More->import(tests => $Total);
$out->read; # clear the plan from $out
# This should all work in the presence of a __DIE__ handler.
local $SIG{__DIE__} = sub { $TB->ok(0, "DIE handler called: ".join "", @_); };
my $tb = Test::More->builder;
$tb->use_numbers(0);
my $Filename = quotemeta $0;
#line 38
ok( 0, 'failing' );
out_ok( <<OUT, <<ERR );
not ok - failing
OUT
# Failed test 'failing'
# at $0 line 38.
ERR
#line 40
is( "foo", "bar", 'foo is bar?');
out_ok( <<OUT, <<ERR );
not ok - foo is bar?
OUT
# Failed test 'foo is bar?'
# at $0 line 40.
# got: 'foo'
# expected: 'bar'
ERR
#line 89
is( undef, '', 'undef is empty string?');
out_ok( <<OUT, <<ERR );
not ok - undef is empty string?
OUT
# Failed test 'undef is empty string?'
# at $0 line 89.
# got: undef
# expected: ''
ERR
#line 99
is( undef, 0, 'undef is 0?');
out_ok( <<OUT, <<ERR );
not ok - undef is 0?
OUT
# Failed test 'undef is 0?'
# at $0 line 99.
# got: undef
# expected: '0'
ERR
#line 110
is( '', 0, 'empty string is 0?' );
out_ok( <<OUT, <<ERR );
not ok - empty string is 0?
OUT
# Failed test 'empty string is 0?'
# at $0 line 110.
# got: ''
# expected: '0'
ERR
#line 121
isnt("foo", "foo", 'foo isnt foo?' );
out_ok( <<OUT, <<ERR );
not ok - foo isnt foo?
OUT
# Failed test 'foo isnt foo?'
# at $0 line 121.
# got: 'foo'
# expected: anything else
ERR
#line 132
isn't("foo", "foo",'foo isn\'t foo?' );
out_ok( <<OUT, <<ERR );
not ok - foo isn't foo?
OUT
# Failed test 'foo isn\'t foo?'
# at $0 line 132.
# got: 'foo'
# expected: anything else
ERR
#line 143
isnt(undef, undef, 'undef isnt undef?');
out_ok( <<OUT, <<ERR );
not ok - undef isnt undef?
OUT
# Failed test 'undef isnt undef?'
# at $0 line 143.
# got: undef
# expected: anything else
ERR
#line 154
like( "foo", '/that/', 'is foo like that' );
out_ok( <<OUT, <<ERR );
not ok - is foo like that
OUT
# Failed test 'is foo like that'
# at $0 line 154.
# 'foo'
# doesn't match '/that/'
ERR
#line 165
unlike( "foo", '/foo/', 'is foo unlike foo' );
out_ok( <<OUT, <<ERR );
not ok - is foo unlike foo
OUT
# Failed test 'is foo unlike foo'
# at $0 line 165.
# 'foo'
# matches '/foo/'
ERR
# Nick Clark found this was a bug. Fixed in 0.40.
# line 177
like( "bug", '/(%)/', 'regex with % in it' );
out_ok( <<OUT, <<ERR );
not ok - regex with % in it
OUT
# Failed test 'regex with % in it'
# at $0 line 177.
# 'bug'
# doesn't match '/(%)/'
ERR
#line 188
fail('fail()');
out_ok( <<OUT, <<ERR );
not ok - fail()
OUT
# Failed test 'fail()'
# at $0 line 188.
ERR
#line 197
can_ok('Mooble::Hooble::Yooble', qw(this that));
out_ok( <<OUT, <<ERR );
not ok - Mooble::Hooble::Yooble->can(...)
OUT
# Failed test 'Mooble::Hooble::Yooble->can(...)'
# at $0 line 197.
# Mooble::Hooble::Yooble->can('this') failed
# Mooble::Hooble::Yooble->can('that') failed
ERR
#line 208
can_ok('Mooble::Hooble::Yooble', ());
out_ok( <<OUT, <<ERR );
not ok - Mooble::Hooble::Yooble->can(...)
OUT
# Failed test 'Mooble::Hooble::Yooble->can(...)'
# at $0 line 208.
# can_ok() called with no methods
ERR
#line 218
can_ok(undef, undef);
out_ok( <<OUT, <<ERR );
not ok - ->can(...)
OUT
# Failed test '->can(...)'
# at $0 line 218.
# can_ok() called with empty class or reference
ERR
#line 228
can_ok([], "foo");
out_ok( <<OUT, <<ERR );
not ok - ARRAY->can('foo')
OUT
# Failed test 'ARRAY->can('foo')'
# at $0 line 228.
# ARRAY->can('foo') failed
ERR
#line 238
isa_ok(bless([], "Foo"), "Wibble");
out_ok( <<OUT, <<ERR );
not ok - An object of class 'Foo' isa 'Wibble'
OUT
# Failed test 'An object of class 'Foo' isa 'Wibble''
# at $0 line 238.
# The object of class 'Foo' isn't a 'Wibble'
ERR
#line 248
isa_ok(42, "Wibble", "My Wibble");
out_ok( <<OUT, <<ERR );
not ok - 'My Wibble' isa 'Wibble'
OUT
# Failed test ''My Wibble' isa 'Wibble''
# at $0 line 248.
# 'My Wibble' isn't a 'Wibble'
ERR
#line 252
isa_ok(42, "Wibble");
out_ok( <<OUT, <<ERR );
not ok - The class (or class-like) '42' isa 'Wibble'
OUT
# Failed test 'The class (or class-like) '42' isa 'Wibble''
# at $0 line 252.
# The class (or class-like) '42' isn't a 'Wibble'
ERR
#line 258
isa_ok(undef, "Wibble", "Another Wibble");
out_ok( <<OUT, <<ERR );
not ok - 'Another Wibble' isa 'Wibble'
OUT
# Failed test ''Another Wibble' isa 'Wibble''
# at $0 line 258.
# 'Another Wibble' isn't defined
ERR
#line 268
isa_ok([], "HASH");
out_ok( <<OUT, <<ERR );
not ok - A reference of type 'ARRAY' isa 'HASH'
OUT
# Failed test 'A reference of type 'ARRAY' isa 'HASH''
# at $0 line 268.
# The reference of type 'ARRAY' isn't a 'HASH'
ERR
#line 278
new_ok(undef);
out_like( <<OUT, <<ERR );
not ok - undef->new\\(\\) died
OUT
# Failed test 'undef->new\\(\\) died'
# at $Filename line 278.
# Error was: Can't call method "new" on an undefined value at .*
ERR
#line 288
new_ok( "Does::Not::Exist" );
out_like( <<OUT, <<ERR );
not ok - Does::Not::Exist->new\\(\\) died
OUT
# Failed test 'Does::Not::Exist->new\\(\\) died'
# at $Filename line 288.
# Error was: Can't locate object method "new" via package "Does::Not::Exist" .*
ERR
{ package Foo; sub new { } }
{ package Bar; sub new { {} } }
{ package Baz; sub new { bless {}, "Wibble" } }
#line 303
new_ok( "Foo" );
out_ok( <<OUT, <<ERR );
not ok - undef isa 'Foo'
OUT
# Failed test 'undef isa 'Foo''
# at $0 line 303.
# undef isn't defined
ERR
# line 313
new_ok( "Bar" );
out_ok( <<OUT, <<ERR );
not ok - A reference of type 'HASH' isa 'Bar'
OUT
# Failed test 'A reference of type 'HASH' isa 'Bar''
# at $0 line 313.
# The reference of type 'HASH' isn't a 'Bar'
ERR
#line 323
new_ok( "Baz" );
out_ok( <<OUT, <<ERR );
not ok - An object of class 'Wibble' isa 'Baz'
OUT
# Failed test 'An object of class 'Wibble' isa 'Baz''
# at $0 line 323.
# The object of class 'Wibble' isn't a 'Baz'
ERR
#line 333
new_ok( "Baz", [], "no args" );
out_ok( <<OUT, <<ERR );
not ok - 'no args' isa 'Baz'
OUT
# Failed test ''no args' isa 'Baz''
# at $0 line 333.
# 'no args' isn't a 'Baz'
ERR
#line 343
cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' );
out_ok( <<OUT, <<ERR );
not ok - cmp_ok eq
OUT
# Failed test 'cmp_ok eq'
# at $0 line 343.
# got: 'foo'
# expected: 'bar'
ERR
#line 354
cmp_ok( 42.1, '==', 23, , ' ==' );
out_ok( <<OUT, <<ERR );
not ok - ==
OUT
# Failed test ' =='
# at $0 line 354.
# got: 42.1
# expected: 23
ERR
#line 365
cmp_ok( 42, '!=', 42 , ' !=' );
out_ok( <<OUT, <<ERR );
not ok - !=
OUT
# Failed test ' !='
# at $0 line 365.
# got: 42
# expected: anything else
ERR
#line 376
cmp_ok( 1, '&&', 0 , ' &&' );
out_ok( <<OUT, <<ERR );
not ok - &&
OUT
# Failed test ' &&'
# at $0 line 376.
# '1'
# &&
# '0'
ERR
# line 388
cmp_ok( 42, 'eq', "foo", ' eq with numbers' );
out_ok( <<OUT, <<ERR );
not ok - eq with numbers
OUT
# Failed test ' eq with numbers'
# at $0 line 388.
# got: '42'
# expected: 'foo'
ERR
{
my $warnings = '';
local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
# line 415
cmp_ok( 42, '==', "foo", ' == with strings' );
out_ok( <<OUT, <<ERR );
not ok - == with strings
OUT
# Failed test ' == with strings'
# at $0 line 415.
# got: 42
# expected: foo
ERR
My::Test::like(
$warnings,
qr/^Argument "foo" isn't numeric in .* at \(eval in cmp_ok\) $Filename line 415\.\n$/
);
$warnings = '';
}
{
my $warnings = '';
local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
#line 437
cmp_ok( undef, "ne", "", "undef ne empty string" );
$TB->is_eq( $out->read, <<OUT );
not ok - undef ne empty string
OUT
$TB->is_eq( $err->read, <<ERR );
# Failed test 'undef ne empty string'
# at $0 line 437.
# undef
# ne
# ''
ERR
My::Test::like(
$warnings,
qr/^Use of uninitialized value.* in string ne at \(eval in cmp_ok\) $Filename line 437.\n\z/
);
}
# generate a $!, it changes its value by context.
-e "wibblehibble";
my $Errno_Number = $!+0;
my $Errno_String = $!.'';
#line 425
cmp_ok( $!, 'eq', '', ' eq with stringified errno' );
out_ok( <<OUT, <<ERR );
not ok - eq with stringified errno
OUT
# Failed test ' eq with stringified errno'
# at $0 line 425.
# got: '$Errno_String'
# expected: ''
ERR
#line 436
cmp_ok( $!, '==', -1, ' eq with numerified errno' );
out_ok( <<OUT, <<ERR );
not ok - eq with numerified errno
OUT
# Failed test ' eq with numerified errno'
# at $0 line 436.
# got: $Errno_Number
# expected: -1
ERR
#line 447
use_ok('Hooble::mooble::yooble');
my $more_err_re = <<ERR;
# Failed test 'use Hooble::mooble::yooble;'
# at $Filename line 447\\.
# Tried to use 'Hooble::mooble::yooble'.
# Error: Can't locate Hooble.* in \\\@INC .*
ERR
out_like(
qr/^\Qnot ok - use Hooble::mooble::yooble;\E\n\z/,
qr/^$more_err_re/
);
#line 460
require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble');
$more_err_re = <<ERR;
# Failed test 'require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;'
# at $Filename line 460\\.
# Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'.
# Error: Can't locate ALL.* in \\\@INC .*
ERR
out_like(
qr/^\Qnot ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;\E\n\z/,
qr/^$more_err_re/
);
END {
out_like( <<OUT, <<ERR );
OUT
# Looks like you failed $Total tests of $Total.
ERR
exit(0);
}
PK 1��\eO��� � t/Legacy/fail.tnu �[��� #!perl -w
# Simple test of what failure output looks like
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
# Normalize the output whether we're running under Test::Harness or not.
local $ENV{HARNESS_ACTIVE} = 0;
use Test::Builder;
use Test::Builder::NoOutput;
# TB methods expect to be wrapped
my $ok = sub { shift->ok(@_) };
my $plan = sub { shift->plan(@_) };
my $done_testing = sub { shift->done_testing(@_) };
my $Test = Test::Builder->new;
# Set up a builder to record some failing tests.
{
my $tb = Test::Builder::NoOutput->create;
$tb->$plan( tests => 5 );
#line 28
$tb->$ok( 1, 'passing' );
$tb->$ok( 2, 'passing still' );
$tb->$ok( 3, 'still passing' );
$tb->$ok( 0, 'oh no!' );
$tb->$ok( 0, 'damnit' );
$tb->_ending;
$Test->is_eq($tb->read('out'), <<OUT);
1..5
ok 1 - passing
ok 2 - passing still
ok 3 - still passing
not ok 4 - oh no!
not ok 5 - damnit
OUT
$Test->is_eq($tb->read('err'), <<ERR);
# Failed test 'oh no!'
# at $0 line 31.
# Failed test 'damnit'
# at $0 line 32.
# Looks like you failed 2 tests of 5.
ERR
$Test->$done_testing(2);
}
PK 1��\
VL�i i t/Legacy/fail_one.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
# Normalize the output whether we're running under Test::Harness or not.
local $ENV{HARNESS_ACTIVE} = 0;
use Test::Builder;
use Test::Builder::NoOutput;
# TB methods expect to be wrapped
my $ok = sub { shift->ok(@_) };
my $plan = sub { shift->plan(@_) };
my $done_testing = sub { shift->done_testing(@_) };
my $Test = Test::Builder->new;
{
my $tb = Test::Builder::NoOutput->create;
$tb->$plan( tests => 1 );
#line 28
$tb->$ok(0);
$tb->_ending;
$Test->is_eq($tb->read('out'), <<OUT);
1..1
not ok 1
OUT
$Test->is_eq($tb->read('err'), <<ERR);
# Failed test at $0 line 28.
# Looks like you failed 1 test of 1.
ERR
$Test->$done_testing(2);
}
PK 1��\-e" " t/Legacy/filehandles.tnu �[��� #!perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
}
use lib 't/lib';
use Test::More tests => 1;
use Dev::Null;
tie *STDOUT, "Dev::Null" or die $!;
print "not ok 1\n"; # this should not print.
pass 'STDOUT can be mucked with';
PK 1��\+�Og� � t/Legacy/fork.tnu �[��� #!/usr/bin/perl -w
use strict;
use warnings;
use Test2::Util qw/CAN_FORK/;
BEGIN {
unless(CAN_FORK) {
require Test::More;
Test::More->import(skip_all => "fork is not supported");
}
}
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::More;
plan tests => 1;
if( fork ) { # parent
pass("Only the parent should process the ending, not the child");
}
else {
exit; # child
}
PK 1��\{�s� � t/Legacy/harness_active.tnu �[��� #!perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
# This has to be a require or else the END block below runs before
# Test::Builder's own and the ending diagnostics don't come out right.
require Test::Builder;
my $TB = Test::Builder->create;
$TB->plan(tests => 4);
# Utility testing functions.
sub ok ($;$) {
return $TB->ok(@_);
}
sub main::err_ok ($) {
my($expect) = @_;
my $got = $err->read;
return $TB->is_eq( $got, $expect );
}
package main;
require Test::More;
Test::More->import(tests => 4);
Test::More->builder->no_ending(1);
{
local $ENV{HARNESS_ACTIVE} = 0;
local $ENV{HARNESS_IS_VERBOSE} = 0;
#line 62
fail( "this fails" );
err_ok( <<ERR );
# Failed test 'this fails'
# at $0 line 62.
ERR
#line 72
is( 1, 0 );
err_ok( <<ERR );
# Failed test at $0 line 72.
# got: '1'
# expected: '0'
ERR
}
{
local $ENV{HARNESS_ACTIVE} = 1;
local $ENV{HARNESS_IS_VERBOSE} = 0;
#line 71
fail( "this fails" );
err_ok( <<ERR );
# Failed test 'this fails'
# at $0 line 71.
ERR
#line 84
is( 1, 0 );
err_ok( <<ERR );
# Failed test at $0 line 84.
# got: '1'
# expected: '0'
ERR
}
PK 1��\J��� � t/Legacy/import.tnu �[��� BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::More tests => 2, import => [qw(!fail)];
can_ok(__PACKAGE__, qw(ok pass like isa_ok));
ok( !__PACKAGE__->can('fail'), 'fail() not exported' );
PK 1��\�6��w w t/Legacy/is_deeply_dne_bug.tnu �[��� #!/usr/bin/perl -w
# test for rt.cpan.org 20768
#
# There was a bug where the internal "does not exist" object could get
# confused with an overloaded object.
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use Test::More tests => 2;
{
package Foo;
use overload
'eq' => \&overload_equiv,
'==' => \&overload_equiv;
sub new {
return bless {}, shift;
}
sub overload_equiv {
if (ref($_[0]) ne 'Foo' || ref($_[1]) ne 'Foo') {
print ref($_[0]), " ", ref($_[1]), "\n";
die "Invalid object passed to overload_equiv\n";
}
return 1; # change to 0 ... makes little difference
}
}
my $obj1 = Foo->new();
my $obj2 = Foo->new();
eval { is_deeply([$obj1, $obj2], [$obj1, $obj2]); };
is $@, '';
PK 1��\�5ί. . t/Legacy/is_deeply_fail.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use Test::Builder;
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
Test::Builder->new->no_header(1);
Test::Builder->new->no_ending(1);
local $ENV{HARNESS_ACTIVE} = 0;
# Can't use Test.pm, that's a 5.005 thing.
package main;
my $TB = Test::Builder->create;
$TB->plan(tests => 102);
# Utility testing functions.
sub ok ($;$) {
return $TB->ok(@_);
}
sub is ($$;$) {
my($thing, $that, $name) = @_;
my $ok = $TB->is_eq($$thing, $that, $name);
$$thing = '';
return $ok;
}
sub like ($$;$) {
my($thing, $regex, $name) = @_;
$regex = "/$regex/" if !ref $regex and $regex !~ m{^/.*/$}s;
my $ok = $TB->like($$thing, $regex, $name);
$$thing = '';
return $ok;
}
require Test::More;
Test::More->import(tests => 11, import => ['is_deeply']);
my $Filename = quotemeta $0;
#line 68
ok !is_deeply('foo', 'bar', 'plain strings');
is( $out, "not ok 1 - plain strings\n", 'plain strings' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'plain strings'
# at $0 line 68.
# got: 'foo'
# expected: 'bar'
ERR
#line 78
ok !is_deeply({}, [], 'different types');
is( $out, "not ok 2 - different types\n", 'different types' );
like( $err, <<ERR, ' right diagnostic' );
# Failed test 'different types'
# at $Filename line 78.
# Structures begin differing at:
# \\\$got = HASH\\(0x[0-9a-f]+\\)
# \\\$expected = ARRAY\\(0x[0-9a-f]+\\)
ERR
#line 88
ok !is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values');
is( $out, "not ok 3 - hashes with different values\n",
'hashes with different values' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'hashes with different values'
# at $0 line 88.
# Structures begin differing at:
# \$got->{this} = '42'
# \$expected->{this} = '43'
ERR
#line 99
ok !is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys');
is( $out, "not ok 4 - hashes with different keys\n",
'hashes with different keys' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'hashes with different keys'
# at $0 line 99.
# Structures begin differing at:
# \$got->{this} = Does not exist
# \$expected->{this} = '42'
ERR
#line 110
ok !is_deeply([1..9], [1..10], 'arrays of different length');
is( $out, "not ok 5 - arrays of different length\n",
'arrays of different length' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'arrays of different length'
# at $0 line 110.
# Structures begin differing at:
# \$got->[9] = Does not exist
# \$expected->[9] = '10'
ERR
#line 121
ok !is_deeply([undef, undef], [undef], 'arrays of undefs' );
is( $out, "not ok 6 - arrays of undefs\n", 'arrays of undefs' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'arrays of undefs'
# at $0 line 121.
# Structures begin differing at:
# \$got->[1] = undef
# \$expected->[1] = Does not exist
ERR
#line 131
ok !is_deeply({ foo => undef }, {}, 'hashes of undefs' );
is( $out, "not ok 7 - hashes of undefs\n", 'hashes of undefs' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'hashes of undefs'
# at $0 line 131.
# Structures begin differing at:
# \$got->{foo} = undef
# \$expected->{foo} = Does not exist
ERR
#line 141
ok !is_deeply(\42, \23, 'scalar refs');
is( $out, "not ok 8 - scalar refs\n", 'scalar refs' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'scalar refs'
# at $0 line 141.
# Structures begin differing at:
# \${ \$got} = '42'
# \${\$expected} = '23'
ERR
#line 151
ok !is_deeply([], \23, 'mixed scalar and array refs');
is( $out, "not ok 9 - mixed scalar and array refs\n",
'mixed scalar and array refs' );
like( $err, <<ERR, ' right diagnostic' );
# Failed test 'mixed scalar and array refs'
# at $Filename line 151.
# Structures begin differing at:
# \\\$got = ARRAY\\(0x[0-9a-f]+\\)
# \\\$expected = SCALAR\\(0x[0-9a-f]+\\)
ERR
my($a1, $a2, $a3);
$a1 = \$a2; $a2 = \$a3;
$a3 = 42;
my($b1, $b2, $b3);
$b1 = \$b2; $b2 = \$b3;
$b3 = 23;
#line 173
ok !is_deeply($a1, $b1, 'deep scalar refs');
is( $out, "not ok 10 - deep scalar refs\n", 'deep scalar refs' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'deep scalar refs'
# at $0 line 173.
# Structures begin differing at:
# \${\${ \$got}} = '42'
# \${\${\$expected}} = '23'
ERR
# I don't know how to properly display this structure.
# $a2 = { foo => \$a3 };
# $b2 = { foo => \$b3 };
# is_deeply([$a1], [$b1], 'deep mixed scalar refs');
my $foo = {
this => [1..10],
that => { up => "down", left => "right" },
};
my $bar = {
this => [1..10],
that => { up => "down", left => "right", foo => 42 },
};
#line 198
ok !is_deeply( $foo, $bar, 'deep structures' );
ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' );
is( $out, "not ok 11 - deep structures\n", 'deep structures' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'deep structures'
# at $0 line 198.
# Structures begin differing at:
# \$got->{that}{foo} = Does not exist
# \$expected->{that}{foo} = '42'
ERR
#line 221
my @tests = ([],
[qw(42)],
[qw(42 23), qw(42 23)]
);
foreach my $test (@tests) {
my $num_args = @$test;
my $warning;
local $SIG{__WARN__} = sub { $warning .= join '', @_; };
ok !is_deeply(@$test);
like \$warning,
"/^is_deeply\\(\\) takes two or three args, you gave $num_args\.\n/";
}
#line 240
# [rt.cpan.org 6837]
ok !is_deeply([{Foo => undef}],[{Foo => ""}]), 'undef != ""';
ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' );
#line 258
# [rt.cpan.org 7031]
my $a = [];
ok !is_deeply($a, $a.''), "don't compare refs like strings";
ok !is_deeply([$a], [$a.'']), " even deep inside";
#line 265
# [rt.cpan.org 7030]
ok !is_deeply( {}, {key => []} ), '[] could match non-existent values';
ok !is_deeply( [], [[]] );
#line 273
$$err = $$out = '';
ok !is_deeply( [\'a', 'b'], [\'a', 'c'] );
is( $out, "not ok 20\n", 'scalar refs in an array' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test at $0 line 274.
# Structures begin differing at:
# \$got->[1] = 'b'
# \$expected->[1] = 'c'
ERR
#line 285
my $ref = \23;
ok !is_deeply( 23, $ref );
is( $out, "not ok 21\n", 'scalar vs ref' );
is( $err, <<ERR, ' right diagnostic');
# Failed test at $0 line 286.
# Structures begin differing at:
# \$got = '23'
# \$expected = $ref
ERR
#line 296
ok !is_deeply( $ref, 23 );
is( $out, "not ok 22\n", 'ref vs scalar' );
is( $err, <<ERR, ' right diagnostic');
# Failed test at $0 line 296.
# Structures begin differing at:
# \$got = $ref
# \$expected = '23'
ERR
#line 306
ok !is_deeply( undef, [] );
is( $out, "not ok 23\n", 'is_deeply and undef [RT 9441]' );
like( $err, <<ERR, ' right diagnostic' );
# Failed test at $Filename line 306\\.
# Structures begin differing at:
# \\\$got = undef
# \\\$expected = ARRAY\\(0x[0-9a-f]+\\)
ERR
# rt.cpan.org 8865
{
my $array = [];
my $hash = {};
#line 321
ok !is_deeply( $array, $hash );
is( $out, "not ok 24\n", 'is_deeply and different reference types' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test at $0 line 321.
# Structures begin differing at:
# \$got = $array
# \$expected = $hash
ERR
#line 332
ok !is_deeply( [$array], [$hash] );
is( $out, "not ok 25\n", 'nested different ref types' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test at $0 line 332.
# Structures begin differing at:
# \$got->[0] = $array
# \$expected->[0] = $hash
ERR
# Overloaded object tests
{
my $foo = bless [], "Foo";
my $bar = bless {}, "Bar";
{
package Bar;
"overload"->import(q[""] => sub { "wibble" });
}
#line 353
ok !is_deeply( [$foo], [$bar] );
is( $out, "not ok 26\n", 'string overloaded refs respected in diag' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test at $0 line 353.
# Structures begin differing at:
# \$got->[0] = $foo
# \$expected->[0] = 'wibble'
ERR
}
}
# rt.cpan.org 14746
{
# line 349
ok !is_deeply( sub {"foo"}, sub {"bar"} ), 'function refs';
is( $out, "not ok 27\n" );
like( $err, <<ERR, ' right diagnostic' );
# Failed test at $Filename line 349.
# Structures begin differing at:
# \\\$got = CODE\\(0x[0-9a-f]+\\)
# \\\$expected = CODE\\(0x[0-9a-f]+\\)
ERR
use Symbol;
my $glob1 = gensym;
my $glob2 = gensym;
#line 357
ok !is_deeply( $glob1, $glob2 ), 'typeglobs';
is( $out, "not ok 28\n" );
like( $err, <<ERR, ' right diagnostic' );
# Failed test at $Filename line 357.
# Structures begin differing at:
# \\\$got = GLOB\\(0x[0-9a-f]+\\)
# \\\$expected = GLOB\\(0x[0-9a-f]+\\)
ERR
}
# rt.cpan.org 53469
{
# Accept both old and new-style stringification
my $modifiers = (qr/foobar/ =~ /\Q(?^/) ? '^' : '-xism';
#line 380
ok !is_deeply( qr/a/, qr/b/, "different regexes" );
is( $out, "not ok 29 - different regexes\n" );
is( $err, <<ERR, ' right diagnostic' );
# Failed test 'different regexes'
# at $0 line 380.
# Structures begin differing at:
# \$got = (?$modifiers:a)
# \$expected = (?$modifiers:b)
ERR
}
# false values that should not compare equal
{
ok !is_deeply( 0, '', "0 != ''" );
is( $out, "not ok 30 - 0 != ''\n" );
ok !is_deeply( 0, undef, "0 != undef" );
is( $out, "not ok 31 - 0 != undef\n" );
ok !is_deeply( '', undef, "'' != undef" );
is( $out, "not ok 32 - '' != undef\n" );
ok !is_deeply( [0], [''], "[0] != ['']" );
is( $out, "not ok 33 - [0] != ['']\n" );
ok !is_deeply( [0], [undef], "[0] != [undef]" );
is( $out, "not ok 34 - [0] != [undef]\n" );
ok !is_deeply( [''], [undef], "[''] != [undef]" );
is( $out, "not ok 35 - [''] != [undef]\n" );
ok !is_deeply( [0], [], "[0] != []" );
is( $out, "not ok 36 - [0] != []\n" );
ok !is_deeply( [undef], [], "[undef] != []" );
is( $out, "not ok 37 - [undef] != []\n" );
ok !is_deeply( [''], [], "[''] != []" );
is( $out, "not ok 38 - [''] != []\n" );
ok !is_deeply( {x => 0}, {x => ''}, "{x => 0} != {x => ''}" );
is( $out, "not ok 39 - {x => 0} != {x => ''}\n" );
ok !is_deeply( {x => 0}, {x => undef}, "{x => 0} != {x => undef}" );
is( $out, "not ok 40 - {x => 0} != {x => undef}\n" );
ok !is_deeply( {x => ''}, {x => undef}, "{x => ''} != {x => undef}" );
is( $out, "not ok 41 - {x => ''} != {x => undef}\n" );
}
# this will also happily fail before 5.10, even though there's no VSTRING ref type
{
my $version1 = v1.2.3;
my $version2 = v1.2.4;
ok !is_deeply( [\\$version1], [\\$version2], "version objects");
is( $out, "not ok 42 - version objects\n" );
}
PK 1��\ni+�y y ! t/Legacy/is_deeply_with_threads.tnu �[��� #!/usr/bin/perl -w
# Test to see if is_deeply() plays well with threads.
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use Test2::Util qw/CAN_THREAD/;
BEGIN {
unless(CAN_THREAD) {
require Test::More;
Test::More->import(skip_all => "threads are not supported");
}
}
use threads;
BEGIN {
unless ( $ENV{AUTHOR_TESTING} ) {
print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n";
exit 0;
}
}
use Test::More;
my $Num_Threads = 5;
plan tests => $Num_Threads * 100 + 6;
sub do_one_thread {
my $kid = shift;
my @list = ( 'x', 'yy', 'zzz', 'a', 'bb', 'ccc', 'aaaaa', 'z',
'hello', 's', 'thisisalongname', '1', '2', '3',
'abc', 'xyz', '1234567890', 'm', 'n', 'p' );
my @list2 = @list;
print "# kid $kid before is_deeply\n";
for my $j (1..100) {
is_deeply(\@list, \@list2);
}
print "# kid $kid exit\n";
return 42;
}
my @kids = ();
for my $i (1..$Num_Threads) {
my $t = threads->new(\&do_one_thread, $i);
print "# parent $$: continue\n";
push(@kids, $t);
}
for my $t (@kids) {
print "# parent $$: waiting for join\n";
my $rc = $t->join();
cmp_ok( $rc, '==', 42, "threads exit status is $rc" );
}
pass("End of test");
PK 1��\f�0M M t/Legacy/missing.tnu �[��� # HARNESS-NO-STREAM
# HARNESS-NO-PRELOAD
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
# This has to be a require or else the END block below runs before
# Test::Builder's own and the ending diagnostics don't come out right.
require Test::Builder;
my $TB = Test::Builder->create;
$TB->plan(tests => 2);
sub is { $TB->is_eq(@_) }
package main;
require Test::Simple;
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
local $ENV{HARNESS_ACTIVE} = 0;
Test::Simple->import(tests => 5);
#line 30
ok(1, 'Foo');
ok(0, 'Bar');
ok(1, '1 2 3');
END {
My::Test::is($$out, <<OUT);
1..5
ok 1 - Foo
not ok 2 - Bar
ok 3 - 1 2 3
OUT
My::Test::is($$err, <<ERR);
# Failed test 'Bar'
# at $0 line 31.
# You named your test '1 2 3'. You shouldn't use numbers for your test names.
# Very confusing.
# Looks like you planned 5 tests but ran 3.
# Looks like you failed 1 test of 3 run.
ERR
exit 0;
}
PK 1��\���� � t/Legacy/new_ok.tnu �[��� #!/usr/bin/perl -w
use strict;
use Test::More tests => 13;
{
package Bar;
sub new {
my $class = shift;
return bless {@_}, $class;
}
package Foo;
our @ISA = qw(Bar);
}
{
my $obj = new_ok("Foo");
is_deeply $obj, {};
isa_ok $obj, "Foo";
$obj = new_ok("Bar");
is_deeply $obj, {};
isa_ok $obj, "Bar";
$obj = new_ok("Foo", [this => 42]);
is_deeply $obj, { this => 42 };
isa_ok $obj, "Foo";
$obj = new_ok("Foo", [], "Foo");
is_deeply $obj, {};
isa_ok $obj, "Foo";
}
# And what if we give it nothing?
eval {
new_ok();
};
is $@, sprintf "new_ok() must be given at least a class at %s line %d.\n", $0, __LINE__ - 2;
PK 1��\B��
t/Legacy/no_log_results.tnu �[��� use strict;
use warnings;
use Test::More;
sub it {
my $tb = Test::Builder->new;
$tb->no_log_results;
ok(1, "sample");
ok(2, "sample");
is_deeply([$tb->details], [], "no details were logged");
}
it();
subtest it => \⁢
done_testing;
PK 1��\��=H H t/Legacy/no_plan.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use Test::More tests => 7;
my $tb = Test::Builder->create;
# TB methods expect to be wrapped
my $ok = sub { shift->ok(@_) };
my $plan = sub { shift->plan(@_) };
my $done_testing = sub { shift->done_testing(@_) };
#line 20
ok !eval { $tb->$plan(tests => undef) };
is($@, "Got an undefined number of tests at $0 line 20.\n");
#line 24
ok !eval { $tb->$plan(tests => 0) };
is($@, "You said to run 0 tests at $0 line 24.\n");
{
my $warning = '';
local $SIG{__WARN__} = sub { $warning .= join '', @_ };
#line 31
ok $tb->$plan(no_plan => 1);
is( $warning, "no_plan takes no arguments at $0 line 31.\n" );
is $tb->has_plan, 'no_plan';
}
PK 1��\�Ԏ%7 7 t/Legacy/no_tests.tnu �[��� #!perl -w
# HARNESS-NO-STREAM
# HARNESS-NO-PRELOAD
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
# This has to be a require or else the END block below runs before
# Test::Builder's own and the ending diagnostics don't come out right.
require Test::Builder;
my $TB = Test::Builder->create;
$TB->plan(tests => 3);
package main;
require Test::Simple;
chdir 't';
push @INC, '../t/lib/';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
local $ENV{HARNESS_ACTIVE} = 0;
Test::Simple->import(tests => 1);
END {
$TB->is_eq($out->read, <<OUT);
1..1
OUT
$TB->is_eq($err->read, <<ERR);
# No tests run!
ERR
$TB->is_eq($?, 255, "exit code");
$? = grep { !$_ } $TB->summary;
}
PK 1��\�z�Y� � t/Legacy/note.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use warnings;
use Test::Builder::NoOutput;
use Test::More tests => 2;
{
my $tb = Test::Builder::NoOutput->create;
$tb->note("foo");
$tb->reset_outputs;
is $tb->read('out'), "# foo\n";
is $tb->read('err'), '';
}
PK 1��\��� � � t/Legacy/overload.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use Test::More tests => 19;
package Overloaded;
use overload
q{eq} => sub { $_[0]->{string} eq $_[1] },
q{==} => sub { $_[0]->{num} == $_[1] },
q{""} => sub { $_[0]->{stringify}++; $_[0]->{string} },
q{0+} => sub { $_[0]->{numify}++; $_[0]->{num} }
;
sub new {
my $class = shift;
bless {
string => shift,
num => shift,
stringify => 0,
numify => 0,
}, $class;
}
package main;
local $SIG{__DIE__} = sub {
my($call_file, $call_line) = (caller)[1,2];
fail("SIGDIE accidentally called");
diag("From $call_file at $call_line");
};
my $obj = Overloaded->new('foo', 42);
isa_ok $obj, 'Overloaded';
cmp_ok $obj, 'eq', 'foo', 'cmp_ok() eq';
is $obj->{stringify}, 0, ' does not stringify';
is $obj, 'foo', 'is() with string overloading';
cmp_ok $obj, '==', 42, 'cmp_ok() with number overloading';
is $obj->{numify}, 0, ' does not numify';
is_deeply [$obj], ['foo'], 'is_deeply with string overloading';
ok eq_array([$obj], ['foo']), 'eq_array ...';
ok eq_hash({foo => $obj}, {foo => 'foo'}), 'eq_hash ...';
# rt.cpan.org 13506
is_deeply $obj, 'foo', 'is_deeply with string overloading at the top';
Test::More->builder->is_num($obj, 42);
Test::More->builder->is_eq ($obj, "foo");
{
# rt.cpan.org 14675
package TestPackage;
use overload q{""} => sub { ::fail("This should not be called") };
package Foo;
::is_deeply(['TestPackage'], ['TestPackage']);
::is_deeply({'TestPackage' => 'TestPackage'},
{'TestPackage' => 'TestPackage'});
::is_deeply('TestPackage', 'TestPackage');
}
# Make sure 0 isn't a special case. [rt.cpan.org 41109]
{
my $obj = Overloaded->new('0', 42);
isa_ok $obj, 'Overloaded';
cmp_ok $obj, 'eq', '0', 'cmp_ok() eq';
is $obj->{stringify}, 0, ' does not stringify';
is $obj, '0', 'is() with string overloading';
}
PK 1��\\S��� � t/Legacy/overload_threads.tnu �[��� #!perl -w
use Test2::Util qw/CAN_THREAD/;
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
chdir 't';
BEGIN {
# There was a bug with overloaded objects and threads.
# See rt.cpan.org 4218
eval { require threads; 'threads'->import; 1; } if CAN_THREAD;
}
use Test::More;
plan skip_all => "known to crash on $]" if $] le "5.006002";
plan tests => 5;
package Overloaded;
use overload
q{""} => sub { $_[0]->{string} };
sub new {
my $class = shift;
bless { string => shift }, $class;
}
package main;
my $warnings = '';
local $SIG{__WARN__} = sub { $warnings = join '', @_ };
# overloaded object as name
my $obj = Overloaded->new('foo');
ok( 1, $obj );
# overloaded object which returns undef as name
my $undef = Overloaded->new(undef);
pass( $undef );
is( $warnings, '' );
TODO: {
my $obj = Overloaded->new('not really todo, testing overloaded reason');
local $TODO = $obj;
fail("Just checking todo as an overloaded value");
}
SKIP: {
my $obj = Overloaded->new('not really skipped, testing overloaded reason');
skip $obj, 1;
}
PK 1��\tk��� � t/Legacy/plan.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::More;
plan tests => 4;
eval { plan tests => 4 };
is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ - 1),
'disallow double plan' );
eval { plan 'no_plan' };
is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ -1),
'disallow changing plan' );
pass('Just testing plan()');
pass('Testing it some more');
PK 1��\�� f0 0 t/Legacy/plan_bad.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::More tests => 12;
use Test::Builder;
my $tb = Test::Builder->create;
$tb->level(0);
ok !eval { $tb->plan( tests => 'no_plan' ); };
is $@, sprintf "Number of tests must be a positive integer. You gave it 'no_plan' at %s line %d.\n", $0, __LINE__ - 1;
my $foo = [];
my @foo = ($foo, 2, 3);
ok !eval { $tb->plan( tests => @foo ) };
is $@, sprintf "Number of tests must be a positive integer. You gave it '$foo' at %s line %d.\n", $0, __LINE__ - 1;
ok !eval { $tb->plan( tests => 9.99 ) };
is $@, sprintf "Number of tests must be a positive integer. You gave it '9.99' at %s line %d.\n", $0, __LINE__ - 1;
#line 25
ok !eval { $tb->plan( tests => -1 ) };
is $@, "Number of tests must be a positive integer. You gave it '-1' at $0 line 25.\n";
#line 29
ok !eval { $tb->plan( tests => '' ) };
is $@, "You said to run 0 tests at $0 line 29.\n";
#line 33
ok !eval { $tb->plan( 'wibble' ) };
is $@, "plan() doesn't understand wibble at $0 line 33.\n";
PK 1��\�by� � t/Legacy/plan_is_noplan.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use Test::More tests => 1;
use Test::Builder::NoOutput;
{
my $tb = Test::Builder::NoOutput->create;
$tb->plan('no_plan');
$tb->ok(1, 'foo');
$tb->_ending;
is($tb->read, <<OUT);
ok 1 - foo
1..1
OUT
}
PK 1��\fq�� t/Legacy/plan_no_plan.tnu �[��� BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::More;
BEGIN {
if( !$ENV{HARNESS_ACTIVE} && $ENV{PERL_CORE} ) {
plan skip_all => "Won't work with t/TEST";
}
}
plan 'no_plan';
pass('Just testing');
ok(1, 'Testing again');
{
my $warning = '';
local $SIG{__WARN__} = sub { $warning = join "", @_ };
SKIP: {
skip 'Just testing skip with no_plan';
fail("So very failed");
}
is( $warning, '', 'skip with no "how_many" ok with no_plan' );
$warning = '';
TODO: {
todo_skip "Just testing todo_skip";
fail("Just testing todo");
die "todo_skip should prevent this";
pass("Again");
}
is( $warning, '', 'skip with no "how_many" ok with no_plan' );
}
PK 1��\< `�& & t/Legacy/plan_shouldnt_import.tnu �[��� #!/usr/bin/perl -w
# plan() used to export functions by mistake [rt.cpan.org 8385]
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::More ();
Test::More::plan(tests => 1);
Test::More::ok( !__PACKAGE__->can('ok'), 'plan should not export' );
PK 1��\��5� � t/Legacy/plan_skip_all.tnu �[��� BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::More;
plan skip_all => 'Just testing plan & skip_all';
fail('We should never get here');
PK 1��\ 㮊 t/Legacy/require_ok.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use Test::More tests => 8;
# Symbol and Class::Struct are both non-XS core modules back to 5.004.
# So they'll always be there.
require_ok("Symbol");
ok( $INC{'Symbol.pm'}, "require_ok MODULE" );
require_ok("Class/Struct.pm");
ok( $INC{'Class/Struct.pm'}, "require_ok FILE" );
# Its more trouble than its worth to try to create these filepaths to test
# through require_ok() so we cheat and use the internal logic.
ok !Test::More::_is_module_name('foo:bar');
ok !Test::More::_is_module_name('foo/bar.thing');
ok !Test::More::_is_module_name('Foo::Bar::');
ok Test::More::_is_module_name('V');
PK 1��\ 3i� � t/Legacy/run_test.tnu �[��� use strict;
use Test::Tester;
use Data::Dumper qw(Dumper);
my $test = Test::Builder->new;
$test->plan(tests => 54);
my $cap;
{
$cap = Test::Tester->capture;
my ($prem, @results) = run_tests(
sub {$cap->ok(1, "run pass")}
);
local $Test::Builder::Level = 0;
$test->is_eq($prem, "", "run pass no prem");
$test->is_num(scalar (@results), 1, "run pass result count");
my $res = $results[0];
$test->is_eq($res->{name}, "run pass", "run pass name");
$test->is_eq($res->{ok}, 1, "run pass ok");
$test->is_eq($res->{actual_ok}, 1, "run pass actual_ok");
$test->is_eq($res->{reason}, "", "run pass reason");
$test->is_eq($res->{type}, "", "run pass type");
$test->is_eq($res->{diag}, "", "run pass diag");
$test->is_num($res->{depth}, 0, "run pass depth");
}
{
my ($prem, @results) = run_tests(
sub {$cap->ok(0, "run fail")}
);
local $Test::Builder::Level = 0;
$test->is_eq($prem, "", "run fail no prem");
$test->is_num(scalar (@results), 1, "run fail result count");
my $res = $results[0];
$test->is_eq($res->{name}, "run fail", "run fail name");
$test->is_eq($res->{actual_ok}, 0, "run fail actual_ok");
$test->is_eq($res->{ok}, 0, "run fail ok");
$test->is_eq($res->{reason}, "", "run fail reason");
$test->is_eq($res->{type}, "", "run fail type");
$test->is_eq($res->{diag}, "", "run fail diag");
$test->is_num($res->{depth}, 0, "run fail depth");
}
{
my ($prem, @results) = run_tests(
sub {$cap->skip("just because")}
);
local $Test::Builder::Level = 0;
$test->is_eq($prem, "", "skip no prem");
$test->is_num(scalar (@results), 1, "skip result count");
my $res = $results[0];
$test->is_eq($res->{name}, "", "skip name");
$test->is_eq($res->{actual_ok}, 1, "skip actual_ok");
$test->is_eq($res->{ok}, 1, "skip ok");
$test->is_eq($res->{reason}, "just because", "skip reason");
$test->is_eq($res->{type}, "skip", "skip type");
$test->is_eq($res->{diag}, "", "skip diag");
$test->is_num($res->{depth}, 0, "skip depth");
}
{
my ($prem, @results) = run_tests(
sub {$cap->todo_skip("just because")}
);
local $Test::Builder::Level = 0;
$test->is_eq($prem, "", "todo_skip no prem");
$test->is_num(scalar (@results), 1, "todo_skip result count");
my $res = $results[0];
$test->is_eq($res->{name}, "", "todo_skip name");
$test->is_eq($res->{actual_ok}, 0, "todo_skip actual_ok");
$test->is_eq($res->{ok}, 1, "todo_skip ok");
$test->is_eq($res->{reason}, "just because", "todo_skip reason");
$test->is_eq($res->{type}, "todo_skip", "todo_skip type");
$test->is_eq($res->{diag}, "", "todo_skip diag");
$test->is_num($res->{depth}, 0, "todo_skip depth");
}
{
my ($prem, @results) = run_tests(
sub {$cap->diag("run diag")}
);
local $Test::Builder::Level = 0;
$test->is_eq($prem, "run diag\n", "run diag prem");
$test->is_num(scalar (@results), 0, "run diag result count");
}
{
my ($prem, @results) = run_tests(
sub {
$cap->ok(1, "multi pass");
$cap->diag("multi pass diag1");
$cap->diag("multi pass diag2");
$cap->ok(0, "multi fail");
$cap->diag("multi fail diag");
}
);
local $Test::Builder::Level = 0;
$test->is_eq($prem, "", "run multi no prem");
$test->is_num(scalar (@results), 2, "run multi result count");
my $res_pass = $results[0];
$test->is_eq($res_pass->{name}, "multi pass", "run multi pass name");
$test->is_eq($res_pass->{actual_ok}, 1, "run multi pass actual_ok");
$test->is_eq($res_pass->{ok}, 1, "run multi pass ok");
$test->is_eq($res_pass->{reason}, "", "run multi pass reason");
$test->is_eq($res_pass->{type}, "", "run multi pass type");
$test->is_eq($res_pass->{diag}, "multi pass diag1\nmulti pass diag2\n",
"run multi pass diag");
$test->is_num($res_pass->{depth}, 0, "run multi pass depth");
my $res_fail = $results[1];
$test->is_eq($res_fail->{name}, "multi fail", "run multi fail name");
$test->is_eq($res_pass->{actual_ok}, 1, "run multi fail actual_ok");
$test->is_eq($res_fail->{ok}, 0, "run multi fail ok");
$test->is_eq($res_pass->{reason}, "", "run multi fail reason");
$test->is_eq($res_pass->{type}, "", "run multi fail type");
$test->is_eq($res_fail->{diag}, "multi fail diag\n", "run multi fail diag");
$test->is_num($res_pass->{depth}, 0, "run multi fail depth");
}
PK 1��\��/�� � t/Legacy/simple.tnu �[��� BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use strict;
BEGIN { $| = 1; $^W = 1; }
use Test::Simple tests => 3;
ok(1, 'compile');
ok(1);
ok(1, 'foo');
PK 1��\��<o� � t/Legacy/skip.tnu �[��� #!perl -w
# HARNESS-NO-PRELOAD
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::More tests => 17;
# If we skip with the same name, Test::Harness will report it back and
# we won't get lots of false bug reports.
my $Why = "Just testing the skip interface.";
SKIP: {
skip $Why, 2
unless Pigs->can('fly');
my $pig = Pigs->new;
$pig->takeoff;
ok( $pig->altitude > 0, 'Pig is airborne' );
ok( $pig->airspeed > 0, ' and moving' );
}
SKIP: {
skip "We're not skipping", 2 if 0;
pass("Inside skip block");
pass("Another inside");
}
SKIP: {
skip "Again, not skipping", 2 if 0;
my($pack, $file, $line) = caller;
is( $pack || '', '', 'calling package not interfered with' );
is( $file || '', '', ' or file' );
is( $line || '', '', ' or line' );
}
SKIP: {
skip $Why, 2 if 1;
die "A horrible death";
fail("Deliberate failure");
fail("And again");
}
{
my $warning;
local $SIG{__WARN__} = sub { $warning = join "", @_ };
SKIP: {
# perl gets the line number a little wrong on the first
# statement inside a block.
1 == 1;
#line 56
skip $Why;
fail("So very failed");
}
is( $warning, "skip() needs to know \$how_many tests are in the ".
"block at $0 line 56\n",
'skip without $how_many warning' );
}
SKIP: {
skip "Not skipping here.", 4 if 0;
pass("This is supposed to run");
# Testing out nested skips.
SKIP: {
skip $Why, 2;
fail("AHHH!");
fail("You're a failure");
}
pass("This is supposed to run, too");
}
{
my $warning = '';
local $SIG{__WARN__} = sub { $warning .= join "", @_ };
SKIP: {
skip 1, "This is backwards" if 1;
pass "This does not run";
}
like $warning, qr/^skip\(\) was passed a non-numeric number of tests/;
}
PK 1��\wF��� � t/Legacy/skipall.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use Test::More;
my $Test = Test::Builder->create;
$Test->plan(tests => 2);
my $out = '';
my $err = '';
{
my $tb = Test::More->builder;
$tb->output(\$out);
$tb->failure_output(\$err);
plan 'skip_all';
}
END {
$Test->is_eq($out, "1..0 # SKIP\n");
$Test->is_eq($err, "");
}
PK 1��\�� G� � t/Legacy/strays.tnu �[��� #!/usr/bin/perl -w
# Check that stray newlines in test output are properly handed.
BEGIN {
print "1..0 # Skip not completed\n";
exit 0;
}
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
chdir 't';
use Test::Builder::NoOutput;
my $tb = Test::Builder::NoOutput->create;
$tb->ok(1, "name\n");
$tb->ok(0, "foo\nbar\nbaz");
$tb->skip("\nmoofer");
$tb->todo_skip("foo\n\n");
PK 1��\��4� � % t/Legacy/tbm_doesnt_set_exported_to.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use strict;
use warnings;
# Can't use Test::More, that would set exported_to()
use Test::Builder;
use Test::Builder::Module;
my $TB = Test::Builder->create;
$TB->plan( tests => 1 );
$TB->level(0);
$TB->is_eq( Test::Builder::Module->builder->exported_to,
undef,
'using Test::Builder::Module does not set exported_to()'
);
PK 1��\�lqz z t/Legacy/thread_taint.tnu �[��� #!/usr/bin/perl -w
use Test::More tests => 1;
ok( !$INC{'threads.pm'}, 'Loading Test::More does not load threads.pm' );
PK 1��\oy�
h h t/Legacy/threads.tnu �[��� #!/usr/bin/perl -w
use strict;
use warnings;
use Test2::Util qw/CAN_THREAD/;
BEGIN {
unless(CAN_THREAD) {
require Test::More;
Test::More->import(skip_all => "threads are not supported");
}
}
use threads;
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use strict;
use Test::Builder;
my $Test = Test::Builder->new;
$Test->exported_to('main');
$Test->plan(tests => 6);
for(1..5) {
'threads'->create(sub {
$Test->ok(1,"Each of these should app the test number")
})->join;
}
$Test->is_num($Test->current_test(), 5,"Should be five");
PK 1��\�q6�
t/Legacy/todo.tnu �[��� #!perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::More;
plan tests => 36;
$Why = 'Just testing the todo interface.';
my $is_todo;
TODO: {
local $TODO = $Why;
fail("Expected failure");
fail("Another expected failure");
$is_todo = Test::More->builder->todo;
}
pass("This is not todo");
ok( $is_todo, 'TB->todo' );
TODO: {
local $TODO = $Why;
fail("Yet another failure");
}
pass("This is still not todo");
TODO: {
local $TODO = "testing that error messages don't leak out of todo";
ok( 'this' eq 'that', 'ok' );
like( 'this', qr/that/, 'like' );
is( 'this', 'that', 'is' );
isnt( 'this', 'this', 'isnt' );
can_ok('Fooble', 'yarble');
isa_ok('Fooble', 'yarble');
use_ok('Fooble');
require_ok('Fooble');
}
TODO: {
todo_skip "Just testing todo_skip", 2;
fail("Just testing todo");
die "todo_skip should prevent this";
pass("Again");
}
{
my $warning;
local $SIG{__WARN__} = sub { $warning = join "", @_ };
TODO: {
# perl gets the line number a little wrong on the first
# statement inside a block.
1 == 1;
#line 74
todo_skip "Just testing todo_skip";
fail("So very failed");
}
is( $warning, "todo_skip() needs to know \$how_many tests are in the ".
"block at $0 line 74\n",
'todo_skip without $how_many warning' );
}
my $builder = Test::More->builder;
my $exported_to = $builder->exported_to;
TODO: {
$builder->exported_to("Wibble");
local $TODO = "testing \$TODO with an incorrect exported_to()";
fail("Just testing todo");
}
$builder->exported_to($exported_to);
$builder->todo_start('Expected failures');
fail('Testing todo_start()');
ok 0, 'Testing todo_start() with more than one failure';
$is_todo = $builder->todo;
$builder->todo_end;
is $is_todo, 'Expected failures',
'todo_start should have the correct TODO message';
ok 1, 'todo_end() should not leak TODO behavior';
my @nested_todo;
my ( $level1, $level2 ) = ( 'failure level 1', 'failure_level 2' );
TODO: {
local $TODO = 'Nesting TODO';
fail('fail 1');
$builder->todo_start($level1);
fail('fail 2');
push @nested_todo => $builder->todo;
$builder->todo_start($level2);
fail('fail 3');
push @nested_todo => $builder->todo;
$builder->todo_end;
fail('fail 4');
push @nested_todo => $builder->todo;
$builder->todo_end;
$is_todo = $builder->todo;
fail('fail 4');
}
is_deeply \@nested_todo, [ $level1, $level2, $level1 ],
'Nested TODO message should be correct';
is $is_todo, 'Nesting TODO',
'... and original TODO message should be correct';
{
$builder->todo_start;
fail("testing todo_start() with no message");
my $reason = $builder->todo;
my $in_todo = $builder->in_todo;
$builder->todo_end;
is $reason, '', " todo() reports no reason";
ok $in_todo, " but we're in_todo()";
}
eval {
$builder->todo_end;
};
is $@, sprintf "todo_end() called without todo_start() at %s line %d.\n", $0, __LINE__ - 3;
{
my($reason, $in_todo);
TODO: {
local $TODO = '';
$reason = $builder->todo;
$in_todo = $builder->in_todo;
}
is $reason, '';
ok !$in_todo, '$TODO = "" is not considered TODO';
}
PK 1��\�R��� � t/Legacy/undef.tnu �[��� #!/usr/bin/perl -w
# HARNESS-NO-FORK
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use Test::More tests => 21;
BEGIN { $^W = 1; }
my $warnings = '';
local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
my $TB = Test::Builder->new;
sub no_warnings {
$TB->is_eq($warnings, '', ' no warnings');
$warnings = '';
}
sub warnings_is {
$TB->is_eq($warnings, $_[0]);
$warnings = '';
}
sub warnings_like {
$TB->like($warnings, $_[0]);
$warnings = '';
}
my $Filename = quotemeta $0;
is( undef, undef, 'undef is undef');
no_warnings;
isnt( undef, 'foo', 'undef isnt foo');
no_warnings;
isnt( undef, '', 'undef isnt an empty string' );
isnt( undef, 0, 'undef isnt zero' );
Test::More->builder->is_num(undef, undef, 'is_num()');
Test::More->builder->isnt_num(23, undef, 'isnt_num()');
#line 45
like( undef, qr/.*/, 'undef is like anything' );
no_warnings;
eq_array( [undef, undef], [undef, 23] );
no_warnings;
eq_hash ( { foo => undef, bar => undef },
{ foo => undef, bar => 23 } );
no_warnings;
eq_set ( [undef, undef, 12], [29, undef, undef] );
no_warnings;
eq_hash ( { foo => undef, bar => { baz => undef, moo => 23 } },
{ foo => undef, bar => { baz => undef, moo => 23 } } );
no_warnings;
#line 74
cmp_ok( undef, '<=', 2, ' undef <= 2' );
warnings_like(qr/Use of uninitialized value.* at \(eval in cmp_ok\) $Filename line 74\.\n/);
my $tb = Test::More->builder;
SKIP: {
skip("Test cannot be run with this formatter", 2)
unless $tb->{Stack}->top->format->isa('Test::Builder::Formatter');
my $err = '';
$tb->failure_output(\$err);
diag(undef);
$tb->reset_outputs;
is( $err, "# undef\n" );
no_warnings;
}
$tb->maybe_regex(undef);
no_warnings;
# test-more.googlecode.com #42
{
is_deeply([ undef ], [ undef ]);
no_warnings;
}
PK 1��\���`) ) t/Legacy/use_ok.tnu �[��� #!/usr/bin/perl -w
use strict;
use warnings;
use lib 't/lib';
use Test::More;
note "Basic use_ok"; {
package Foo::one;
::use_ok("Symbol");
::ok( defined &gensym, 'use_ok() no args exports defaults' );
}
note "With one arg"; {
package Foo::two;
::use_ok("Symbol", qw(qualify));
::ok( !defined &gensym, ' one arg, defaults overridden' );
::ok( defined &qualify, ' right function exported' );
}
note "Multiple args"; {
package Foo::three;
::use_ok("Symbol", qw(gensym ungensym));
::ok( defined &gensym && defined &ungensym, ' multiple args' );
}
note "Defining constants"; {
package Foo::four;
my $warn; local $SIG{__WARN__} = sub { $warn .= shift; };
::use_ok("constant", qw(foo bar));
::ok( defined &foo, 'constant' );
::is( $warn, undef, 'no warning');
}
note "use Module VERSION"; {
package Foo::five;
::use_ok("Symbol", 1.02);
}
note "use Module VERSION does not call import"; {
package Foo::six;
::use_ok("NoExporter", 1.02);
}
{
package Foo::seven;
local $SIG{__WARN__} = sub {
# Old perls will warn on X.YY_ZZ style versions. Not our problem
warn @_ unless $_[0] =~ /^Argument "\d+\.\d+_\d+" isn't numeric/;
};
::use_ok("Test::More", 0.47);
}
note "Signals are preserved"; {
package Foo::eight;
local $SIG{__DIE__};
::use_ok("SigDie");
::ok(defined $SIG{__DIE__}, ' SIG{__DIE__} preserved');
}
note "Line numbers preserved"; {
my $package = "that_cares_about_line_numbers";
# Store the output of caller.
my @caller;
{
package that_cares_about_line_numbers;
sub import {
@caller = caller;
return;
}
$INC{"$package.pm"} = 1; # fool use into thinking it's already loaded
}
::use_ok($package);
my $line = __LINE__-1;
::is( $caller[0], __PACKAGE__, "caller package preserved" );
::is( $caller[1], __FILE__, " file" );
::is( $caller[2], $line, " line" );
}
note "not confused by functions vs class names"; {
$INC{"ok.pm"} = 1;
use_ok("ok"); # ok is a function inside Test::More
$INC{"Foo/bar.pm"} = 1;
sub Foo::bar { 42 }
use_ok("Foo::bar"); # Confusing a class name with a function name
}
done_testing;
PK 1��\�ph,m m t/Legacy/useing.tnu �[��� BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::More tests => 5;
require_ok('Test::Builder');
require_ok("Test::More");
require_ok("Test::Simple");
{
package Foo;
use Test::More import => [qw(ok is can_ok)];
can_ok('Foo', qw(ok is can_ok));
ok( !Foo->can('like'), 'import working properly' );
}
PK 1��\�Tn�� � t/Legacy/utf8.tnu �[��� #!/usr/bin/perl -w
# HARNESS-NO-STREAM
# HARNESS-NO-PRELOAD
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use strict;
use warnings;
my $have_perlio;
BEGIN {
# All together so Test::More sees the open discipline
$have_perlio = eval q[
require PerlIO;
PerlIO->VERSION(1.02); # required for PerlIO::get_layers
binmode *STDOUT, ":encoding(utf8)";
binmode *STDERR, ":encoding(utf8)";
require Test::More;
1;
];
}
use Test::More;
unless (Test::Builder->new->{Stack}->top->format->isa('Test::Builder::Formatter')) {
plan skip_all => 'Test cannot be run using this formatter';
}
if( !$have_perlio ) {
plan skip_all => "Don't have PerlIO 1.02";
}
else {
plan tests => 5;
}
SKIP: {
skip( "Need PerlIO for this feature", 3 )
unless $have_perlio;
my %handles = (
output => \*STDOUT,
failure_output => \*STDERR,
todo_output => \*STDOUT
);
for my $method (keys %handles) {
my $src = $handles{$method};
my $dest = Test::More->builder->$method;
is_deeply { map { $_ => 1 } PerlIO::get_layers($dest) },
{ map { $_ => 1 } PerlIO::get_layers($src) },
"layers copied to $method";
}
}
# Test utf8 is ok.
{
my $uni = "\x{11e}";
my @warnings;
local $SIG{__WARN__} = sub {
push @warnings, @_;
};
is( $uni, $uni, "Testing $uni" );
is_deeply( \@warnings, [] );
}
PK 1��\� � t/Legacy/versions.tnu �[��� #!/usr/bin/perl -w
# HARNESS-NO-PRELOAD
# Make sure all the modules have the same version
#
# TBT has its own version system.
use strict;
use Test::More;
require Test::Builder;
require Test::Builder::Module;
require Test::Simple;
my $dist_version = Test::More->VERSION;
like( $dist_version, qr/^ \d+ \. \d+ $/x );
my @modules = qw(
Test::Simple
Test::Builder
Test::Builder::Module
);
for my $module (@modules) {
is( $dist_version, $module->VERSION, $module );
}
done_testing(4);
PK 1��\��;�l l t/Legacy/subtest/args.tnu �[��� #!/usr/bin/perl -w
use strict;
use Test::Builder;
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ( '../lib', 'lib' );
}
else {
unshift @INC, 't/lib';
}
}
use Test::Builder::NoOutput;
my $tb = Test::Builder->new;
$tb->ok( !eval { $tb->subtest() } );
$tb->like( $@, qr/^\Qsubtest()'s second argument must be a code ref/ );
$tb->ok( !eval { $tb->subtest("foo") } );
$tb->like( $@, qr/^\Qsubtest()'s second argument must be a code ref/ );
my $foo;
$tb->subtest('Arg passing', sub {
$foo = shift;
$tb->ok(1);
}, 'foo');
$tb->is_eq($foo, 'foo');
$tb->done_testing();
PK 1��\~) * t/Legacy/subtest/bail_out.tnu �[��� #!/usr/bin/perl -w
# HARNESS-NO-STREAM
# HARNESS-NO-PRELOAD
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
my $goto = 0;
my $Exit_Code;
BEGIN {
*CORE::GLOBAL::exit = sub { $Exit_Code = shift; goto XXX if $goto; CORE::exit($Exit_Code)};
}
use Test::Builder;
use Test::More;
my $skip = ref(Test::Builder->new->{Stack}->top->format) ne 'Test::Builder::Formatter';
plan skip_all => "This test cannot be run with the current formatter"
if $skip;
$goto = 1;
my $output;
my $TB = Test::More->builder;
$TB->output(\$output);
my $Test = Test::Builder->create;
$Test->level(0);
$Test->plan(tests => 2);
plan tests => 4;
ok 'foo';
subtest 'bar' => sub {
plan tests => 3;
ok 'sub_foo';
subtest 'sub_bar' => sub {
plan tests => 3;
ok 'sub_sub_foo';
ok 'sub_sub_bar';
BAIL_OUT("ROCKS FALL! EVERYONE DIES!");
ok 'sub_sub_baz';
};
ok 'sub_baz';
};
XXX:
$Test->is_eq( $output, <<'OUT' );
1..4
ok 1
# Subtest: bar
1..3
ok 1
# Subtest: sub_bar
1..3
ok 1
ok 2
Bail out! ROCKS FALL! EVERYONE DIES!
OUT
$Test->is_eq( $Exit_Code, 255 );
Test2::API::test2_stack()->top->set_no_ending(1);
PK 1��\^�=� � t/Legacy/subtest/basic.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ( '../lib', 'lib' );
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use warnings;
use Test::Builder::NoOutput;
use Test::More tests => 12;
# TB Methods expect to be wrapped.
my $ok = sub { shift->ok(@_) };
my $plan = sub { shift->plan(@_) };
my $diag = sub { shift->diag(@_) };
my $finalize = sub { shift->finalize(@_) };
# Formatting may change if we're running under Test::Harness.
$ENV{HARNESS_ACTIVE} = 0;
{
my $tb = Test::Builder::NoOutput->create;
$tb->$plan( tests => 7 );
for( 1 .. 3 ) {
$tb->$ok( $_, "We're on $_" );
$tb->$diag("We ran $_");
}
{
my $indented = $tb->child;
$indented->$plan('no_plan');
$indented->$ok( 1, "We're on 1" );
$indented->$ok( 1, "We're on 2" );
$indented->$ok( 1, "We're on 3" );
$indented->$finalize;
}
for( 7, 8, 9 ) {
$tb->$ok( $_, "We're on $_" );
}
is $tb->read, <<"END", 'Output should nest properly';
1..7
ok 1 - We're on 1
# We ran 1
ok 2 - We're on 2
# We ran 2
ok 3 - We're on 3
# We ran 3
ok 1 - We're on 1
ok 2 - We're on 2
ok 3 - We're on 3
1..3
ok 4 - Child of $0
ok 5 - We're on 7
ok 6 - We're on 8
ok 7 - We're on 9
END
}
{
my $tb = Test::Builder::NoOutput->create;
$tb->$plan('no_plan');
for( 1 .. 1 ) {
$tb->$ok( $_, "We're on $_" );
$tb->$diag("We ran $_");
}
{
my $indented = $tb->child;
$indented->$plan('no_plan');
$indented->$ok( 1, "We're on 1" );
{
my $indented2 = $indented->child('with name');
$indented2->$plan( tests => 2 );
$indented2->$ok( 1, "We're on 2.1" );
$indented2->$ok( 1, "We're on 2.1" );
$indented2->$finalize;
}
$indented->$ok( 1, 'after child' );
$indented->$finalize;
}
for(7) {
$tb->$ok( $_, "We're on $_" );
}
$tb->_ending;
is $tb->read, <<"END", 'We should allow arbitrary nesting';
ok 1 - We're on 1
# We ran 1
ok 1 - We're on 1
1..2
ok 1 - We're on 2.1
ok 2 - We're on 2.1
ok 2 - with name
ok 3 - after child
1..3
ok 2 - Child of $0
ok 3 - We're on 7
1..3
END
}
{
#line 108
my $tb = Test::Builder::NoOutput->create;
{
my $child = $tb->child('expected to fail');
$child->$plan( tests => 3 );
$child->$ok(1);
$child->$ok(0);
$child->$ok(3);
$child->$finalize;
}
{
my $child = $tb->child('expected to pass');
$child->$plan( tests => 3 );
$child->$ok(1);
$child->$ok(2);
$child->$ok(3);
$child->$finalize;
}
is $tb->read, <<"END", 'Previous child failures should not force subsequent failures';
1..3
ok 1
not ok 2
# Failed test at $0 line 114.
ok 3
# Looks like you failed 1 test of 3.
not ok 1 - expected to fail
# Failed test 'expected to fail'
# at $0 line 116.
1..3
ok 1
ok 2
ok 3
ok 2 - expected to pass
END
}
{
my $tb = Test::Builder::NoOutput->create;
my $child = $tb->child('one');
is $child->{$_}, $tb->{$_}, "The child should copy the ($_) filehandle"
foreach qw{Out_FH Todo_FH Fail_FH};
$child->$finalize;
}
{
my $tb = Test::Builder::NoOutput->create;
my $child = $tb->child('one');
can_ok $child, 'parent';
can_ok $tb, 'name';
is $child->name, 'one', '... but child names should be whatever we set them to';
$child->$finalize;
$child = $tb->child;
$child->$finalize;
}
# Skip all subtests
{
my $tb = Test::Builder::NoOutput->create;
{
my $child = $tb->child('skippy says he loves you');
eval { $child->$plan( skip_all => 'cuz I said so' ) };
}
subtest 'skip all', sub {
plan skip_all => 'subtest with skip_all';
ok 0, 'This should never be run';
};
}
# to do tests
{
#line 204
my $tb = Test::Builder::NoOutput->create;
$tb->$plan( tests => 1 );
my $child = $tb->child;
$child->$plan( tests => 1 );
$child->todo_start( 'message' );
$child->$ok( 0 );
$child->todo_end;
$child->$finalize;
$tb->_ending;
is $tb->read, <<"END", 'TODO tests should not make the parent test fail';
1..1
1..1
not ok 1 # TODO message
# Failed (TODO) test at $0 line 209.
ok 1 - Child of $0
END
}
{
my $tb = Test::Builder::NoOutput->create;
$tb->$plan( tests => 1 );
my $child = $tb->child;
$child->$finalize;
$tb->_ending;
my $expected = <<"END";
1..1
not ok 1 - No tests run for subtest "Child of $0"
END
like $tb->read, qr/\Q$expected\E/,
'Not running subtests should make the parent test fail';
}
PK 1��\^Dc � � t/Legacy/subtest/callback.tnu �[��� #!/usr/bin/perl -w
# What happens when a subtest dies?
use lib 't/lib';
use strict;
use Test::More;
use Test::Builder;
use Test2::API;
my $Test = Test::Builder->new;
my $step = 0;
my @callback_calls = ();
Test2::API::test2_add_callback_pre_subtest(
sub {
$Test->is_num(
$step,
0,
'pre-subtest callbacks should be invoked before the subtest',
);
++$step;
push @callback_calls, [@_];
},
);
$Test->subtest(
(my $subtest_name='some subtest'),
(my $subtest_code=sub {
$Test->is_num(
$step,
1,
'subtest should be run after the pre-subtest callbacks',
);
++$step;
}),
(my @subtest_args = (1,2,3)),
);
is_deeply(
\@callback_calls,
[[$subtest_name,$subtest_code,@subtest_args]],
'pre-subtest callbacks should be invoked with the expected arguments',
);
$Test->is_num(
$step,
2,
'the subtest should be run',
);
$Test->done_testing();
PK 1��\!_� t/Legacy/subtest/die.tnu �[��� #!/usr/bin/perl -w
# What happens when a subtest dies?
use lib 't/lib';
use strict;
use Test::Builder;
use Test::Builder::NoOutput;
my $Test = Test::Builder->new;
{
my $tb = Test::Builder::NoOutput->create;
$tb->ok(1);
$Test->ok( !eval {
$tb->subtest("death" => sub {
die "Death in the subtest";
});
1;
});
$Test->like( $@, qr/^Death in the subtest at \Q$0\E line /);
$Test->ok( !$tb->parent, "the parent object is restored after a die" );
}
$Test->done_testing();
PK 1��\�� � t/Legacy/subtest/do.tnu �[��� #!/usr/bin/perl -w
# Test the idiom of running another test file as a subtest.
use strict;
use Test::More;
pass("First");
my $file = "./t/Legacy/subtest/for_do_t.test";
ok -e $file, "subtest test file exists";
subtest $file => sub { do $file };
pass("Last");
done_testing(4);
PK 1��\I|!x x t/Legacy/subtest/events.tnu �[��� use strict;
use warnings;
use Test::More;
use Test2::API qw/intercept/;
my $events = intercept {
subtest foo => sub {
ok(1, "pass");
};
};
my $st = $events->[-1];
isa_ok($st, 'Test2::Event::Subtest');
ok(my $id = $st->subtest_id, "got an id");
for my $se (@{$st->subevents}) {
is($se->trace->hid, $id, "set subtest_id on child event");
}
done_testing;
PK 1��\sv~$p p t/Legacy/subtest/for_do_t.testnu �[��� # Test used by t/subtest/do.t
use Test::More;
pass("First");
pass("Second");
pass("Third");
done_testing(3);
PK 1��\Y �U� � t/Legacy/subtest/fork.tnu �[��� #!/usr/bin/perl -w
use strict;
use warnings;
# HARNESS-NO-STREAM
# HARNESS-NO-PRELOAD
use Test2::Util qw/CAN_FORK/;
BEGIN {
unless(CAN_FORK) {
require Test::More;
Test::More->import(skip_all => "fork is not supported");
}
}
use IO::Pipe;
use Test::Builder;
use Test::More;
plan 'skip_all' => "This test cannot be run with the current formatter"
unless Test::Builder->new->{Stack}->top->format->isa('Test::Builder::Formatter');
plan 'tests' => 1;
subtest 'fork within subtest' => sub {
plan tests => 2;
my $pipe = IO::Pipe->new;
my $pid = fork;
defined $pid or plan skip_all => "Fork not working";
if ($pid) {
$pipe->reader;
my $child_output = do { local $/ ; <$pipe> };
waitpid $pid, 0;
is $?, 0, 'child exit status';
like $child_output, qr/^[\s#]+Child Done\s*\z/, 'child output';
}
else {
$pipe->writer;
# Force all T::B output into the pipe, for the parent
# builder as well as the current subtest builder.
my $tb = Test::Builder->new;
$tb->output($pipe);
$tb->failure_output($pipe);
$tb->todo_output($pipe);
diag 'Child Done';
exit 0;
}
};
PK 1��\\SF�� � t/Legacy/subtest/implicit_done.tnu �[��� #!/usr/bin/perl -w
# A subtest without a plan implicitly calls "done_testing"
use strict;
use Test::More;
pass "Before";
subtest 'basic' => sub {
pass "Inside sub test";
};
subtest 'with done' => sub {
pass 'This has done_testing';
done_testing;
};
subtest 'with plan' => sub {
plan tests => 1;
pass 'I have a plan, Batman!';
};
subtest 'skipping' => sub {
plan skip_all => 'Skipping';
fail 'Shouldnt see me!';
};
pass "After";
done_testing;
PK 1��\h v� t/Legacy/subtest/line_numbers.tnu �[��� #!/usr/bin/perl -w
# Test Test::More::subtest(), focusing on correct line numbers in
# failed test diagnostics.
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ( '../lib', 'lib' );
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use warnings;
use Test::More tests => 5;
use Test::Builder;
use Test::Builder::Tester;
# Formatting may change if we're running under Test::Harness.
$ENV{HARNESS_ACTIVE} = 0;
our %line;
{
test_out("# Subtest: namehere");
test_out(" 1..3");
test_out(" ok 1");
test_out(" not ok 2");
test_err(" # Failed test at $0 line $line{innerfail1}.");
test_out(" ok 3");
test_err(" # Looks like you failed 1 test of 3.");
test_out("not ok 1 - namehere");
test_err("# Failed test 'namehere'");
test_err("# at $0 line $line{outerfail1}.");
subtest namehere => sub {
plan tests => 3;
ok 1;
ok 0; BEGIN{ $line{innerfail1} = __LINE__ }
ok 1;
}; BEGIN{ $line{outerfail1} = __LINE__ }
test_test("un-named inner tests");
}
{
test_out("# Subtest: namehere");
test_out(" 1..3");
test_out(" ok 1 - first is good");
test_out(" not ok 2 - second is bad");
test_err(" # Failed test 'second is bad'");
test_err(" # at $0 line $line{innerfail2}.");
test_out(" ok 3 - third is good");
test_err(" # Looks like you failed 1 test of 3.");
test_out("not ok 1 - namehere");
test_err("# Failed test 'namehere'");
test_err("# at $0 line $line{outerfail2}.");
subtest namehere => sub {
plan tests => 3;
ok 1, "first is good";
ok 0, "second is bad"; BEGIN{ $line{innerfail2} = __LINE__ }
ok 1, "third is good";
}; BEGIN{ $line{outerfail2} = __LINE__ }
test_test("named inner tests");
}
sub run_the_subtest {
subtest namehere => sub {
plan tests => 3;
ok 1, "first is good";
ok 0, "second is bad"; BEGIN{ $line{innerfail3} = __LINE__ }
ok 1, "third is good";
}; BEGIN{ $line{outerfail3} = __LINE__ }
}
{
test_out("# Subtest: namehere");
test_out(" 1..3");
test_out(" ok 1 - first is good");
test_out(" not ok 2 - second is bad");
test_err(" # Failed test 'second is bad'");
test_err(" # at $0 line $line{innerfail3}.");
test_out(" ok 3 - third is good");
test_err(" # Looks like you failed 1 test of 3.");
test_out("not ok 1 - namehere");
test_err("# Failed test 'namehere'");
test_err("# at $0 line $line{outerfail3}.");
run_the_subtest();
test_test("subtest() called from a sub");
}
{
test_out( "# Subtest: namehere");
test_out( " 1..0");
test_err( " # No tests run!");
test_out( 'not ok 1 - No tests run for subtest "namehere"');
test_err(q{# Failed test 'No tests run for subtest "namehere"'});
test_err( "# at $0 line $line{outerfail4}.");
subtest namehere => sub {
done_testing;
}; BEGIN{ $line{outerfail4} = __LINE__ }
test_test("lineno in 'No tests run' diagnostic");
}
{
test_out("# Subtest: namehere");
test_out(" 1..1");
test_out(" not ok 1 - foo is bar");
test_err(" # Failed test 'foo is bar'");
test_err(" # at $0 line $line{is_fail}.");
test_err(" # got: 'foo'");
test_err(" # expected: 'bar'");
test_err(" # Looks like you failed 1 test of 1.");
test_out('not ok 1 - namehere');
test_err("# Failed test 'namehere'");
test_err("# at $0 line $line{is_outer_fail}.");
subtest namehere => sub {
plan tests => 1;
is 'foo', 'bar', 'foo is bar'; BEGIN{ $line{is_fail} = __LINE__ }
}; BEGIN{ $line{is_outer_fail} = __LINE__ }
test_test("diag indent for is() in subtest");
}
PK 1��\S�a a t/Legacy/subtest/plan.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ( '../lib', 'lib' );
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use warnings;
use Test::Builder::NoOutput;
use Test::More tests => 6;
# Formatting may change if we're running under Test::Harness.
$ENV{HARNESS_ACTIVE} = 0;
{
ok defined &subtest, 'subtest() should be exported to our namespace';
is prototype('subtest'), undef, '... has no prototype';
subtest 'subtest with plan', sub {
plan tests => 2;
ok 1, 'planned subtests should work';
ok 1, '... and support more than one test';
};
subtest 'subtest without plan', sub {
plan 'no_plan';
ok 1, 'no_plan subtests should work';
ok 1, '... and support more than one test';
ok 1, '... no matter how many tests are run';
};
subtest 'subtest with implicit done_testing()', sub {
ok 1, 'subtests with an implicit done testing should work';
ok 1, '... and support more than one test';
ok 1, '... no matter how many tests are run';
};
subtest 'subtest with explicit done_testing()', sub {
ok 1, 'subtests with an explicit done testing should work';
ok 1, '... and support more than one test';
ok 1, '... no matter how many tests are run';
done_testing();
};
}
PK 1��\���� � t/Legacy/subtest/predicate.tnu �[��� #!/usr/bin/perl -w
# Test the use of subtest() to define new test predicates that combine
# multiple existing predicates.
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ( '../lib', 'lib' );
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use warnings;
use Test::More tests => 5;
use Test::Builder;
use Test::Builder::Tester;
# Formatting may change if we're running under Test::Harness.
$ENV{HARNESS_ACTIVE} = 0;
our %line;
# Define a new test predicate with Test::More::subtest(), using
# Test::More predicates as building blocks...
sub foobar_ok ($;$) {
my ($value, $name) = @_;
$name ||= "foobar_ok";
local $Test::Builder::Level = $Test::Builder::Level + 1;
subtest $name => sub {
plan tests => 2;
ok $value =~ /foo/, "foo";
ok $value =~ /bar/, "bar"; BEGIN{ $line{foobar_ok_bar} = __LINE__ }
};
}
{
test_out("# Subtest: namehere");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
test_err(" # Failed test 'bar'");
test_err(" # at $0 line $line{foobar_ok_bar}.");
test_err(" # Looks like you failed 1 test of 2.");
test_out("not ok 1 - namehere");
test_err("# Failed test 'namehere'");
test_err("# at $0 line ".(__LINE__+2).".");
foobar_ok "foot", "namehere";
test_test("foobar_ok failing line numbers");
}
# Wrap foobar_ok() to make another new predicate...
sub foobar_ok_2 ($;$) {
my ($value, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
foobar_ok($value, $name);
}
{
test_out("# Subtest: namehere");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
test_err(" # Failed test 'bar'");
test_err(" # at $0 line $line{foobar_ok_bar}.");
test_err(" # Looks like you failed 1 test of 2.");
test_out("not ok 1 - namehere");
test_err("# Failed test 'namehere'");
test_err("# at $0 line ".(__LINE__+2).".");
foobar_ok_2 "foot", "namehere";
test_test("foobar_ok_2 failing line numbers");
}
# Define another new test predicate, this time using
# Test::Builder::subtest() rather than Test::More::subtest()...
sub barfoo_ok ($;$) {
my ($value, $name) = @_;
$name ||= "barfoo_ok";
Test::Builder->new->subtest($name => sub {
plan tests => 2;
ok $value =~ /foo/, "foo";
ok $value =~ /bar/, "bar"; BEGIN{ $line{barfoo_ok_bar} = __LINE__ }
});
}
{
test_out("# Subtest: namehere");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
test_err(" # Failed test 'bar'");
test_err(" # at $0 line $line{barfoo_ok_bar}.");
test_err(" # Looks like you failed 1 test of 2.");
test_out("not ok 1 - namehere");
test_err("# Failed test 'namehere'");
test_err("# at $0 line ".(__LINE__+2).".");
barfoo_ok "foot", "namehere";
test_test("barfoo_ok failing line numbers");
}
# Wrap barfoo_ok() to make another new predicate...
sub barfoo_ok_2 ($;$) {
my ($value, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level + 1;
barfoo_ok($value, $name);
}
{
test_out("# Subtest: namehere");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
test_err(" # Failed test 'bar'");
test_err(" # at $0 line $line{barfoo_ok_bar}.");
test_err(" # Looks like you failed 1 test of 2.");
test_out("not ok 1 - namehere");
test_err("# Failed test 'namehere'");
test_err("# at $0 line ".(__LINE__+2).".");
barfoo_ok_2 "foot", "namehere";
test_test("barfoo_ok_2 failing line numbers");
}
# A subtest-based predicate called from within a subtest
{
test_out("# Subtest: outergroup");
test_out(" 1..2");
test_out(" ok 1 - this passes");
test_out(" # Subtest: namehere");
test_out(" 1..2");
test_out(" ok 1 - foo");
test_out(" not ok 2 - bar");
test_err(" # Failed test 'bar'");
test_err(" # at $0 line $line{barfoo_ok_bar}.");
test_err(" # Looks like you failed 1 test of 2.");
test_out(" not ok 2 - namehere");
test_err(" # Failed test 'namehere'");
test_err(" # at $0 line $line{ipredcall}.");
test_err(" # Looks like you failed 1 test of 2.");
test_out("not ok 1 - outergroup");
test_err("# Failed test 'outergroup'");
test_err("# at $0 line $line{outercall}.");
subtest outergroup => sub {
plan tests => 2;
ok 1, "this passes";
barfoo_ok_2 "foot", "namehere"; BEGIN{ $line{ipredcall} = __LINE__ }
}; BEGIN{ $line{outercall} = __LINE__ }
test_test("outergroup with internal barfoo_ok_2 failing line numbers");
}
PK 1��\-��+� � t/Legacy/subtest/singleton.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ( '../lib', 'lib' );
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use warnings;
use Test::More tests => 3;
{
package Test::Singleton;
use Test::Builder;
my $TB = Test::Builder->new;
sub singleton_ok ($;$) {
my( $val, $name ) = @_;
$TB->ok( $val, $name );
}
}
ok 1, 'TB top level';
subtest 'doing a subtest' => sub {
plan tests => 4;
ok 1, 'first test in subtest';
Test::Singleton::singleton_ok(1, 'this should not fail');
ok 1, 'second test in subtest';
Test::Singleton::singleton_ok(1, 'this should not fail');
};
ok 1, 'left subtest';
PK 1��\�]� � � t/Legacy/subtest/threads.tnu �[��� #!/usr/bin/perl -w
use strict;
use warnings;
use Test2::Util qw/CAN_THREAD/;
BEGIN {
unless(CAN_THREAD) {
require Test::More;
Test::More->import(skip_all => "threads are not supported");
}
}
use threads;
use Test::More;
subtest 'simple test with threads on' => sub {
is( 1+1, 2, "simple test" );
is( "a", "a", "another simple test" );
};
pass("Parent retains sharedness");
done_testing(2);
PK 1��\ �d�V V t/Legacy/subtest/todo.tnu �[��� #!/usr/bin/perl -w
# Test todo subtests.
#
# A subtest in a todo context should have all of its diagnostic output
# redirected to the todo output destination, but individual tests
# within the subtest should not become todo tests themselves.
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ( '../lib', 'lib' );
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use warnings;
use Test::More;
use Test::Builder;
use Test::Builder::Tester;
# Formatting may change if we're running under Test::Harness.
$ENV{HARNESS_ACTIVE} = 0;
our %line;
# Repeat each test for various combinations of the todo reason,
# the mechanism by which it is set and $Level.
our @test_combos;
foreach my $level (1, 2, 3) {
push @test_combos, ['$TODO', 'Reason', $level],
['todo_start', 'Reason', $level],
['todo_start', '', $level],
['todo_start', 0, $level];
}
plan tests => 8 * @test_combos;
sub test_subtest_in_todo {
my ($name, $code, $want_out, $no_tests_run) = @_;
my $xxx = $no_tests_run ? 'No tests run for subtest "xxx"' : 'xxx';
chomp $want_out;
my @outlines = split /\n/, $want_out;
foreach my $combo (@test_combos) {
my ($set_via, $todo_reason, $level) = @$combo;
test_out( map { my $x = $_; $x =~ s/\s+$//g; $x }
"# Subtest: xxx",
@outlines,
"not ok 1 - $xxx # TODO $todo_reason",
"# Failed (TODO) test '$xxx'",
"# at $0 line $line{xxx}.",
"not ok 2 - regular todo test # TODO $todo_reason",
"# Failed (TODO) test 'regular todo test'",
"# at $0 line $line{reg}.",
);
{
local $TODO = $set_via eq '$TODO' ? $todo_reason : undef;
if ($set_via eq 'todo_start') {
Test::Builder->new->todo_start($todo_reason);
}
subtest_at_level(
'xxx', $code, $level); BEGIN{ $line{xxx} = __LINE__ }
ok 0, 'regular todo test'; BEGIN{ $line{reg} = __LINE__ }
if ($set_via eq 'todo_start') {
Test::Builder->new->todo_end;
}
}
test_test("$name ($level), todo [$todo_reason] set via $set_via");
}
}
package Foo; # If several stack frames are in package 'main' then $Level
# could be wrong and $main::TODO might still be found. Using
# another package makes the tests more sensitive.
sub main::subtest_at_level {
my ($name, $code, $level) = @_;
if ($level > 1) {
local $Test::Builder::Level = $Test::Builder::Level + 1;
main::subtest_at_level($name, $code, $level-1);
}
else {
Test::Builder->new->subtest($name => $code);
}
}
package main;
test_subtest_in_todo("plan, no tests run", sub {
plan tests => 2;
}, <<END, 1);
1..2
# No tests run!
END
test_subtest_in_todo("noplan, no tests run", sub {
plan 'no_plan';
}, <<END, 1);
# No tests run!
END
test_subtest_in_todo("missingplan, no tests run", sub {
1;
}, <<END, 1);
1..0
# No tests run!
END
test_subtest_in_todo("donetesting, no tests run", sub {
done_testing;
}, <<END, 1);
1..0
# No tests run!
END
test_subtest_in_todo("1 failed test", sub {
ok 0, 'failme'; BEGIN { $line{fail1} = __LINE__ }
}, <<END);
not ok 1 - failme
# Failed test 'failme'
# at $0 line $line{fail1}.
1..1
# Looks like you failed 1 test of 1.
END
test_subtest_in_todo("1fail, wrongplan", sub {
plan tests => 17;
ok 0, 'failme'; BEGIN { $line{fail2} = __LINE__ }
}, <<END);
1..17
not ok 1 - failme
# Failed test 'failme'
# at $0 line $line{fail2}.
# Looks like you planned 17 tests but ran 1.
# Looks like you failed 1 test of 1 run.
END
test_subtest_in_todo("1fail, 1pass", sub {
ok 0, 'failme'; BEGIN { $line{fail3} = __LINE__ }
ok 1, 'passme';
}, <<END);
not ok 1 - failme
# Failed test 'failme'
# at $0 line $line{fail3}.
ok 2 - passme
1..2
# Looks like you failed 1 test of 2.
END
test_subtest_in_todo("todo tests in the subtest", sub {
ok 0, 'inner test 1'; BEGIN{ $line{in1} = __LINE__ }
TODO: {
local $TODO = 'Inner1';
ok 0, 'failing TODO a'; BEGIN{ $line{fta} = __LINE__ }
ok 1, 'unexpected pass a';
}
ok 0, 'inner test 2'; BEGIN{ $line{in2} = __LINE__ }
Test::Builder->new->todo_start('Inner2');
ok 0, 'failing TODO b'; BEGIN{ $line{ftb} = __LINE__ }
ok 1, 'unexpected pass b';
Test::Builder->new->todo_end;
ok 0, 'inner test 3'; BEGIN{ $line{in3} = __LINE__ }
}, <<END);
not ok 1 - inner test 1
# Failed test 'inner test 1'
# at $0 line $line{in1}.
not ok 2 - failing TODO a # TODO Inner1
# Failed (TODO) test 'failing TODO a'
# at $0 line $line{fta}.
ok 3 - unexpected pass a # TODO Inner1
not ok 4 - inner test 2
# Failed test 'inner test 2'
# at $0 line $line{in2}.
not ok 5 - failing TODO b # TODO Inner2
# Failed (TODO) test 'failing TODO b'
# at $0 line $line{ftb}.
ok 6 - unexpected pass b # TODO Inner2
not ok 7 - inner test 3
# Failed test 'inner test 3'
# at $0 line $line{in3}.
1..7
# Looks like you failed 3 tests of 7.
END
PK 1��\�?�q q t/Legacy/subtest/wstat.tnu �[��� #!/usr/bin/perl -w
# Test that setting $? doesn't affect subtest success
use strict;
use Test::More;
subtest foo => sub {
plan tests => 1;
$? = 1;
pass('bar');
};
is $?, 1, "exit code keeps on from a subtest";
subtest foo2 => sub {
plan tests => 1;
pass('bar2');
$? = 1;
};
is $?, 1, "exit code keeps on from a subtest";
done_testing(4);
PK 1��\���G� � t/Legacy/00test_harness_check.tnu �[��� #!/usr/bin/perl -w
# A test to make sure the new Test::Harness was installed properly.
use Test::More;
plan tests => 1;
my $TH_Version = 2.03;
require Test::Harness;
unless( cmp_ok( eval $Test::Harness::VERSION, '>=', $TH_Version, "T::H version" ) ) {
diag <<INSTRUCTIONS;
Test::Simple/More/Builder has features which depend on a version of
Test::Harness greater than $TH_Version. You have $Test::Harness::VERSION.
Please install a new version from CPAN.
If you've already tried to upgrade Test::Harness and still get this
message, the new version may be "shadowed" by the old. Check the
output of Test::Harness's "make install" for "## Differing version"
messages. You can delete the old version by running
"make install UNINST=1".
INSTRUCTIONS
}
PK 1��\�s�Z Z t/Legacy/01-basic.tnu �[��� use strict;
use Test::More tests => 3;
use ok 'strict';
use ok 'Test::More';
use ok 'ok';
PK 1��\��TY� � t/Legacy/478-cmp_ok_hash.tnu �[��� use strict;
use warnings;
use Test::More;
my $want = 0;
my $got = 0;
cmp_ok($got, 'eq', $want, "Passes on correct comparison");
my ($res, @ok, @diag, @warn);
{
no warnings 'redefine';
local *Test::Builder::ok = sub {
my ($tb, $ok, $name) = @_;
push @ok => $ok;
return $ok;
};
local *Test::Builder::diag = sub {
my ($tb, @d) = @_;
push @diag => @d;
};
local $SIG{__WARN__} = sub {
push @warn => @_;
};
$res = cmp_ok($got, '#eq', $want, "You shall not pass!");
}
ok(!$res, "Did not pass");
is(@ok, 1, "1 result");
ok(!$ok[0], "result is false");
# We only care that it mentions a syntax error.
like(join("\n" => @diag), qr/syntax error at \(eval in cmp_ok\)/, "Syntax error");
# We are not going to inspect the warning because it is not super predictable,
# and changes with eval specifics.
ok(@warn, "We got warnings");
done_testing;
PK 1��\���c� � t/Legacy/BEGIN_require_ok.tnu �[��� #!/usr/bin/perl -w
# Fixed a problem with BEGIN { use_ok or require_ok } silently failing when there's no
# plan set. [rt.cpan.org 28345] Thanks Adriano Ferreira and Yitzchak.
use strict;
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use Test::More;
my $result;
BEGIN {
$result = require_ok("strict");
}
ok $result, "require_ok ran";
done_testing(2);
PK 1��\�ߍ�� � t/Legacy/BEGIN_use_ok.tnu �[��� #!/usr/bin/perl -w
# [rt.cpan.org 28345]
#
# A use_ok() inside a BEGIN block lacking a plan would be silently ignored.
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use Test::More;
my $result;
BEGIN {
$result = use_ok("strict");
}
ok( $result, "use_ok() ran" );
done_testing(2);
PK 1��\�omQb b t/Legacy/More.tnu �[��� #!perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = qw(../lib ../lib/Test/Simple/t/lib);
}
}
use lib 't/lib';
use Test::More tests => 54;
# Make sure we don't mess with $@ or $!. Test at bottom.
my $Err = "this should not be touched";
my $Errno = 42;
$@ = $Err;
$! = $Errno;
use_ok('Dummy');
is( $Dummy::VERSION, '0.01', 'use_ok() loads a module' );
require_ok('Test::More');
ok( 2 eq 2, 'two is two is two is two' );
is( "foo", "foo", 'foo is foo' );
isnt( "foo", "bar", 'foo isnt bar');
isn't("foo", "bar", 'foo isn\'t bar');
#'#
like("fooble", '/^foo/', 'foo is like fooble');
like("FooBle", '/foo/i', 'foo is like FooBle');
like("/usr/local/pr0n/", '/^\/usr\/local/', 'regexes with slashes in like' );
unlike("fbar", '/^bar/', 'unlike bar');
unlike("FooBle", '/foo/', 'foo is unlike FooBle');
unlike("/var/local/pr0n/", '/^\/usr\/local/','regexes with slashes in unlike' );
my @foo = qw(foo bar baz);
unlike(@foo, '/foo/');
can_ok('Test::More', qw(require_ok use_ok ok is isnt like skip can_ok
pass fail eq_array eq_hash eq_set));
can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip
can_ok pass fail eq_array eq_hash eq_set));
isa_ok(bless([], "Foo"), "Foo");
isa_ok([], 'ARRAY');
isa_ok(\42, 'SCALAR');
{
local %Bar::;
local @Foo::ISA = 'Bar';
isa_ok( "Foo", "Bar" );
}
# can_ok() & isa_ok should call can() & isa() on the given object, not
# just class, in case of custom can()
{
local *Foo::can;
local *Foo::isa;
*Foo::can = sub { $_[0]->[0] };
*Foo::isa = sub { $_[0]->[0] };
my $foo = bless([0], 'Foo');
ok( ! $foo->can('bar') );
ok( ! $foo->isa('bar') );
$foo->[0] = 1;
can_ok( $foo, 'blah');
isa_ok( $foo, 'blah');
}
pass('pass() passed');
ok( eq_array([qw(this that whatever)], [qw(this that whatever)]),
'eq_array with simple arrays' );
is @Test::More::Data_Stack, 0, '@Data_Stack not holding onto things';
ok( eq_hash({ foo => 42, bar => 23 }, {bar => 23, foo => 42}),
'eq_hash with simple hashes' );
is @Test::More::Data_Stack, 0;
ok( eq_set([qw(this that whatever)], [qw(that whatever this)]),
'eq_set with simple sets' );
is @Test::More::Data_Stack, 0;
my @complex_array1 = (
[qw(this that whatever)],
{foo => 23, bar => 42},
"moo",
"yarrow",
[qw(498 10 29)],
);
my @complex_array2 = (
[qw(this that whatever)],
{foo => 23, bar => 42},
"moo",
"yarrow",
[qw(498 10 29)],
);
is_deeply( \@complex_array1, \@complex_array2, 'is_deeply with arrays' );
ok( eq_array(\@complex_array1, \@complex_array2),
'eq_array with complicated arrays' );
ok( eq_set(\@complex_array1, \@complex_array2),
'eq_set with complicated arrays' );
my @array1 = (qw(this that whatever),
{foo => 23, bar => 42} );
my @array2 = (qw(this that whatever),
{foo => 24, bar => 42} );
ok( !eq_array(\@array1, \@array2),
'eq_array with slightly different complicated arrays' );
is @Test::More::Data_Stack, 0;
ok( !eq_set(\@array1, \@array2),
'eq_set with slightly different complicated arrays' );
is @Test::More::Data_Stack, 0;
my %hash1 = ( foo => 23,
bar => [qw(this that whatever)],
har => { foo => 24, bar => 42 },
);
my %hash2 = ( foo => 23,
bar => [qw(this that whatever)],
har => { foo => 24, bar => 42 },
);
is_deeply( \%hash1, \%hash2, 'is_deeply with complicated hashes' );
ok( eq_hash(\%hash1, \%hash2), 'eq_hash with complicated hashes');
%hash1 = ( foo => 23,
bar => [qw(this that whatever)],
har => { foo => 24, bar => 42 },
);
%hash2 = ( foo => 23,
bar => [qw(this tha whatever)],
har => { foo => 24, bar => 42 },
);
ok( !eq_hash(\%hash1, \%hash2),
'eq_hash with slightly different complicated hashes' );
is @Test::More::Data_Stack, 0;
is( Test::Builder->new, Test::More->builder, 'builder()' );
cmp_ok(42, '==', 42, 'cmp_ok ==');
cmp_ok('foo', 'eq', 'foo', ' eq');
cmp_ok(42.5, '<', 42.6, ' <');
cmp_ok(0, '||', 1, ' ||');
# Piers pointed out sometimes people override isa().
{
package Wibble;
sub isa {
my($self, $class) = @_;
return 1 if $class eq 'Wibblemeister';
}
sub new { bless {} }
}
isa_ok( Wibble->new, 'Wibblemeister' );
my $sub = sub {};
is_deeply( $sub, $sub, 'the same function ref' );
use Symbol;
my $glob = gensym;
is_deeply( $glob, $glob, 'the same glob' );
is_deeply( { foo => $sub, bar => [1, $glob] },
{ foo => $sub, bar => [1, $glob] }
);
# rt.cpan.org 53469 is_deeply with regexes
is_deeply( qr/a/, qr/a/, "same regex" );
# These two tests must remain at the end.
is( $@, $Err, '$@ untouched' );
cmp_ok( $!, '==', $Errno, '$! untouched' );
PK 1��\��g�V V t/Legacy/auto.tnu �[��� use strict;
use warnings;
use lib 't/lib';
use Test::Tester tests => 6;
use SmallTest;
use MyTest;
{
my ($prem, @results) = run_tests(
sub { MyTest::ok(1, "run pass")}
);
is_eq($results[0]->{name}, "run pass");
is_num($results[0]->{ok}, 1);
}
{
my ($prem, @results) = run_tests(
sub { MyTest::ok(0, "run fail")}
);
is_eq($results[0]->{name}, "run fail");
is_num($results[0]->{ok}, 0);
}
is_eq(ref(SmallTest::getTest()), "Test::Tester::Delegate");
is_eq(
SmallTest::getTest()->can('ok'),
Test::Builder->can('ok'),
"Delegate->can() returns the sub from the inner object",
);
PK 1��\,��� � t/Legacy/bad_plan.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Test::Builder;
my $Test = Test::Builder->new;
$Test->plan( tests => 2 );
$Test->level(0);
my $tb = Test::Builder->create;
eval { $tb->plan(7); };
$Test->like( $@, qr/^plan\(\) doesn't understand 7/, 'bad plan()' ) ||
print STDERR "# $@";
eval { $tb->plan(wibble => 7); };
$Test->like( $@, qr/^plan\(\) doesn't understand wibble 7/, 'bad plan()' ) ||
print STDERR "# $@";
PK 1��\L�\DS S t/Legacy/bail_out.tnu �[��� #!/usr/bin/perl -w
# HARNESS-NO-STREAM
# HARNESS-NO-PRELOAD
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
my $Exit_Code;
BEGIN {
*CORE::GLOBAL::exit = sub { $Exit_Code = shift; };
}
# This test uses multiple builders, the real one is using the top hub, we need
# to fix the ending.
Test2::API::test2_stack()->top->set_no_ending(1);
use Test::Builder;
use Test::More;
my $output;
my $TB = Test::More->builder;
$TB->output(\$output);
my $Test = Test::Builder->create;
$Test->level(0);
$Test->plan(tests => 3);
plan tests => 4;
BAIL_OUT("ROCKS FALL! EVERYONE DIES!");
$Test->is_eq( $output, <<'OUT' );
1..4
Bail out! ROCKS FALL! EVERYONE DIES!
OUT
$Test->is_eq( $Exit_Code, 255 );
$Test->ok( $Test->can("BAILOUT"), "Backwards compat" );
PK 1��\X�6~� � t/Legacy/buffer.tnu �[��� #!/usr/bin/perl
# HARNESS-NO-STREAM
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
# Ensure that intermixed prints to STDOUT and tests come out in the
# right order (ie. no buffering problems).
use Test::More tests => 20;
my $T = Test::Builder->new;
$T->no_ending(1);
for my $num (1..10) {
$tnum = $num * 2;
pass("I'm ok");
$T->current_test($tnum);
print "ok $tnum - You're ok\n";
}
PK 1��\0O_�� � t/Legacy/c_flag.tnu �[��� #!/usr/bin/perl -w
# HARNESS-NO-STREAM
# HARNESS-NO-PRELOAD
# Test::More should not print anything when Perl is only doing
# a compile as with the -c flag or B::Deparse or perlcc.
# HARNESS_ACTIVE=1 was causing an error with -c
{
local $ENV{HARNESS_ACTIVE} = 1;
local $^C = 1;
require Test::More;
Test::More->import(tests => 1);
fail("This should not show up");
}
Test::More->builder->no_ending(1);
print "1..1\n";
print "ok 1\n";
PK 1��\���� � t/Legacy/capture.tnu �[��� use strict;
use Test::Tester;
my $Test = Test::Builder->new;
$Test->plan(tests => 3);
my $cap;
$cap = Test::Tester->capture;
{
no warnings 'redefine';
sub Test::Tester::find_run_tests { return 0};
}
local $Test::Builder::Level = 0;
{
my $cur = $cap->current_test;
$Test->is_num($cur, 0, "current test");
eval {$cap->current_test(2)};
$Test->ok($@, "can't set test_num");
}
{
$cap->ok(1, "a test");
my @res = $cap->details;
$Test->is_num(scalar @res, 1, "res count");
}
PK 1��\��1� � t/Legacy/check_tests.tnu �[��� use strict;
use Test::Tester;
use Data::Dumper qw(Dumper);
my $test = Test::Builder->new;
$test->plan(tests => 139);
my $cap;
$cap = Test::Tester->capture;
my @tests = (
[
'pass',
'$cap->ok(1, "pass");',
{
name => "pass",
ok => 1,
actual_ok => 1,
reason => "",
type => "",
diag => "",
depth => 0,
},
],
[
'pass diag',
'$cap->ok(1, "pass diag");
$cap->diag("pass diag1");
$cap->diag("pass diag2");',
{
name => "pass diag",
ok => 1,
actual_ok => 1,
reason => "",
type => "",
diag => "pass diag1\npass diag2\n",
depth => 0,
},
],
[
'pass diag no \\n',
'$cap->ok(1, "pass diag");
$cap->diag("pass diag1");
$cap->diag("pass diag2");',
{
name => "pass diag",
ok => 1,
actual_ok => 1,
reason => "",
type => "",
diag => "pass diag1\npass diag2",
depth => 0,
},
],
[
'fail',
'$cap->ok(0, "fail");
$cap->diag("fail diag");',
{
name => "fail",
ok => 0,
actual_ok => 0,
reason => "",
type => "",
diag => "fail diag\n",
depth => 0,
},
],
[
'skip',
'$cap->skip("just because");',
{
name => "",
ok => 1,
actual_ok => 1,
reason => "just because",
type => "skip",
diag => "",
depth => 0,
},
],
[
'todo_skip',
'$cap->todo_skip("why not");',
{
name => "",
ok => 1,
actual_ok => 0,
reason => "why not",
type => "todo_skip",
diag => "",
depth => 0,
},
],
[
'pass diag qr',
'$cap->ok(1, "pass diag qr");
$cap->diag("pass diag qr");',
{
name => "pass diag qr",
ok => 1,
actual_ok => 1,
reason => "",
type => "",
diag => qr/pass diag qr/,
depth => 0,
},
],
[
'fail diag qr',
'$cap->ok(0, "fail diag qr");
$cap->diag("fail diag qr");',
{
name => "fail diag qr",
ok => 0,
actual_ok => 0,
reason => "",
type => "",
diag => qr/fail diag qr/,
depth => 0,
},
],
);
my $big_code = "";
my @big_expect;
foreach my $test (@tests)
{
my ($name, $code, $expect) = @$test;
$big_code .= "$code\n";
push(@big_expect, $expect);
my $test_sub = eval "sub {$code}";
check_test($test_sub, $expect, $name);
}
my $big_test_sub = eval "sub {$big_code}";
check_tests($big_test_sub, \@big_expect, "run all");
PK 1��\.F
b� � t/Legacy/circular_data.tnu �[��� #!/usr/bin/perl -w
# Test is_deeply and friends with circular data structures [rt.cpan.org 7289]
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use strict;
use Test::More tests => 11;
my $a1 = [ 1, 2, 3 ];
push @$a1, $a1;
my $a2 = [ 1, 2, 3 ];
push @$a2, $a2;
is_deeply $a1, $a2;
ok( eq_array ($a1, $a2) );
ok( eq_set ($a1, $a2) );
my $h1 = { 1=>1, 2=>2, 3=>3 };
$h1->{4} = $h1;
my $h2 = { 1=>1, 2=>2, 3=>3 };
$h2->{4} = $h2;
is_deeply $h1, $h2;
ok( eq_hash ($h1, $h2) );
my ($r, $s);
$r = \$r;
$s = \$s;
ok( eq_array ([$s], [$r]) );
{
# Classic set of circular scalar refs.
my($a,$b,$c);
$a = \$b;
$b = \$c;
$c = \$a;
my($d,$e,$f);
$d = \$e;
$e = \$f;
$f = \$d;
is_deeply( $a, $a );
is_deeply( $a, $d );
}
{
# rt.cpan.org 11623
# Make sure the circular ref checks don't get confused by a reference
# which is simply repeating.
my $a = {};
my $b = {};
my $c = {};
is_deeply( [$a, $a], [$b, $c] );
is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } );
is_deeply( [\$a, \$a], [\$b, \$c] );
}
PK 1��\9��R t/Legacy/cmp_ok.tnu �[��� #!/usr/bin/perl -w
use strict;
use warnings;
use lib 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
local $ENV{HARNESS_ACTIVE} = 0;
require Test::Builder;
my $TB = Test::Builder->create;
$TB->level(0);
sub try_cmp_ok {
my($left, $cmp, $right, $error) = @_;
my %expect;
if( $error ) {
$expect{ok} = 0;
$expect{error} = $error;
}
else {
$expect{ok} = eval "\$left $cmp \$right";
$expect{error} = $@;
$expect{error} =~ s/ at .*\n?//;
}
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $ok;
eval { $ok = cmp_ok($left, $cmp, $right, "cmp_ok"); };
$TB->is_num(!!$ok, !!$expect{ok}, " right return");
my $diag = $err->read;
if ($@) {
$diag = $@;
$diag =~ s/ at .*\n?//;
}
if( !$ok and $expect{error} ) {
$diag =~ s/^# //mg;
$TB->like( $diag, qr/\Q$expect{error}\E/, " expected error" );
}
elsif( $ok ) {
$TB->is_eq( $diag, '', " passed without diagnostic" );
}
else {
$TB->ok(1, " failed without diagnostic");
}
}
use Test::More;
Test::More->builder->no_ending(1);
require MyOverload;
my $cmp = Overloaded::Compare->new("foo", 42);
my $ify = Overloaded::Ify->new("bar", 23);
my @Tests = (
[1, '==', 1],
[1, '==', 2],
["a", "eq", "b"],
["a", "eq", "a"],
[1, "+", 1],
[1, "-", 1],
[$cmp, '==', 42],
[$cmp, 'eq', "foo"],
[$ify, 'eq', "bar"],
[$ify, "==", 23],
[1, "=", 0, "= is not a valid comparison operator in cmp_ok()"],
[1, "+=", 0, "+= is not a valid comparison operator in cmp_ok()"],
);
plan tests => scalar @Tests;
$TB->plan(tests => @Tests * 2);
for my $test (@Tests) {
try_cmp_ok(@$test);
}
PK 1��\"�5� t/Legacy/depth.tnu �[��� use strict;
use warnings;
use lib 't/lib';
use Test::Tester;
use MyTest;
my $test = Test::Builder->new;
$test->plan(tests => 2);
sub deeper
{
MyTest::ok(1);
}
{
my @results = run_tests(
sub {
MyTest::ok(1);
deeper();
}
);
local $Test::Builder::Level = 0;
$test->is_num($results[1]->{depth}, 1, "depth 1");
$test->is_num($results[2]->{depth}, 2, "deeper");
}
PK 1��\]Þϐ � t/Legacy/diag.tnu �[��� #!perl -w
use strict;
use Test2::Util qw/CAN_THREAD/;
# Turn on threads here, if available, since this test tends to find
# lots of threading bugs.
BEGIN {
if (CAN_THREAD) {
require threads;
threads->import;
}
}
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
use Test::Builder::NoOutput;
use Test::More tests => 7;
my $test = Test::Builder::NoOutput->create;
# Test diag() goes to todo_output() in a todo test.
{
$test->todo_start();
$test->diag("a single line");
is( $test->read('todo'), <<'DIAG', 'diag() with todo_output set' );
# a single line
DIAG
my $ret = $test->diag("multiple\n", "lines");
is( $test->read('todo'), <<'DIAG', ' multi line' );
# multiple
# lines
DIAG
ok( !$ret, 'diag returns false' );
$test->todo_end();
}
# Test diagnostic formatting
{
$test->diag("# foo");
is( $test->read('err'), "# # foo\n", "diag() adds # even if there's one already" );
$test->diag("foo\n\nbar");
is( $test->read('err'), <<'DIAG', " blank lines get escaped" );
# foo
#
# bar
DIAG
$test->diag("foo\n\nbar\n\n");
is( $test->read('err'), <<'DIAG', " even at the end" );
# foo
#
# bar
#
DIAG
}
# [rt.cpan.org 8392] diag(@list) emulates print
{
$test->diag(qw(one two));
is( $test->read('err'), <<'DIAG' );
# onetwo
DIAG
}
PK 1��\8���y y t/Legacy/died.tnu �[��� #!perl -w
# HARNESS-NO-STREAM
# HARNESS-NO-PRELOAD
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
# This has to be a require or else the END block below runs before
# Test::Builder's own and the ending diagnostics don't come out right.
require Test::Builder;
my $TB = Test::Builder->create;
$TB->plan(tests => 3);
package main;
require Test::Simple;
chdir 't';
push @INC, '../t/lib/';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
local $ENV{HARNESS_ACTIVE} = 0;
Test::Simple->import(tests => 1);
exit 250;
END {
$TB->is_eq($out->read, <<OUT);
1..1
OUT
$TB->is_eq($err->read, <<ERR);
# Looks like your test exited with 250 before it could output anything.
ERR
$TB->is_eq($?, 250, "exit code");
$? = grep { !$_ } $TB->summary;
}
PK 1��\\�� % t/Legacy/dont_overwrite_die_handler.tnu �[��� #!/usr/bin/perl -w
use Config; # To prevent conflict with some strawberry-portable versions
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use Carp qw/cluck/;
# Make sure this is in place before Test::More is loaded.
my $started = 0;
my $handler_called;
BEGIN {
$SIG{__DIE__} = sub { $handler_called++; cluck 'Died early!' unless $started };
}
use Test::More tests => 2;
$started = 1;
ok !eval { die };
is $handler_called, 1, 'existing DIE handler not overridden';
PK 1��\I}��< < ( t/Legacy_And_Test2/builder_loaded_late.tnu �[��� use strict;
use warnings;
# HARNESS-NO-PRELOAD
use Test2::Tools::Tiny;
use Test2::API qw/intercept test2_stack/;
plan 3;
my @warnings;
{
local $SIG{__WARN__} = sub { push @warnings => @_ };
require Test::Builder;
};
is(@warnings, 2, "got warnings");
like(
$warnings[0],
qr/Test::Builder was loaded after Test2 initialization, this is not recommended/,
"Warn about late Test::Builder load"
);
like(
$warnings[1],
qr/Formatter Test::Builder::Formatter loaded too late to be used as the global formatter/,
"Got the formatter warning"
);
PK 1��\.١�� � % t/Legacy_And_Test2/diag_event_on_ok.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::API qw/intercept/;
use Test::More ();
my $events = intercept {
Test::More::ok(0, 'name');
};
my ($ok, $diag) = @$events;
ok($ok->isa('Test2::Event::Ok'), "got 'ok' result");
is($ok->pass, 0, "'ok' test failed");
is($ok->name, 'name', "got 'ok' name");
ok($diag->isa('Test2::Event::Diag'), "got 'ok' result");
is($diag->message, " Failed test 'name'\n at $0 line 9.\n", "got all diag message in one diag event");
done_testing;
PK 1��\p�el3 3 $ t/Legacy_And_Test2/hidden_warnings.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::API qw( context_do );
$SIG{__WARN__} = sub {
context_do { shift->throw("oops\n"); }
$_[0];
};
my $array_var = [];
eval { warn "trigger warning" };
my $err = $@;
like(
$err,
qr/oops/,
"Got expected error"
);
done_testing();
PK 1��\�`S� � & t/Legacy_And_Test2/preload_diag_note.tnu �[��� use strict;
use warnings;
if ($] lt "5.008") {
print "1..0 # SKIP Test cannot run on perls below 5.8.0\n";
exit 0;
}
BEGIN {
require Test2::API;
Test2::API::test2_start_preload();
}
use Test::More;
my ($stdout, $stderr) = ('', '');
{
local *STDOUT;
open(STDOUT, '>', \$stdout) or die "Could not open temp STDOUT";
local *STDERR;
open(STDERR, '>', \$stderr) or die "Could not open temp STDOUT";
diag("test\n", "diag\nfoo");
note("test\n", "note\nbar");
}
Test2::API::test2_stop_preload();
is($stdout, <<EOT, "Got stdout");
# test
# note
# bar
EOT
is($stderr, <<EOT, "Got stderr");
# test
# diag
# foo
EOT
done_testing;
PK 1��\�W�4� � ( t/Test2/acceptance/try_it_done_testing.tnu �[��� use strict;
use warnings;
use Test2::API qw/context/;
sub done_testing {
my $ctx = context();
die "Test Already ended!" if $ctx->hub->ended;
$ctx->hub->finalize($ctx->trace, 1);
$ctx->release;
}
sub ok($;$) {
my ($bool, $name) = @_;
my $ctx = context();
$ctx->ok($bool, $name);
$ctx->release;
}
ok(1, "First");
ok(1, "Second");
done_testing;
1;
PK 1��\X
�=" " t/Test2/acceptance/try_it_fork.tnu �[��� use strict;
use warnings;
use Test2::Util qw/CAN_FORK/;
use Test2::IPC;
use Test2::API qw/context/;
sub plan {
my $ctx = context();
$ctx->plan(@_);
$ctx->release;
}
sub ok($;$) {
my ($bool, $name) = @_;
my $ctx = context();
$ctx->ok($bool, $name);
$ctx->release;
}
plan(0, skip_all => 'System cannot fork') unless CAN_FORK();
plan(6);
for (1 .. 3) {
my $pid = fork;
die "Failed to fork" unless defined $pid;
next if $pid;
ok(1, "test 1 in pid $$");
ok(1, "test 2 in pid $$");
last;
}
1;
PK 1��\�t�5 5 # t/Test2/acceptance/try_it_no_plan.tnu �[��� use strict;
use warnings;
use Test2::API qw/context/;
sub plan {
my $ctx = context();
$ctx->plan(@_);
$ctx->release;
}
sub ok($;$) {
my ($bool, $name) = @_;
my $ctx = context();
$ctx->ok($bool, $name);
$ctx->release;
}
plan(0, 'no_plan');
ok(1, "First");
ok(1, "Second");
1;
PK 1��\
�f* * t/Test2/acceptance/try_it_plan.tnu �[��� use strict;
use warnings;
use Test2::API qw/context/;
sub plan {
my $ctx = context();
$ctx->plan(@_);
$ctx->release;
}
sub ok($;$) {
my ($bool, $name) = @_;
my $ctx = context();
$ctx->ok($bool, $name);
$ctx->release;
}
plan(2);
ok(1, "First");
ok(1, "Second");
1;
PK 1��\dU6�� � t/Test2/acceptance/try_it_skip.tnu �[��� use strict;
use warnings;
use Test2::API qw/context/;
sub plan {
my $ctx = context();
$ctx->plan(@_);
$ctx->release;
}
plan(0, skip_all => 'testing skip all');
die "Should not see this";
1;
PK 1��\iL�C C # t/Test2/acceptance/try_it_threads.tnu �[��� use strict;
use warnings;
use Test2::Util qw/CAN_THREAD/;
use Test2::IPC;
use Test2::API qw/context/;
sub plan {
my $ctx = context();
$ctx->plan(@_);
$ctx->release;
}
sub ok($;$) {
my ($bool, $name) = @_;
my $ctx = context();
$ctx->ok($bool, $name);
$ctx->release;
}
plan(0, skip_all => 'System does not have threads') unless CAN_THREAD();
plan(6);
require threads;
threads->import;
for (1 .. 3) {
threads->create(sub {
ok(1, "test 1 in thread " . threads->tid());
ok(1, "test 2 in thread " . threads->tid());
});
}
1;
PK 1��\ �&� � t/Test2/acceptance/try_it_todo.tnu �[��� use strict;
use warnings;
use Test2::API qw/context test2_stack/;
sub done_testing {
my $ctx = context();
die "Test Already ended!" if $ctx->hub->ended;
$ctx->hub->finalize($ctx->trace, 1);
$ctx->release;
}
sub ok($;$) {
my ($bool, $name) = @_;
my $ctx = context();
$ctx->ok($bool, $name);
$ctx->release;
}
sub diag {
my $ctx = context();
$ctx->diag( join '', @_ );
$ctx->release;
}
ok(1, "First");
my $filter = test2_stack->top->filter(sub {
my ($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 ($event->isa('Test2::Event::Ok')) {
$event->set_todo('here be dragons');
$event->set_effective_pass(1);
}
return $event;
});
ok(0, "Second");
diag "should be a note";
test2_stack->top->unfilter($filter);
ok(1, "Third");
done_testing;
PK 1��\߇5O� � t/Test2/behavior/Formatter.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::API qw/intercept run_subtest test2_stack/;
use Test2::Event::Bail;
{
package Formatter::Subclass;
use base 'Test2::Formatter';
use Test2::Util::HashBase qw{f t};
sub init {
my $self = shift;
$self->{+F} = [];
$self->{+T} = [];
}
sub write { }
sub hide_buffered { 1 }
sub terminate {
my $s = shift;
push @{$s->{+T}}, [@_];
}
sub finalize {
my $s = shift;
push @{$s->{+F}}, [@_];
}
}
{
my $f = Formatter::Subclass->new;
intercept {
my $hub = test2_stack->top;
$hub->format($f);
is(1, 1, 'test event 1');
is(2, 2, 'test event 2');
is(3, 2, 'test event 3');
done_testing;
};
is(scalar @{$f->f}, 1, 'finalize method was called on formatter');
is_deeply(
$f->f->[0],
[3, 3, 1, 0, 0],
'finalize method received expected arguments'
);
ok(!@{$f->t}, 'terminate method was not called on formatter');
}
{
my $f = Formatter::Subclass->new;
intercept {
my $hub = test2_stack->top;
$hub->format($f);
$hub->send(Test2::Event::Bail->new(reason => 'everything is terrible'));
done_testing;
};
is(scalar @{$f->t}, 1, 'terminate method was called because of bail event');
ok(!@{$f->f}, 'finalize method was not called on formatter');
}
{
my $f = Formatter::Subclass->new;
intercept {
my $hub = test2_stack->top;
$hub->format($f);
$hub->send(Test2::Event::Plan->new(directive => 'skip_all', reason => 'Skipping all the tests'));
done_testing;
};
is(scalar @{$f->t}, 1, 'terminate method was called because of plan skip_all event');
ok(!@{$f->f}, 'finalize method was not called on formatter');
}
done_testing;
PK 1��\K��x
x
+ t/Test2/behavior/Subtest_buffer_formatter.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::API qw/run_subtest intercept test2_stack/;
{
package Formatter::Hide;
sub write { }
sub hide_buffered { 1 }
sub terminate { }
sub finalize { }
package Formatter::Show;
sub write { }
sub hide_buffered { 0 }
sub terminate { }
sub finalize { }
package Formatter::NA;
sub write { }
sub terminate { }
sub finalize { }
}
my %HAS_FORMATTER;
my $events = intercept {
my $code = sub {
my $hub = test2_stack->top;
$HAS_FORMATTER{unbuffered_none} = $hub->format ? 1 : 0;
};
run_subtest('unbuffered', $code);
$code = sub {
my $hub = test2_stack->top;
$HAS_FORMATTER{buffered_none} = $hub->format ? 1 : 0;
};
run_subtest('buffered', $code, 'BUFFERED');
#####################
test2_stack->top->format(bless {}, 'Formatter::Hide');
$code = sub {
my $hub = test2_stack->top;
$HAS_FORMATTER{unbuffered_hide} = $hub->format ? 1 : 0;
};
run_subtest('unbuffered', $code);
$code = sub {
my $hub = test2_stack->top;
$HAS_FORMATTER{buffered_hide} = $hub->format ? 1 : 0;
};
run_subtest('buffered', $code, 'BUFFERED');
#####################
test2_stack->top->format(bless {}, 'Formatter::Show');
$code = sub {
my $hub = test2_stack->top;
$HAS_FORMATTER{unbuffered_show} = $hub->format ? 1 : 0;
};
run_subtest('unbuffered', $code);
$code = sub {
my $hub = test2_stack->top;
$HAS_FORMATTER{buffered_show} = $hub->format ? 1 : 0;
};
run_subtest('buffered', $code, 'BUFFERED');
#####################
$code = sub {
my $hub = test2_stack->top;
$HAS_FORMATTER{unbuffered_na} = $hub->format ? 1 : 0;
};
run_subtest('unbuffered', $code);
test2_stack->top->format(bless {}, 'Formatter::NA');
$code = sub {
my $hub = test2_stack->top;
$HAS_FORMATTER{buffered_na} = $hub->format ? 1 : 0;
};
run_subtest('buffered', $code, 'BUFFERED');
};
ok(!$HAS_FORMATTER{unbuffered_none}, "Unbuffered with no parent formatter has no formatter");
ok( $HAS_FORMATTER{unbuffered_show}, "Unbuffered where parent has 'show' formatter has formatter");
ok( $HAS_FORMATTER{unbuffered_hide}, "Unbuffered where parent has 'hide' formatter has formatter");
ok(!$HAS_FORMATTER{buffered_none}, "Buffered with no parent formatter has no formatter");
ok( $HAS_FORMATTER{buffered_show}, "Buffered where parent has 'show' formatter has formatter");
ok(!$HAS_FORMATTER{buffered_hide}, "Buffered where parent has 'hide' formatter has no formatter");
done_testing;
PK 1��\]3� � # t/Test2/behavior/Subtest_callback.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::API qw/run_subtest intercept/;
my $step = 0;
my @callback_calls = ();
Test2::API::test2_add_callback_pre_subtest(
sub {
is(
$step,
0,
'pre-subtest callbacks should be invoked before the subtest',
);
++$step;
push @callback_calls, [@_];
},
);
run_subtest(
(my $subtest_name='some subtest'),
(my $subtest_code=sub {
is(
$step,
1,
'subtest should be run after the pre-subtest callbacks',
);
++$step;
}),
undef,
(my @subtest_args = (1,2,3)),
);
is_deeply(
\@callback_calls,
[[$subtest_name,$subtest_code,@subtest_args]],
'pre-subtest callbacks should be invoked with the expected arguments',
);
is(
$step,
2,
'the subtest should be run',
);
done_testing;
PK 1��\�R2�� � ! t/Test2/behavior/Subtest_events.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::API qw/run_subtest intercept/;
my $events = intercept {
my $code = sub { ok(1) };
run_subtest('blah', $code, 'buffered');
};
ok(!$events->[0]->trace->nested, "main event is not inside a subtest");
ok($events->[0]->subtest_id, "Got subtest id");
is($events->[0]->subevents->[0]->trace->hid, $events->[0]->subtest_id, "nested events are in the subtest");
done_testing;
PK 1��\l�39c c t/Test2/behavior/Subtest_plan.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::API qw/run_subtest intercept/;
my $events = intercept {
my $code = sub { plan 4; ok(1) };
run_subtest('bad_plan', $code, 'buffered');
};
is(
$events->[-1]->message,
"Bad subtest plan, expected 4 but ran 1",
"Helpful message if subtest has a bad plan",
);
done_testing;
PK 1��\��t�� � t/Test2/behavior/Subtest_todo.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
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 $subevents = $events->[1]->subevents;
is(scalar @$subevents, 3, 'got subevents in the subtest');
ok($subevents->[0]->facets->{assert}->pass, 'first event passed');
ok(!$subevents->[1]->facets->{assert}->pass, 'second event failed');
ok(!$subevents->[1]->causes_fail, 'second event does not cause failure');
done_testing;
PK 1��\�$�d d t/Test2/behavior/Taint.tnu �[��� #!/usr/bin/env perl -T
# HARNESS-NO-FORMATTER
use Test2::API qw/context/;
sub ok($;$@) {
my ($bool, $name) = @_;
my $ctx = context();
$ctx->ok($bool, $name);
$ctx->release;
return $bool ? 1 : 0;
}
sub done_testing {
my $ctx = context();
$ctx->hub->finalize($ctx->trace, 1);
$ctx->release;
}
ok(1);
ok(1);
done_testing;
PK 1��\��]�� � t/Test2/behavior/disable_ipc_a.tnu �[��� use strict;
use warnings;
no Test2::IPC;
use Test2::Tools::Tiny;
use Test2::IPC::Driver::Files;
ok(Test2::API::test2_ipc_disabled, "disabled IPC");
ok(!Test2::API::test2_ipc, "No IPC");
done_testing;
PK 1��\G<��� � t/Test2/behavior/disable_ipc_b.tnu �[��� use strict;
use warnings;
BEGIN { $ENV{T2_NO_IPC} = 1 };
use Test2::Tools::Tiny;
use Test2::IPC::Driver::Files;
ok(Test2::API::test2_ipc_disabled, "disabled IPC");
ok(!Test2::API::test2_ipc, "No IPC");
done_testing;
PK 1��\�Ң� t/Test2/behavior/disable_ipc_c.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::API qw/test2_ipc_disable/;
BEGIN { test2_ipc_disable() }
use Test2::IPC::Driver::Files;
ok(Test2::API::test2_ipc_disabled, "disabled IPC");
ok(!Test2::API::test2_ipc, "No IPC");
done_testing;
PK 1��\~��u� � t/Test2/behavior/disable_ipc_d.tnu �[��� use strict;
use warnings;
use Test2::Util qw/CAN_THREAD/;
use Test2::API qw/context/;
BEGIN {
sub plan {
my $ctx = context();
$ctx->plan(@_);
$ctx->release;
}
unless (CAN_THREAD()) {
plan(0, skip_all => 'System does not have threads');
exit 0;
}
}
use threads;
no Test2::IPC;
use Test::More;
ok(Test2::API::test2_ipc_disabled, "disabled IPC");
ok(!Test2::API::test2_ipc, "No IPC");
done_testing;
PK 1��\��� � t/Test2/behavior/err_var.tnu �[��� use strict;
use warnings;
use Test2::IPC;
use Test2::Tools::Tiny;
{
local $! = 100;
is(0 + $!, 100, 'set $!');
is(0 + $!, 100, 'preserved $!');
}
done_testing;
PK 1��\�T�M M t/Test2/behavior/init_croak.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
BEGIN {
package Foo::Bar;
use Test2::Util::HashBase qw/foo bar baz/;
use Carp qw/croak/;
sub init {
my $self = shift;
croak "'foo' is a required attribute"
unless $self->{+FOO};
}
}
skip_all("known to fail on $]") if $] le "5.006002";
$@ = "";
my ($file, $line) = (__FILE__, __LINE__ + 1);
eval { my $one = Foo::Bar->new };
my $err = $@;
like(
$err,
qr/^'foo' is a required attribute at \Q$file\E line $line/,
"Croak does not report to HashBase from init"
);
done_testing;
PK 1��\�R�] ] t/Test2/behavior/intercept.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::API qw/intercept intercept_deep context run_subtest/;
sub streamed {
my $name = shift;
my $code = shift;
my $ctx = context();
my $pass = run_subtest("Subtest: $name", $code, {buffered => 0}, @_);
$ctx->release;
return $pass;
}
sub buffered {
my $name = shift;
my $code = shift;
my $ctx = context();
my $pass = run_subtest($name, $code, {buffered => 1}, @_);
$ctx->release;
return $pass;
}
my $subtest = sub { ok(1, "pass") };
my $buffered_shallow = intercept { buffered 'buffered shallow' => $subtest };
my $streamed_shallow = intercept { streamed 'streamed shallow' => $subtest };
my $buffered_deep = intercept_deep { buffered 'buffered shallow' => $subtest };
my $streamed_deep = intercept_deep { streamed 'streamed shallow' => $subtest };
is(@$buffered_shallow, 1, "Just got the subtest event");
is(@$streamed_shallow, 2, "Got note, and subtest events");
is(@$buffered_deep, 3, "Got ok, plan, and subtest events");
is(@$streamed_deep, 4, "Got note, ok, plan, and subtest events");
done_testing;
PK 1��\����/ / # t/Test2/behavior/ipc_wait_timeout.tnu �[��� use strict;
use warnings;
# The things done in this test can trigger a buggy return value on some
# platforms. This prevents that. The harness should catch actual failures. If
# no harness is active then we will NOT sanitize the exit value, false fails
# are better than false passes.
END { $? = 0 if $ENV{HARNESS_ACTIVE} }
# Some platforms throw a sigpipe in this test, we can ignore it.
BEGIN { $SIG{PIPE} = 'IGNORE' }
BEGIN { local ($@, $?, $!); eval { require threads } }
use Test2::Tools::Tiny;
use Test2::Util qw/CAN_THREAD CAN_REALLY_FORK/;
use Test2::IPC;
use Test2::API qw/test2_ipc_set_timeout test2_ipc_get_timeout/;
my $plan = 2;
$plan += 2 if CAN_REALLY_FORK;
$plan += 2 if CAN_THREAD && threads->can('is_joinable');
plan $plan;
is(test2_ipc_get_timeout(), 30, "got default timeout");
test2_ipc_set_timeout(10);
is(test2_ipc_get_timeout(), 10, "hanged the timeout");
if (CAN_REALLY_FORK) {
note "Testing process waiting";
my ($ppiper, $ppipew);
pipe($ppiper, $ppipew) or die "Could not create pipe for fork";
my $proc = fork();
die "Could not fork!" unless defined $proc;
unless ($proc) {
local $SIG{ALRM} = sub { die "PROCESS TIMEOUT" };
alarm 15;
my $ignore = <$ppiper>;
exit 0;
}
my $exit;
my $warnings = warnings {
$exit = Test2::API::Instance::_ipc_wait(1);
};
is($exit, 255, "Exited 255");
like($warnings->[0], qr/Timeout waiting on child processes/, "Warned about timeout");
print $ppipew "end\n";
close($ppiper);
close($ppipew);
}
if (CAN_THREAD) {
note "Testing thread waiting";
my ($tpiper, $tpipew);
pipe($tpiper, $tpipew) or die "Could not create pipe for threads";
my $thread = threads->create(
sub {
local $SIG{ALRM} = sub { die "THREAD TIMEOUT" };
alarm 15;
my $ignore = <$tpiper>;
}
);
if ($thread->can('is_joinable')) {
my $exit;
my $warnings = warnings {
$exit = Test2::API::Instance::_ipc_wait(1);
};
is($exit, 255, "Exited 255");
like($warnings->[0], qr/Timeout waiting on child thread/, "Warned about timeout");
}
else {
note "threads.pm is too old for a thread joining timeout :-(";
}
print $tpipew "end\n";
close($tpiper);
close($tpipew);
}
PK 1��\!
[ [ + t/Test2/behavior/nested_context_exception.tnu �[��� use strict;
use warnings;
BEGIN { $Test2::API::DO_DEPTH_CHECK = 1 }
use Test2::Tools::Tiny;
use Test2::API qw/context/;
skip_all("known to fail on $]") if $] le "5.006002";
sub outer {
my $code = shift;
my $ctx = context();
$ctx->note("outer");
my $out = eval { $code->() };
$ctx->release;
return $out;
}
sub dies {
my $ctx = context();
$ctx->note("dies");
die "Foo";
}
sub bad_store {
my $ctx = context();
$ctx->note("bad store");
return $ctx; # Emulate storing it somewhere
}
sub bad_simple {
my $ctx = context();
$ctx->note("bad simple");
return;
}
my @warnings;
{
local $SIG{__WARN__} = sub { push @warnings => @_ };
eval { dies() };
}
ok(!@warnings, "no warnings") || diag @warnings;
@warnings = ();
my $keep = bad_store();
eval { my $x = 1 }; # Ensure an eval changing $@ does not meddle.
{
local $SIG{__WARN__} = sub { push @warnings => @_ };
ok(1, "random event");
}
ok(@warnings, "got warnings");
like(
$warnings[0],
qr/context\(\) was called to retrieve an existing context/,
"got expected warning"
);
$keep = undef;
{
@warnings = ();
local $SIG{__WARN__} = sub { push @warnings => @_ };
bad_simple();
}
ok(@warnings, "got warnings");
like(
$warnings[0],
qr/A context appears to have been destroyed without first calling release/,
"got expected warning"
);
@warnings = ();
outer(\&dies);
{
local $SIG{__WARN__} = sub { push @warnings => @_ };
ok(1, "random event");
}
ok(!@warnings, "no warnings") || diag @warnings;
@warnings = ();
{
local $SIG{__WARN__} = sub { push @warnings => @_ };
outer(\&bad_store);
}
ok(@warnings, "got warnings");
like(
$warnings[0],
qr/A context appears to have been destroyed without first calling release/,
"got expected warning"
);
{
@warnings = ();
local $SIG{__WARN__} = sub { push @warnings => @_ };
outer(\&bad_simple);
}
ok(@warnings, "got warnings") || diag @warnings;
like(
$warnings[0],
qr/A context appears to have been destroyed without first calling release/,
"got expected warning"
);
done_testing;
PK 1��\�y�� t/Test2/behavior/no_load_api.tnu �[��� use strict;
use warnings;
use Data::Dumper;
# HARNESS-NO-STREAM
# HARNESS-NO-PRELOAD
###############################################################################
# #
# This test is to insure certain objects do not load Test2::API directly or #
# indirectly when being required. It is ok for import() to load Test2::API if #
# necessary, but simply requiring the modules should not. #
# #
###############################################################################
require Test2::Formatter;
require Test2::Formatter::TAP;
require Test2::Event;
require Test2::Event::Bail;
require Test2::Event::Diag;
require Test2::Event::Exception;
require Test2::Event::Note;
require Test2::Event::Ok;
require Test2::Event::Plan;
require Test2::Event::Skip;
require Test2::Event::Subtest;
require Test2::Event::Waiting;
require Test2::Util;
require Test2::Util::ExternalMeta;
require Test2::Util::HashBase;
require Test2::EventFacet::Trace;
require Test2::Hub;
require Test2::Hub::Interceptor;
require Test2::Hub::Subtest;
require Test2::Hub::Interceptor::Terminator;
my @loaded = grep { $INC{$_} } qw{
Test2/API.pm
Test2/API/Instance.pm
Test2/API/Context.pm
Test2/API/Stack.pm
};
require Test2::Tools::Tiny;
Test2::Tools::Tiny::ok(!@loaded, "Test2::API was not loaded")
|| Test2::Tools::Tiny::diag("Loaded: " . Dumper(\@loaded));
Test2::Tools::Tiny::done_testing();
PK 1��\bf�� � & t/Test2/behavior/run_subtest_inherit.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::API qw/run_subtest intercept context/;
# Test a subtest that should inherit the trace from the tool that calls it
my ($file, $line) = (__FILE__, __LINE__ + 1);
my $events = intercept { my_tool_inherit() };
is(@$events, 1, "got 1 event");
my $e = shift @$events;
ok($e->isa('Test2::Event::Subtest'), "got a subtest event");
is($e->trace->file, $file, "subtest is at correct file");
is($e->trace->line, $line, "subtest is at correct line");
my $plan = pop @{$e->subevents};
ok($plan->isa('Test2::Event::Plan'), "Removed plan");
for my $se (@{$e->subevents}) {
is($se->trace->file, $file, "subtest event is at correct file");
is($se->trace->line, $line, "subtest event is at correct line");
ok($se->facets->{assert}->pass, "subtest event passed");
}
# Test a subtest that should NOT inherit the trace from the tool that calls it
($file, $line) = (__FILE__, __LINE__ + 1);
$events = intercept { my_tool_no_inherit() };
is(@$events, 1, "got 1 event");
$e = shift @$events;
ok($e->isa('Test2::Event::Subtest'), "got a subtest event");
is($e->trace->file, $file, "subtest is at correct file");
is($e->trace->line, $line, "subtest is at correct line");
$plan = pop @{$e->subevents};
ok($plan->isa('Test2::Event::Plan'), "Removed plan");
for my $se (@{$e->subevents}) {
ok($se->trace->file ne $file, "subtest event is not in our file");
ok($se->trace->line ne $line, "subtest event is not on our line");
ok($se->facets->{assert}->{pass}, "subtest event passed");
}
done_testing;
# Make these tools appear to be in a different file/line
#line 100 'fake.pm'
sub my_tool_inherit {
my $ctx = context();
run_subtest(
'foo',
sub {
ok(1, 'a');
ok(2, 'b');
is_deeply(\@_, [qw/arg1 arg2/], "got args");
},
{buffered => 1, inherit_trace => 1},
'arg1', 'arg2'
);
$ctx->release;
}
sub my_tool_no_inherit {
my $ctx = context();
run_subtest(
'foo',
sub {
ok(1, 'a');
ok(2, 'b');
is_deeply(\@_, [qw/arg1 arg2/], "got args");
},
{buffered => 1, inherit_trace => 0},
'arg1', 'arg2'
);
$ctx->release;
}
PK 1��\ʡ��" " t/Test2/behavior/special_names.tnu �[��� use strict;
use warnings;
# HARNESS-NO-FORMATTER
use Test2::Tools::Tiny;
#########################
#
# This test us here to insure that Ok renders the way we want
#
#########################
use Test2::API qw/test2_stack/;
# Ensure the top hub is generated
test2_stack->top;
my $temp_hub = test2_stack->new_hub();
require Test2::Formatter::TAP;
$temp_hub->format(Test2::Formatter::TAP->new);
my $ok = capture {
ok(1);
ok(1, "");
ok(1, " ");
ok(1, "A");
ok(1, "\n");
ok(1, "\nB");
ok(1, "C\n");
ok(1, "\nD\n");
ok(1, "E\n\n");
};
my $not_ok = capture {
ok(0);
ok(0, "");
ok(0, " ");
ok(0, "A");
ok(0, "\n");
ok(0, "\nB");
ok(0, "C\n");
ok(0, "\nD\n");
ok(0, "E\n\n");
};
test2_stack->pop($temp_hub);
is($ok->{STDERR}, "", "STDERR for ok is empty");
is($ok->{STDOUT}, <<EOT, "STDOUT looks right for ok");
ok 1
ok 2 -_
ok 3 - _
ok 4 - A
ok 5 -_
# _
ok 6 -_
# B
ok 7 - C
# _
ok 8 -_
# D
# _
ok 9 - E
# _
# _
EOT
is($not_ok->{STDOUT}, <<EOT, "STDOUT looks right for not ok");
not ok 10
not ok 11 -_
not ok 12 - _
not ok 13 - A
not ok 14 -_
# _
not ok 15 -_
# B
not ok 16 - C
# _
not ok 17 -_
# D
# _
not ok 18 - E
# _
# _
EOT
done_testing;
PK 1��\cRC�� � " t/Test2/behavior/subtest_bailout.tnu �[��� use Test2::Tools::Tiny;
use strict;
use warnings;
use Test2::API qw/context run_subtest intercept/;
sub subtest {
my ($name, $code) = @_;
my $ctx = context();
my $pass = run_subtest($name, $code, {buffered => 1}, @_);
$ctx->release;
return $pass;
}
sub bail {
my $ctx = context();
$ctx->bail(@_);
$ctx->release;
}
my $events = intercept {
subtest outer => sub {
subtest inner => sub {
bail("bye!");
};
};
};
ok($events->[0]->isa('Test2::Event::Subtest'), "Got a subtest event when bail-out issued in a buffered subtest");
ok($events->[-1]->isa('Test2::Event::Bail'), "Bail-Out propogated");
ok(!$events->[-1]->facet_data->{trace}->{buffered}, "Final Bail-Out is not buffered");
ok($events->[0]->subevents->[-2]->isa('Test2::Event::Bail'), "Got bail out inside outer subtest");
ok($events->[0]->subevents->[-2]->facet_data->{trace}->{buffered}, "Bail-Out is buffered");
ok($events->[0]->subevents->[0]->subevents->[-2]->isa('Test2::Event::Bail'), "Got bail out inside inner subtest");
ok($events->[0]->subevents->[0]->subevents->[-2]->facet_data->{trace}->{buffered}, "Bail-Out is buffered");
done_testing;
PK 1��\�KlV� � " t/Test2/behavior/trace_signature.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::API qw/intercept context/;
use Test2::Util qw/get_tid/;
my $line;
my $events = intercept {
$line = __LINE__ + 1;
ok(1, "pass");
sub {
my $ctx = context;
$ctx->pass;
$ctx->pass;
$ctx->release;
}->();
};
my $sigpass = $events->[0]->trace->signature;
my $sigfail = $events->[1]->trace->signature;
ok($sigpass ne $sigfail, "Each tool got a new signature");
is($events->[$_]->trace->signature, $sigfail, "Diags share failed ok's signature") for 2 .. $#$events;
like($sigpass, qr/$$~${ \get_tid() }~\d+~\d+:$$:\Q${ \get_tid() }:${ \__FILE__ }:$line\E$/, "signature is sane");
my $trace = Test2::EventFacet::Trace->new(frame => ['main', 'foo.t', 42, 'xxx']);
delete $trace->{cid};
is($trace->signature, undef, "No signature without a cid");
is($events->[0]->related($events->[1]), 0, "event 0 is not related to event 1");
is($events->[1]->related($events->[2]), 1, "event 1 is related to event 2");
my $e = Test2::Event::Ok->new(pass => 1);
is($e->related($events->[0]), undef, "Cannot check relation, invalid trace");
$e = Test2::Event::Ok->new(pass => 1, trace => Test2::EventFacet::Trace->new(frame => ['', '', '', '']));
is($e->related($events->[0]), undef, "Cannot check relation, incomplete trace");
$e = Test2::Event::Ok->new(pass => 1, trace => Test2::EventFacet::Trace->new(frame => []));
is($e->related($events->[0]), undef, "Cannot check relation, incomplete trace");
done_testing;
PK 1��\�;}wV
V
t/Test2/behavior/uuid.tnu �[��� use Test2::Tools::Tiny;
use Test2::API qw/test2_add_uuid_via context intercept/;
my %CNT;
test2_add_uuid_via(sub {
my $type = shift;
$CNT{$type} ||= 1;
$type . '-' . $CNT{$type}++;
});
my $events = intercept {
ok(1, "pass");
sub {
my $ctx = context();
ok(1, "pass");
ok(0, "fail");
$ctx->release;
}->();
tests foo => sub {
ok(1, "pass");
};
warnings {
require Test::More;
*subtest = \&Test::More::subtest;
};
subtest(foo => sub {
ok(1, "pass");
});
};
my $hub = Test2::API::test2_stack->top;
is($hub->uuid, 'hub-1', "First hub got a uuid");
is($events->[0]->uuid, 'event-1', "First event gets first uuid");
is($events->[0]->trace->uuid, 'context-2', "First event has correct context");
is($events->[0]->trace->huuid, 'hub-2', "First event has correct hub");
is($events->[0]->facet_data->{about}->{uuid}, "event-1", "The UUID makes it to facet data");
is($events->[1]->uuid, 'event-2', "Second event gets correct uuid");
is($events->[1]->trace->uuid, 'context-3', "Second event has correct context");
is($events->[1]->trace->huuid, 'hub-2', "Second event has correct hub");
is($events->[2]->uuid, 'event-3', "Third event gets correct uuid");
is($events->[2]->trace->uuid, $events->[1]->trace->uuid, "Third event shares context with event 2");
is($events->[2]->trace->huuid, 'hub-2', "Third event has correct hub");
is($events->[3]->uuid, 'event-6', "subtest event gets correct uuid (not next)");
is($events->[3]->subtest_uuid, 'hub-3', "subtest event gets correct subtest-uuid (next hub uuid)");
is($events->[3]->trace->uuid, 'context-4', "subtest gets next sequential context");
is($events->[3]->trace->huuid, 'hub-2', "subtest event has correct hub");
is($events->[3]->subevents->[0]->uuid, 'event-4', "First subevent gets next event uuid");
is($events->[3]->subevents->[0]->trace->uuid, 'context-5', "First subevent has correct context");
is($events->[3]->subevents->[0]->trace->huuid, 'hub-3', "First subevent has correct hub uuid (subtest hub uuid)");
is($events->[3]->subevents->[1]->uuid, 'event-5', "Second subevent gets next event uuid");
is($events->[3]->subevents->[1]->trace->uuid, $events->[3]->trace->uuid, "Second subevent has same context as subtest itself");
is($events->[3]->subevents->[1]->trace->huuid, 'hub-3', "Second subevent has correct hub uuid (subtest hub uuid)");
is($events->[5]->uuid, 'event-10', "subtest event gets correct uuid (not next)");
is($events->[5]->subtest_uuid, 'hub-4', "subtest event gets correct subtest-uuid (next hub uuid)");
is($events->[5]->trace->uuid, 'context-8', "subtest gets next sequential context");
is($events->[5]->trace->huuid, 'hub-2', "subtest event has correct hub");
is($events->[5]->subevents->[0]->uuid, 'event-8', "First subevent gets next event uuid");
is($events->[5]->subevents->[0]->trace->uuid, 'context-10', "First subevent has correct context");
is($events->[5]->subevents->[0]->trace->huuid, 'hub-4', "First subevent has correct hub uuid (subtest hub uuid)");
is($events->[5]->subevents->[1]->uuid, 'event-9', "Second subevent gets next event uuid");
is($events->[5]->subevents->[1]->trace->uuid, $events->[5]->trace->uuid, "Second subevent has same context as subtest itself");
is($events->[5]->subevents->[1]->trace->huuid, 'hub-2', "Second subevent has correct hub uuid (subtest hub uuid)");
done_testing;
PK 1��\ �� � t/Test2/legacy/TAP.tnu �[��� use strict;
use warnings;
# HARNESS-NO-FORMATTER
use Test2::Tools::Tiny;
#########################
#
# This test us here to insure that Ok, Diag, and Note events render the way
# Test::More renders them, trailing whitespace and all.
#
#########################
use Test2::API qw/test2_stack context/;
# The tools in Test2::Tools::Tiny have some intentional differences from the
# Test::More versions, these behave more like Test::More which is important for
# back-compat.
sub tm_ok($;$) {
my ($bool, $name) = @_;
my $ctx = context;
my $ok = bless {
pass => $bool,
name => $name,
effective_pass => 1,
trace => $ctx->trace->snapshot,
}, 'Test2::Event::Ok';
# Do not call init
$ctx->hub->send($ok);
$ctx->release;
return $bool;
}
# Test::More actually does a bit more, but for this test we just want to see
# what happens when message is a specific string, or undef.
sub tm_diag {
my $ctx = context();
$ctx->diag(@_);
$ctx->release;
}
sub tm_note {
my $ctx = context();
$ctx->note(@_);
$ctx->release;
}
# Ensure the top hub is generated
test2_stack->top;
my $temp_hub = test2_stack->new_hub();
require Test::Builder::Formatter;
$temp_hub->format(Test::Builder::Formatter->new);
my $diag = capture {
tm_diag(undef);
tm_diag("");
tm_diag(" ");
tm_diag("A");
tm_diag("\n");
tm_diag("\nB");
tm_diag("C\n");
tm_diag("\nD\n");
tm_diag("E\n\n");
};
my $note = capture {
tm_note(undef);
tm_note("");
tm_note(" ");
tm_note("A");
tm_note("\n");
tm_note("\nB");
tm_note("C\n");
tm_note("\nD\n");
tm_note("E\n\n");
};
my $ok = capture {
tm_ok(1);
tm_ok(1, "");
tm_ok(1, " ");
tm_ok(1, "A");
tm_ok(1, "\n");
tm_ok(1, "\nB");
tm_ok(1, "C\n");
tm_ok(1, "\nD\n");
tm_ok(1, "E\n\n");
};
test2_stack->pop($temp_hub);
is($diag->{STDOUT}, "", "STDOUT is empty for diag");
is($diag->{STDERR}, <<EOT, "STDERR for diag looks right");
# undef
#_
# _
# A
#_
#_
# B
# C
#_
# D
# E
#_
EOT
is($note->{STDERR}, "", "STDERR for note is empty");
is($note->{STDOUT}, <<EOT, "STDOUT looks right for note");
# undef
#_
# _
# A
#_
#_
# B
# C
#_
# D
# E
#_
EOT
is($ok->{STDERR}, "", "STDERR for ok is empty");
is($ok->{STDOUT}, <<EOT, "STDOUT looks right for ok");
ok 1
ok 2 -_
ok 3 - _
ok 4 - A
ok 5 -_
#_
ok 6 -_
# B
ok 7 - C
#_
ok 8 -_
# D
#_
ok 9 - E
#_
#_
EOT
done_testing;
PK 1��\� ���
�
t/Test2/modules/API/Breakage.tnu �[��� use strict;
use warnings;
use Test2::IPC;
use Test2::Tools::Tiny;
use Test2::API::Breakage;
my $CLASS = 'Test2::API::Breakage';
for my $meth (qw/upgrade_suggested upgrade_required known_broken/) {
my @list = $CLASS->$meth;
ok(!(@list % 2), "Got even list ($meth)");
ok(!(grep {!defined($_)} @list), "No undefined items ($meth)");
}
{
no warnings 'redefine';
local *Test2::API::Breakage::upgrade_suggested = sub {
return ('T2Test::UG1' => '1.0', 'T2Test::UG2' => '0.5');
};
local *Test2::API::Breakage::upgrade_required = sub {
return ('T2Test::UR1' => '1.0', 'T2Test::UR2' => '0.5');
};
local *Test2::API::Breakage::known_broken = sub {
return ('T2Test::KB1' => '1.0', 'T2Test::KB2' => '0.5');
};
use warnings 'redefine';
ok(!$CLASS->report, "Nothing to report");
ok(!$CLASS->report(1), "Still nothing to report");
{
local %INC = (
%INC,
'T2Test/UG1.pm' => 1,
'T2Test/UG2.pm' => 1,
'T2Test/UR1.pm' => 1,
'T2Test/UR2.pm' => 1,
'T2Test/KB1.pm' => 1,
'T2Test/KB2.pm' => 1,
);
local $T2Test::UG1::VERSION = '0.9';
local $T2Test::UG2::VERSION = '0.9';
local $T2Test::UR1::VERSION = '0.9';
local $T2Test::UR2::VERSION = '0.9';
local $T2Test::KB1::VERSION = '0.9';
local $T2Test::KB2::VERSION = '0.9';
my @report = $CLASS->report;
is_deeply(
[sort @report],
[
sort
" * Module 'T2Test::UG1' is outdated, we recommed updating above 1.0.",
" * Module 'T2Test::UR1' is outdated and known to be broken, please update to 1.0 or higher.",
" * Module 'T2Test::KB1' is known to be broken in version 1.0 and below, newer versions have not been tested. You have: 0.9",
" * Module 'T2Test::KB2' is known to be broken in version 0.5 and below, newer versions have not been tested. You have: 0.9",
],
"Got expected report items"
);
}
my %look;
unshift @INC => sub {
my ($this, $file) = @_;
$look{$file}++ if $file =~ m{T2Test};
return;
};
ok(!$CLASS->report, "Nothing to report");
is_deeply(\%look, {}, "Did not try to load anything");
ok(!$CLASS->report(1), "Nothing to report");
is_deeply(
\%look,
{
'T2Test/UG1.pm' => 1,
'T2Test/UG2.pm' => 1,
'T2Test/UR1.pm' => 1,
'T2Test/UR2.pm' => 1,
'T2Test/KB1.pm' => 1,
'T2Test/KB2.pm' => 1,
},
"Tried to load modules"
);
}
done_testing;
PK 1��\<��V1 V1 t/Test2/modules/API/Context.tnu �[��� use strict;
use warnings;
BEGIN { $Test2::API::DO_DEPTH_CHECK = 1 }
use Test2::Tools::Tiny;
use Test2::API qw{
context intercept
test2_stack
test2_add_callback_context_acquire
test2_add_callback_context_init
test2_add_callback_context_release
};
my $error = exception { context(); 1 };
my $exception = "context() called, but return value is ignored at " . __FILE__ . ' line ' . (__LINE__ - 1);
like($error, qr/^\Q$exception\E/, "Got the exception" );
my $ref;
my $frame;
sub wrap(&) {
my $ctx = context();
my ($pkg, $file, $line, $sub) = caller(0);
$frame = [$pkg, $file, $line, $sub];
$_[0]->($ctx);
$ref = "$ctx";
$ctx->release;
}
wrap {
my $ctx = shift;
ok($ctx->hub, "got hub");
delete $ctx->trace->frame->[4];
is_deeply($ctx->trace->frame, $frame, "Found place to report errors");
};
wrap {
my $ctx = shift;
ok("$ctx" ne "$ref", "Got a new context");
my $new = context();
my @caller = caller(0);
is_deeply(
$new,
{%$ctx, _is_canon => undef, _is_spawn => [@caller[0,1,2,3]]},
"Additional call to context gets spawn"
);
delete $ctx->trace->frame->[4];
is_deeply($ctx->trace->frame, $frame, "Found place to report errors");
$new->release;
};
wrap {
my $ctx = shift;
my $snap = $ctx->snapshot;
is_deeply(
$snap,
{%$ctx, _is_canon => undef, _is_spawn => undef, _aborted => undef},
"snapshot is identical except for canon/spawn/aborted"
);
ok($ctx != $snap, "snapshot is a new instance");
};
my $end_ctx;
{ # Simulate an END block...
local *END = sub { local *__ANON__ = 'END'; context() };
my $ctx = END();
$frame = [ __PACKAGE__, __FILE__, __LINE__ - 1, 'main::END' ];
# "__LINE__ - 1" on the preceding line forces the value to be an IV
# (even though __LINE__ on its own is a PV), just as (caller)[2] is.
$end_ctx = $ctx->snapshot;
$ctx->release;
}
delete $end_ctx->trace->frame->[4];
is_deeply( $end_ctx->trace->frame, $frame, 'context is ok in an end block');
# Test event generation
{
package My::Formatter;
sub write {
my $self = shift;
my ($e) = @_;
push @$self => $e;
}
}
my $events = bless [], 'My::Formatter';
my $hub = Test2::Hub->new(
formatter => $events,
);
my $trace = Test2::EventFacet::Trace->new(
frame => [ 'Foo::Bar', 'foo_bar.t', 42, 'Foo::Bar::baz' ],
);
my $ctx = Test2::API::Context->new(
trace => $trace,
hub => $hub,
);
my $e = $ctx->build_event('Ok', pass => 1, name => 'foo');
is($e->pass, 1, "Pass");
is($e->name, 'foo', "got name");
is_deeply($e->trace, $trace, "Got the trace info");
ok(!@$events, "No events yet");
$e = $ctx->send_event('Ok', pass => 1, name => 'foo');
is($e->pass, 1, "Pass");
is($e->name, 'foo', "got name");
is_deeply($e->trace, $trace, "Got the trace info");
is(@$events, 1, "1 event");
is_deeply($events, [$e], "Hub saw the event");
pop @$events;
$e = $ctx->ok(1, 'foo');
is($e->pass, 1, "Pass");
is($e->name, 'foo', "got name");
is_deeply($e->trace, $trace, "Got the trace info");
is(@$events, 1, "1 event");
is_deeply($events, [$e], "Hub saw the event");
pop @$events;
$e = $ctx->note('foo');
is($e->message, 'foo', "got message");
is_deeply($e->trace, $trace, "Got the trace info");
is(@$events, 1, "1 event");
is_deeply($events, [$e], "Hub saw the event");
pop @$events;
$e = $ctx->diag('foo');
is($e->message, 'foo', "got message");
is_deeply($e->trace, $trace, "Got the trace info");
is(@$events, 1, "1 event");
is_deeply($events, [$e], "Hub saw the event");
pop @$events;
$e = $ctx->plan(100);
is($e->max, 100, "got max");
is_deeply($e->trace, $trace, "Got the trace info");
is(@$events, 1, "1 event");
is_deeply($events, [$e], "Hub saw the event");
pop @$events;
$e = $ctx->skip('foo', 'because');
is($e->name, 'foo', "got name");
is($e->reason, 'because', "got reason");
ok($e->pass, "skip events pass by default");
is_deeply($e->trace, $trace, "Got the trace info");
is(@$events, 1, "1 event");
is_deeply($events, [$e], "Hub saw the event");
pop @$events;
$e = $ctx->skip('foo', 'because', pass => 0);
ok(!$e->pass, "can override skip params");
pop @$events;
# Test hooks
my @hooks;
$hub = test2_stack()->top;
my $ref1 = $hub->add_context_init(sub { die "Bad Arg" unless ref($_[0]) eq 'Test2::API::Context'; push @hooks => 'hub_init' });
my $ref2 = $hub->add_context_release(sub { die "Bad Arg" unless ref($_[0]) eq 'Test2::API::Context'; push @hooks => 'hub_release' });
test2_add_callback_context_init(sub { die "Bad Arg" unless ref($_[0]) eq 'Test2::API::Context'; push @hooks => 'global_init' });
test2_add_callback_context_release(sub { die "Bad Arg" unless ref($_[0]) eq 'Test2::API::Context'; push @hooks => 'global_release' });
my $ref3 = $hub->add_context_acquire(sub { die "Bad Arg" unless ref($_[0]) eq 'HASH'; push @hooks => 'hub_acquire' });
test2_add_callback_context_acquire(sub { die "Bad Arg" unless ref($_[0]) eq 'HASH'; push @hooks => 'global_acquire' });
sub {
push @hooks => 'start';
my $ctx = context(on_init => sub { push @hooks => 'ctx_init' }, on_release => sub { push @hooks => 'ctx_release' });
push @hooks => 'deep';
my $ctx2 = sub {
context(on_init => sub { push @hooks => 'ctx_init_deep' }, on_release => sub { push @hooks => 'ctx_release_deep' });
}->();
push @hooks => 'release_deep';
$ctx2->release;
push @hooks => 'release_parent';
$ctx->release;
push @hooks => 'released_all';
push @hooks => 'new';
$ctx = context(on_init => sub { push @hooks => 'ctx_init2' }, on_release => sub { push @hooks => 'ctx_release2' });
push @hooks => 'release_new';
$ctx->release;
push @hooks => 'done';
}->();
$hub->remove_context_init($ref1);
$hub->remove_context_release($ref2);
$hub->remove_context_acquire($ref3);
@{Test2::API::_context_init_callbacks_ref()} = ();
@{Test2::API::_context_release_callbacks_ref()} = ();
@{Test2::API::_context_acquire_callbacks_ref()} = ();
is_deeply(
\@hooks,
[qw{
start
global_acquire
hub_acquire
global_init
hub_init
ctx_init
deep
global_acquire
hub_acquire
release_deep
release_parent
ctx_release_deep
ctx_release
hub_release
global_release
released_all
new
global_acquire
hub_acquire
global_init
hub_init
ctx_init2
release_new
ctx_release2
hub_release
global_release
done
}],
"Got all hook in correct order"
);
{
my $ctx = context(level => -1);
my $one = Test2::API::Context->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__, 'blah']),
hub => test2_stack()->top,
);
is($one->_depth, 0, "default depth");
my $ran = 0;
my $doit = sub {
is_deeply(\@_, [qw/foo bar/], "got args");
$ran++;
die "Make sure old context is restored";
};
eval { $one->do_in_context($doit, 'foo', 'bar') };
my $spawn = context(level => -1, wrapped => -2);
is($spawn->trace, $ctx->trace, "Old context restored");
$spawn->release;
$ctx->release;
ok(!exception { $one->do_in_context(sub {1}) }, "do_in_context works without an original")
}
{
like(exception { Test2::API::Context->new() }, qr/The 'trace' attribute is required/, "need to have trace");
my $trace = Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__, 'foo']);
like(exception { Test2::API::Context->new(trace => $trace) }, qr/The 'hub' attribute is required/, "need to have hub");
my $hub = test2_stack()->top;
my $ctx = Test2::API::Context->new(trace => $trace, hub => $hub);
is($ctx->{_depth}, 0, "depth set to 0 when not defined.");
$ctx = Test2::API::Context->new(trace => $trace, hub => $hub, _depth => 1);
is($ctx->{_depth}, 1, "Do not reset depth");
like(
exception { $ctx->release },
qr/release\(\) should not be called on context that is neither canon nor a child/,
"Non canonical context, do not release"
);
}
sub {
like(
exception { my $ctx = context(level => 20) },
qr/Could not find context at depth 21/,
"Level sanity"
);
ok(
!exception {
my $ctx = context(level => 20, fudge => 1);
$ctx->release;
},
"Was able to get context when fudging level"
);
}->();
sub {
my ($ctx1, $ctx2);
sub { $ctx1 = context() }->();
my @warnings;
{
local $SIG{__WARN__} = sub { push @warnings => @_ };
$ctx2 = context();
$ctx1 = undef;
}
$ctx2->release;
is(@warnings, 1, "1 warning");
like(
$warnings[0],
qr/^context\(\) was called to retrieve an existing context, however the existing/,
"Got expected warning"
);
}->();
sub {
my $ctx = context();
my $e = exception { $ctx->throw('xxx') };
like($e, qr/xxx/, "got exception");
$ctx = context();
my $warnings = warnings { $ctx->alert('xxx') };
like($warnings->[0], qr/xxx/, "got warning");
$ctx->release;
}->();
sub {
my $ctx = context;
is($ctx->_parse_event('Ok'), 'Test2::Event::Ok', "Got the Ok event class");
is($ctx->_parse_event('+Test2::Event::Ok'), 'Test2::Event::Ok', "Got the +Ok event class");
like(
exception { $ctx->_parse_event('+DFASGFSDFGSDGSD') },
qr/Could not load event module 'DFASGFSDFGSDGSD': Can't locate DFASGFSDFGSDGSD\.pm/,
"Bad event type"
);
}->();
{
my ($e1, $e2);
my $events = intercept {
my $ctx = context();
$e1 = $ctx->ok(0, 'foo', ['xxx']);
$e2 = $ctx->ok(0, 'foo');
$ctx->release;
};
ok($e1->isa('Test2::Event::Ok'), "returned ok event");
ok($e2->isa('Test2::Event::Ok'), "returned ok event");
is($events->[0], $e1, "got ok event 1");
is($events->[3], $e2, "got ok event 2");
is($events->[2]->message, 'xxx', "event 1 diag 2");
ok($events->[2]->isa('Test2::Event::Diag'), "event 1 diag 2 is diag");
is($events->[3], $e2, "got ok event 2");
}
sub {
local $! = 100;
local $@ = 'foobarbaz';
local $? = 123;
my $ctx = context();
is($ctx->errno, 100, "saved errno");
is($ctx->eval_error, 'foobarbaz', "saved eval error");
is($ctx->child_error, 123, "saved child exit");
$! = 22;
$@ = 'xyz';
$? = 33;
is(0 + $!, 22, "altered \$! in tool");
is($@, 'xyz', "altered \$@ in tool");
is($?, 33, "altered \$? in tool");
sub {
my $ctx2 = context();
$! = 42;
$@ = 'app';
$? = 43;
is(0 + $!, 42, "altered \$! in tool (nested)");
is($@, 'app', "altered \$@ in tool (nested)");
is($?, 43, "altered \$? in tool (nested)");
$ctx2->release;
is(0 + $!, 22, "restored the nested \$! in tool");
is($@, 'xyz', "restored the nested \$@ in tool");
is($?, 33, "restored the nested \$? in tool");
}->();
sub {
my $ctx2 = context();
$! = 42;
$@ = 'app';
$? = 43;
is(0 + $!, 42, "altered \$! in tool (nested)");
is($@, 'app', "altered \$@ in tool (nested)");
is($?, 43, "altered \$? in tool (nested)");
# Will not warn since $@ is changed
$ctx2 = undef;
is(0 + $!, 42, 'Destroy does not reset $!');
is($@, 'app', 'Destroy does not reset $@');
is($?, 43, 'Destroy does not reset $?');
}->();
$ctx->release;
is($ctx->errno, 100, "restored errno");
is($ctx->eval_error, 'foobarbaz', "restored eval error");
is($ctx->child_error, 123, "restored child exit");
}->();
sub {
local $! = 100;
local $@ = 'foobarbaz';
local $? = 123;
my $ctx = context();
is($ctx->errno, 100, "saved errno");
is($ctx->eval_error, 'foobarbaz', "saved eval error");
is($ctx->child_error, 123, "saved child exit");
$! = 22;
$@ = 'xyz';
$? = 33;
is(0 + $!, 22, "altered \$! in tool");
is($@, 'xyz', "altered \$@ in tool");
is($?, 33, "altered \$? in tool");
# Will not warn since $@ is changed
$ctx = undef;
is(0 + $!, 22, "Destroy does not restore \$!");
is($@, 'xyz', "Destroy does not restore \$@");
is($?, 33, "Destroy does not restore \$?");
}->();
done_testing;
PK 1��\3K+�`9 `9 t/Test2/modules/API/Instance.tnu �[��� use strict;
use warnings;
use Test2::IPC;
use Test2::Tools::Tiny;
use Test2::Util qw/CAN_THREAD CAN_REALLY_FORK USE_THREADS get_tid/;
ok(1, "Just to get things initialized.");
# We need to control this env var for this test
$ENV{T2_NO_IPC} = 0;
# This test relies on TAP being the default formatter for non-canon instances
$ENV{T2_FORMATTER} = 'TAP';
my $CLASS = 'Test2::API::Instance';
my $one = $CLASS->new;
is_deeply(
$one,
{
contexts => {},
finalized => undef,
ipc => undef,
formatter => undef,
add_uuid_via => undef,
ipc_polling => undef,
ipc_drivers => [],
ipc_timeout => 30,
ipc_disabled => 0,
formatters => [],
no_wait => 0,
loaded => 0,
exit_callbacks => [],
post_load_callbacks => [],
context_acquire_callbacks => [],
context_init_callbacks => [],
context_release_callbacks => [],
pre_subtest_callbacks => [],
stack => [],
},
"Got initial settings"
);
%$one = ();
is_deeply($one, {}, "wiped object");
$one->reset;
is_deeply(
$one,
{
contexts => {},
ipc_polling => undef,
ipc_drivers => [],
ipc_timeout => 30,
ipc_disabled => 0,
add_uuid_via => undef,
formatters => [],
finalized => undef,
ipc => undef,
formatter => undef,
no_wait => 0,
loaded => 0,
exit_callbacks => [],
post_load_callbacks => [],
context_acquire_callbacks => [],
context_init_callbacks => [],
context_release_callbacks => [],
pre_subtest_callbacks => [],
stack => [],
},
"Reset Object"
);
ok(!$one->formatter_set, "no formatter set");
$one->set_formatter('Foo');
ok($one->formatter_set, "formatter set");
$one->reset;
my $ran = 0;
my $callback = sub { $ran++ };
$one->add_post_load_callback($callback);
ok(!$ran, "did not run yet");
is_deeply($one->post_load_callbacks, [$callback], "stored callback for later");
ok(!$one->loaded, "not loaded");
$one->load;
ok($one->loaded, "loaded");
is($ran, 1, "ran the callback");
$one->load;
is($ran, 1, "Did not run the callback again");
$one->add_post_load_callback($callback);
is($ran, 2, "ran the new callback");
is_deeply($one->post_load_callbacks, [$callback, $callback], "stored callback for the record");
like(
exception { $one->add_post_load_callback({}) },
qr/Post-load callbacks must be coderefs/,
"Post-load callbacks must be coderefs"
);
$one->reset;
ok($one->ipc, 'got ipc');
ok($one->finalized, "calling ipc finalized the object");
$one->reset;
ok($one->stack, 'got stack');
ok(!$one->finalized, "calling stack did not finaliz the object");
$one->reset;
ok($one->formatter, 'Got formatter');
ok($one->finalized, "calling format finalized the object");
$one->reset;
$one->set_formatter('Foo');
is($one->formatter, 'Foo', "got specified formatter");
ok($one->finalized, "calling format finalized the object");
{
local $ENV{T2_FORMATTER} = 'TAP';
$one->reset;
is($one->formatter, 'Test2::Formatter::TAP', "got specified formatter");
ok($one->finalized, "calling format finalized the object");
local $ENV{T2_FORMATTER} = '+Test2::Formatter::TAP';
$one->reset;
is($one->formatter, 'Test2::Formatter::TAP', "got specified formatter");
ok($one->finalized, "calling format finalized the object");
local $ENV{T2_FORMATTER} = '+A::Fake::Module::That::Should::Not::Exist';
$one->reset;
like(
exception { $one->formatter },
qr/COULD NOT LOAD FORMATTER 'A::Fake::Module::That::Should::Not::Exist' \(set by the 'T2_FORMATTER' environment variable\)/,
"Bad formatter"
);
}
$ran = 0;
$one->reset;
$one->add_exit_callback($callback);
is(@{$one->exit_callbacks}, 1, "added an exit callback");
$one->add_exit_callback($callback);
is(@{$one->exit_callbacks}, 2, "added another exit callback");
like(
exception { $one->add_exit_callback({}) },
qr/End callbacks must be coderefs/,
"Exit callbacks must be coderefs"
);
$one->reset;
$one->add_pre_subtest_callback($callback);
is(@{$one->pre_subtest_callbacks}, 1, "added a pre-subtest callback");
$one->add_pre_subtest_callback($callback);
is(@{$one->pre_subtest_callbacks}, 2, "added another pre-subtest callback");
like(
exception { $one->add_pre_subtest_callback({}) },
qr/Pre-subtest callbacks must be coderefs/,
"Pre-subtest callbacks must be coderefs"
);
if (CAN_REALLY_FORK) {
$one->reset;
my $pid = fork;
die "Failed to fork!" unless defined $pid;
unless($pid) { exit 0 }
is(Test2::API::Instance::_ipc_wait, 0, "No errors");
$pid = fork;
die "Failed to fork!" unless defined $pid;
unless($pid) { exit 255 }
my @warnings;
{
local $SIG{__WARN__} = sub { push @warnings => @_ };
is(Test2::API::Instance::_ipc_wait, 255, "Process exited badly");
}
like($warnings[0], qr/Process .* did not exit cleanly \(wstat: \S+, exit: 255, sig: 0\)/, "Warn about exit");
$pid = fork;
die "Failed to fork!" unless defined $pid;
unless($pid) { sleep 20; exit 0 }
kill('TERM', $pid) or die "Failed to send signal";
@warnings = ();
{
local $SIG{__WARN__} = sub { push @warnings => @_ };
is(Test2::API::Instance::_ipc_wait, 255, "Process exited badly");
}
like($warnings[0], qr/Process .* did not exit cleanly \(wstat: \S+, exit: 0, sig: 15\)/, "Warn about exit");
}
if (CAN_THREAD && $] ge '5.010') {
require threads;
$one->reset;
threads->new(sub { 1 });
is(Test2::API::Instance::_ipc_wait, 0, "No errors");
if (threads->can('error')) {
threads->new(sub {
close(STDERR);
close(STDOUT);
die "xxx"
});
my @warnings;
{
local $SIG{__WARN__} = sub { push @warnings => @_ };
is(Test2::API::Instance::_ipc_wait, 255, "Thread exited badly");
}
like($warnings[0], qr/Thread .* did not end cleanly: xxx/, "Warn about exit");
}
}
{
$one->reset();
local $? = 0;
$one->set_exit;
is($?, 0, "no errors on exit");
}
{
$one->reset();
$one->set__tid(1);
local $? = 0;
$one->set_exit;
is($?, 0, "no errors on exit");
}
{
$one->reset();
$one->stack->top;
$one->no_wait(1);
local $? = 0;
$one->set_exit;
is($?, 0, "no errors on exit");
}
{
$one->reset();
$one->stack->top->set_no_ending(1);
local $? = 0;
$one->set_exit;
is($?, 0, "no errors on exit");
}
{
$one->reset();
$one->load();
$one->stack->top->set_failed(2);
local $? = 0;
$one->set_exit;
is($?, 2, "number of failures");
}
{
$one->reset();
$one->load();
local $? = 500;
$one->set_exit;
is($?, 255, "set exit code to a sane number");
}
{
local %INC = %INC;
delete $INC{'Test2/IPC.pm'};
$one->reset();
$one->load();
my @events;
$one->stack->top->filter(sub { push @events => $_[1]; undef});
$one->stack->new_hub;
local $? = 0;
$one->set_exit;
is($?, 255, "errors on exit");
like($events[0]->message, qr/Test ended with extra hubs on the stack!/, "got diag");
}
SKIP: {
last SKIP if $] lt "5.008";
$one->reset;
my $stderr = "";
{
local $INC{'Test/Builder.pm'} = __FILE__;
local $Test2::API::VERSION = '0.002';
local $Test::Builder::VERSION = '0.001';
local *STDERR;
open(STDERR, '>', \$stderr) or print "Failed to open new STDERR";
$one->set_exit;
}
is($stderr, <<' EOT', "Got warning about version mismatch");
********************************************************************************
* *
* Test::Builder -- Test2::API version mismatch detected *
* *
********************************************************************************
Test2::API Version: 0.002
Test::Builder Version: 0.001
This is not a supported configuration, you will have problems.
EOT
}
SKIP: {
last SKIP if $] lt "5.008";
require Test2::API::Breakage;
no warnings qw/redefine once/;
my $ran = 0;
local *Test2::API::Breakage::report = sub { $ran++; return "foo" };
use warnings qw/redefine once/;
$one->reset();
$one->load();
my $stderr = "";
{
local *STDERR;
open(STDERR, '>', \$stderr) or print "Failed to open new STDERR";
local $? = 255;
$one->set_exit;
}
is($stderr, <<" EOT", "Reported bad modules");
You have loaded versions of test modules known to have problems with Test2.
This could explain some test failures.
foo
EOT
}
{
$one->reset();
$one->load();
my @events;
$one->stack->top->filter(sub { push @events => $_[1]; undef});
$one->stack->new_hub;
ok($one->stack->top->ipc, "Have IPC");
$one->stack->new_hub;
ok($one->stack->top->ipc, "Have IPC");
$one->stack->top->set_ipc(undef);
ok(!$one->stack->top->ipc, "no IPC");
$one->stack->new_hub;
local $? = 0;
$one->set_exit;
is($?, 255, "errors on exit");
like($events[0]->message, qr/Test ended with extra hubs on the stack!/, "got diag");
}
if (CAN_REALLY_FORK) {
local $SIG{__WARN__} = sub { };
$one->reset();
my $pid = fork;
die "Failed to fork!" unless defined $pid;
unless ($pid) { exit 255 }
$one->_finalize;
$one->stack->top;
local $? = 0;
$one->set_exit;
is($?, 255, "errors on exit");
$one->reset();
$pid = fork;
die "Failed to fork!" unless defined $pid;
unless ($pid) { exit 255 }
$one->_finalize;
$one->stack->top;
local $? = 122;
$one->set_exit;
is($?, 122, "kept original exit");
}
{
my $ctx = bless {
trace => Test2::EventFacet::Trace->new(frame => ['Foo::Bar', 'Foo/Bar.pm', 42, 'xxx']),
hub => Test2::Hub->new(),
}, 'Test2::API::Context';
$one->contexts->{1234} = $ctx;
local $? = 500;
my $warnings = warnings { $one->set_exit };
is($?, 255, "set exit code to a sane number");
is_deeply(
$warnings,
[
"context object was never released! This means a testing tool is behaving very badly at Foo/Bar.pm line 42.\n"
],
"Warned about unfreed context"
);
}
{
local %INC = %INC;
delete $INC{'Test2/IPC.pm'};
delete $INC{'threads.pm'};
ok(!USE_THREADS, "Sanity Check");
$one->reset;
ok(!$one->ipc, 'IPC not loaded, no IPC object');
ok($one->finalized, "calling ipc finalized the object");
is($one->ipc_polling, undef, "no polling defined");
ok(!@{$one->ipc_drivers}, "no driver");
if (CAN_THREAD) {
local $INC{'threads.pm'} = 1;
no warnings 'once';
local *threads::tid = sub { 0 } unless threads->can('tid');
$one->reset;
ok($one->ipc, 'IPC loaded if threads are');
ok($one->finalized, "calling ipc finalized the object");
ok($one->ipc_polling, "polling on by default");
is($one->ipc_drivers->[0], 'Test2::IPC::Driver::Files', "default driver");
}
{
local $INC{'Test2/IPC.pm'} = 1;
$one->reset;
ok($one->ipc, 'IPC loaded if Test2::IPC is');
ok($one->finalized, "calling ipc finalized the object");
ok($one->ipc_polling, "polling on by default");
is($one->ipc_drivers->[0], 'Test2::IPC::Driver::Files', "default driver");
}
require Test2::IPC::Driver::Files;
$one->reset;
$one->add_ipc_driver('Test2::IPC::Driver::Files');
ok($one->ipc, 'IPC loaded if drivers have been added');
ok($one->finalized, "calling ipc finalized the object");
ok($one->ipc_polling, "polling on by default");
my $file = __FILE__;
my $line = __LINE__ + 1;
my $warnings = warnings { $one->add_ipc_driver('Test2::IPC::Driver::Files') };
like(
$warnings->[0],
qr{^IPC driver Test2::IPC::Driver::Files loaded too late to be used as the global ipc driver at \Q$file\E line $line},
"Got warning at correct frame"
);
$one->reset;
$one->add_ipc_driver('Fake::Fake::XXX');
is(
exception { $one->ipc },
"IPC has been requested, but no viable drivers were found. Aborting...\n",
"Failed without viable IPC driver"
);
}
{
$one->reset;
ok(!@{$one->context_init_callbacks}, "no callbacks");
is($one->ipc_polling, undef, "no polling, undef");
$one->disable_ipc_polling;
ok(!@{$one->context_init_callbacks}, "no callbacks");
is($one->ipc_polling, undef, "no polling, still undef");
my $cull = 0;
no warnings 'once';
local *Fake::Hub::cull = sub { $cull++ };
use warnings;
$one->enable_ipc_polling;
ok(defined($one->{_pid}), "pid is defined");
ok(defined($one->{_tid}), "tid is defined");
is(@{$one->context_init_callbacks}, 1, "added the callback");
is($one->ipc_polling, 1, "polling on");
$one->set_ipc_shm_last('abc1');
$one->context_init_callbacks->[0]->({'hub' => 'Fake::Hub'});
is($cull, 1, "called cull once");
$cull = 0;
$one->disable_ipc_polling;
is(@{$one->context_init_callbacks}, 1, "kept the callback");
is($one->ipc_polling, 0, "no polling, set to 0");
$one->set_ipc_shm_last('abc3');
$one->context_init_callbacks->[0]->({'hub' => 'Fake::Hub'});
is($cull, 0, "did not call cull");
$cull = 0;
$one->enable_ipc_polling;
is(@{$one->context_init_callbacks}, 1, "did not add the callback");
is($one->ipc_polling, 1, "polling on");
$one->set_ipc_shm_last('abc3');
$one->context_init_callbacks->[0]->({'hub' => 'Fake::Hub'});
is($cull, 1, "called cull once");
}
{
require Test2::IPC::Driver::Files;
local $ENV{T2_NO_IPC} = 1;
$one->reset;
$one->add_ipc_driver('Test2::IPC::Driver::Files');
ok($one->ipc_disabled, "IPC is disabled by env var");
ok(!$one->ipc, 'IPC not loaded');
local $ENV{T2_NO_IPC} = 0;
$one->reset;
ok(!$one->ipc_disabled, "IPC is not disabled by env var");
ok($one->ipc, 'IPC loaded');
like(
exception { $one->ipc_disable },
qr/Attempt to disable IPC after it has been initialized/,
"Cannot diable IPC once it is initialized"
);
$one->reset;
ok(!$one->ipc_disabled, "IPC is not disabled by env var");
$one->ipc_disable;
ok($one->ipc_disabled, "IPC is disabled directly");
}
done_testing;
PK 1��\ܻ��A A t/Test2/modules/API/Stack.tnu �[��� use strict;
use warnings;
use Test2::IPC;
use Test2::Tools::Tiny;
use Test2::API::Stack;
use Test2::API qw/test2_ipc/;
ok(my $stack = Test2::API::Stack->new, "Create a stack");
ok(!@$stack, "Empty stack");
ok(!$stack->peek, "Nothing to peek at");
ok(!exception { $stack->cull }, "cull lives when stack is empty");
ok(!exception { $stack->all }, "all lives when stack is empty");
ok(!exception { $stack->clear }, "clear lives when stack is empty");
like(
exception { $stack->pop(Test2::Hub->new) },
qr/No hubs on the stack/,
"No hub to pop"
);
my $hub = Test2::Hub->new;
ok($stack->push($hub), "pushed a hub");
like(
exception { $stack->pop($hub) },
qr/You cannot pop the root hub/,
"Root hub cannot be popped"
);
$stack->push($hub);
like(
exception { $stack->pop(Test2::Hub->new) },
qr/Hub stack mismatch, attempted to pop incorrect hub/,
"Must specify correct hub to pop"
);
is_deeply(
[ $stack->all ],
[ $hub, $hub ],
"Got all hubs"
);
ok(!exception { $stack->pop($hub) }, "Popped the correct hub");
is_deeply(
[ $stack->all ],
[ $hub ],
"Got all hubs"
);
is($stack->peek, $hub, "got the hub");
is($stack->top, $hub, "got the hub");
$stack->clear;
is_deeply(
[ $stack->all ],
[ ],
"no hubs"
);
ok(my $top = $stack->top, "Generated a top hub");
is($top->ipc, test2_ipc, "Used sync's ipc");
ok($top->format, 'Got formatter');
is($stack->top, $stack->top, "do not generate a new top if there is already a top");
ok(my $new = $stack->new_hub(), "Add a new hub");
is($stack->top, $new, "new one is on top");
is($new->ipc, $top->ipc, "inherited ipc");
is($new->format, $top->format, "inherited formatter");
my $new2 = $stack->new_hub(formatter => undef, ipc => undef);
ok(!$new2->ipc, "built with no ipc");
ok(!$new2->format, "built with no formatter");
done_testing;
PK 1��\Y��q q # t/Test2/modules/Event/TAP/Version.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use ok 'Test2::Event::TAP::Version';
my $CLASS = 'Test2::Event::TAP::Version';
like(
exception { $CLASS->new() },
qr/'version' is a required attribute/,
"Must specify the version"
);
my $one = $CLASS->new(version => 13);
is($one->version, 13, "Got version");
is($one->summary, "TAP version 13", "Got summary");
is_deeply(
$one->facet_data,
{
about => { package => $CLASS, details => "TAP version 13", eid => $one->eid},
info => [{tag => 'INFO', debug => 0, details => "TAP version 13"}],
},
"Got facet data"
);
done_testing;
PK 1��\�B�� � t/Test2/modules/Event/Bail.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::Event::Bail;
use Test2::EventFacet::Trace;
my $bail = Test2::Event::Bail->new(
trace => Test2::EventFacet::Trace->new(frame => ['foo', 'foo.t', 42]),
reason => 'evil',
);
ok($bail->causes_fail, "bailout always causes fail.");
is($bail->terminate, 255, "Bail will cause the test to exit.");
is($bail->global, 1, "Bail is global, everything should bail");
is($bail->summary, "Bail out! evil", "Summary includes reason");
$bail->set_reason("");
is($bail->summary, "Bail out!", "Summary has no reason");
ok($bail->diagnostics, "Bail events are counted as diagnostics");
is_deeply(
$bail->facet_data,
{
about => {
package => 'Test2::Event::Bail',
eid => $bail->eid,
},
control => {
global => 1,
terminate => 255,
details => '',
halt => 1
},
trace => {
frame => [
'foo',
'foo.t',
'42',
],
pid => $$,
tid => 0
},
},
"Got facet data",
);
$bail->set_reason('uhg');
is_deeply(
$bail->facet_data,
{
about => {
package => 'Test2::Event::Bail',
eid => $bail->eid,
},
control => {
global => 1,
terminate => 255,
details => 'uhg',
halt => 1
},
trace => {
frame => [
'foo',
'foo.t',
'42',
],
pid => $$,
tid => 0
},
},
"Got facet data with reason",
);
done_testing;
PK 1��\��e~3 3 t/Test2/modules/Event/Diag.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::Event::Diag;
use Test2::EventFacet::Trace;
my $diag = Test2::Event::Diag->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
message => 'foo',
);
is($diag->summary, 'foo', "summary is just message");
$diag = Test2::Event::Diag->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
message => undef,
);
is($diag->message, 'undef', "set undef message to undef");
is($diag->summary, 'undef', "summary is just message even when undef");
$diag = Test2::Event::Diag->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
message => {},
);
like($diag->message, qr/^HASH\(.*\)$/, "stringified the input value");
ok($diag->diagnostics, "Diag events are counted as diagnostics");
$diag = Test2::Event::Diag->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
message => "Hi there",
);
my $facet_data = $diag->facet_data;
ok($facet_data->{about}, "Got 'about' from common");
ok($facet_data->{trace}, "Got 'trace' from common");
is_deeply(
$facet_data->{info},
[{
tag => 'DIAG',
debug => 1,
details => 'Hi there',
}],
"Got info facet"
);
done_testing;
PK 1��\��t� � t/Test2/modules/Event/Encoding.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use ok 'Test2::Event::Encoding';
my $CLASS = 'Test2::Event::Encoding';
like(
exception { $CLASS->new() },
qr/'encoding' is a required attribute/,
"Must specify the encoding"
);
my $one = $CLASS->new(encoding => 'utf8');
is($one->encoding, 'utf8', "Got encoding");
is($one->summary, "Encoding set to utf8", "Got summary");
is_deeply(
$one->facet_data,
{
about => {
package => $CLASS,
details => "Encoding set to utf8",
eid => $one->eid,
},
control => { encoding => 'utf8' },
},
"Got facet data"
);
done_testing;
PK 1��\4k��� � ! t/Test2/modules/Event/Exception.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::Event::Exception;
my $exception = Test2::Event::Exception->new(
trace => {frame => []},
error => "evil at lake_of_fire.t line 6\n",
);
ok($exception->causes_fail, "Exception events always cause failure");
is($exception->summary, "Exception: evil at lake_of_fire.t line 6", "Got summary");
ok($exception->diagnostics, "Exception events are counted as diagnostics");
my $facet_data = $exception->facet_data;
ok($facet_data->{about}, "Got common facet data");
is_deeply(
$facet_data->{errors},
[{
tag => 'ERROR',
fail => 1,
details => "evil at lake_of_fire.t line 6\n",
}],
"Got error facet",
);
my $hash = {an => 'error'};
my $str = "$hash";
$exception = Test2::Event::Exception->new(
trace => {frame => []},
error => $hash,
);
ok($exception->causes_fail, "Exception events always cause failure");
is($exception->error, $str, "Got stringified exception");
$facet_data = $exception->facet_data;
ok($facet_data->{about}, "Got common facet data");
is_deeply(
$facet_data->{errors},
[{
tag => 'ERROR',
fail => 1,
details => $str,
}],
"Got error facet",
);
done_testing;
PK 1��\k��� � t/Test2/modules/Event/Fail.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::API qw/intercept context/;
use ok 'Test2::Event::Fail';
my $CLASS = 'Test2::Event::Fail';
my $one = $CLASS->new(name => 'no soup for you');
is($one->summary, "fail", 'summary');
is($one->increments_count, 1, 'increments_count');
is($one->diagnostics, 0, 'diagnostics');
is($one->no_display, 0, 'no_display');
is($one->subtest_id, undef, 'subtest_id');
is($one->terminate, undef, 'terminate');
is($one->global, undef, 'global');
is($one->sets_plan, undef, 'sets_plan');
is($one->causes_fail, 1, 'causes_fail');
$one->add_amnesty({tag => 'blah', details => 'blah'});
is($one->causes_fail, 0, 'causes_fail is off with amnesty');
$one->add_info({tag => 'xxx', details => 'yyy'});
is_deeply(
$one->facet_data,
{
about => {package => $CLASS, details => 'fail', eid => $one->eid},
assert => {pass => 0, details => 'no soup for you'},
amnesty => [{tag => 'blah', details => 'blah'}],
info => [{tag => 'xxx', details => 'yyy'}],
},
"Got facet data"
);
done_testing;
PK 1��\N��U� � t/Test2/modules/Event/Generic.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::EventFacet::Trace;
use Test2::API qw/context intercept/;
sub tool {
my $ctx = context();
my $e = $ctx->send_event('Generic', @_);
$ctx->release;
return $e;
}
my $e;
intercept { $e = tool() };
ok($e, "got event");
ok($e->isa('Test2::Event'), "It is an event");
ok($e->isa('Test2::Event::Generic'), "It is an event");
delete $e->{trace};
is_deeply(
$e,
{
causes_fail => 0,
increments_count => 0,
diagnostics => 0,
no_display => 0,
_eid => $e->eid,
hubs => [
{
'buffered' => 0,
'details' => 'Test2::Hub::Interceptor',
'hid' => $e->hubs->[0]->{hid},
'ipc' => 0,
'nested' => 0,
'pid' => $$,
'tid' => 0,
$e->hubs->[0]->{uuid} ? (uuid => $e->hubs->[0]->{uuid}) : (uuid => undef),
}
],
$e->uuid ? (uuid => $e->uuid) : (),
},
"Defaults"
);
for my $f (qw/causes_fail increments_count diagnostics no_display/) {
is($e->$f, 0, "'$f' is 0");
is_deeply([$e->$f], [0], "'$f' is 0 is list context as well");
my $set = "set_$f";
$e->$set(1);
is($e->$f, 1, "'$f' was set to 1");
}
for my $f (qw/callback terminate global sets_plan/) {
is($e->$f, undef, "no $f");
is_deeply([$e->$f], [], "$f is empty in list context");
}
like($e->summary, qr/Test2::Event::Generic/, "Got base class summary");
like(
exception { $e->set_sets_plan('bad') },
qr/'sets_plan' must be an array reference/,
"Must provide an arrayref"
);
$e->set_sets_plan([0, skip => 'cause']);
is_deeply([$e->sets_plan], [0, skip => 'cause'], "sets_plan returns a list, not a ref");
$e->set_sets_plan(undef);
ok(!exists $e->{sets_plan}, "Removed sets_plan key");
ok(!$e->sets_plan, "sets_plan is cleared");
$e->set_global(0);
is($e->global, 0, "global is off");
$e->set_global(1);
is($e->global, 1, "global is on");
$e->set_global(0);
is($e->global, 0, "global is again");
$e->set_global(undef);
ok(!exists $e->{global}, "removed global key");
is($e->global, undef, "global is not defined");
like(
exception { $e->set_callback('dogfood') },
qr/callback must be a code reference/,
"Callback must be code"
);
my $ran = 0;
$e->set_callback(sub {
$ran++;
my $self = shift;
is($self, $e, "got self");
is_deeply( \@_, ['a', 'b', 'c'], "Got args" );
return 'foo';
});
is($e->callback('a', 'b', 'c'), 'foo', "got callback's return");
ok($ran, "ran callback");
$e->set_callback(undef);
ok(!$e->callback, "no callback");
ok(!exists $e->{callback}, "no callback key");
like(
exception { $e->set_terminate('1.1') },
qr/terminate must be a positive integer/,
"terminate only takes integers"
);
like(
exception { $e->set_terminate('foo') },
qr/terminate must be a positive integer/,
"terminate only takes numbers"
);
like(
exception { $e->set_terminate('-1') },
qr/terminate must be a positive integer/,
"terminate only takes positive integers"
);
$e->set_terminate(0),
is($e->terminate, 0, "set to 0, 0 is valid");
$e->set_terminate(1),
is($e->terminate, 1, "set to 1");
$e->set_terminate(123),
is($e->terminate, 123, "set to 123");
$e->set_terminate(0),
is($e->terminate, 0, "set to 0, 0 is valid");
$e->set_terminate(undef);
is($e->terminate, undef, "terminate is not defined");
ok(!exists $e->{terminate}, "no terminate key");
# Test constructor args
intercept { $e = tool(causes_fail => 1, increments_count => 'a') };
is($e->causes_fail, 1, "attr from constructor");
is($e->increments_count, 'a', "attr from constructor");
done_testing;
PK 1��\�J4�� � t/Test2/modules/Event/Note.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::Event::Note;
use Test2::EventFacet::Trace;
my $note = Test2::Event::Note->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
message => 'foo',
);
is($note->summary, 'foo', "summary is just message");
$note = Test2::Event::Note->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
message => undef,
);
is($note->message, 'undef', "set undef message to undef");
is($note->summary, 'undef', "summary is just message even when undef");
$note = Test2::Event::Note->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
message => {},
);
like($note->message, qr/^HASH\(.*\)$/, "stringified the input value");
$note = Test2::Event::Note->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
message => 'Hi there',
);
my $facet_data = $note->facet_data;
ok($facet_data->{about}, "Got 'about' from common");
ok($facet_data->{trace}, "Got 'trace' from common");
is_deeply(
$facet_data->{info},
[{
tag => 'NOTE',
debug => 0,
details => 'Hi there',
}],
"Got info facet"
);
done_testing;
PK 1��\iT��] ] t/Test2/modules/Event/Ok.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::EventFacet::Trace;
use Test2::Event::Ok;
use Test2::Event::Diag;
use Test2::API qw/context/;
my $trace;
sub before_each {
# Make sure there is a fresh trace object for each group
$trace = Test2::EventFacet::Trace->new(
frame => ['main_foo', 'foo.t', 42, 'main_foo::flubnarb'],
);
}
tests Passing => sub {
my $ok = Test2::Event::Ok->new(
trace => $trace,
pass => 1,
name => 'the_test',
);
ok($ok->increments_count, "Bumps the count");
ok(!$ok->causes_fail, "Passing 'OK' event does not cause failure");
is($ok->pass, 1, "got pass");
is($ok->name, 'the_test', "got name");
is($ok->effective_pass, 1, "effective pass");
is($ok->summary, "the_test", "Summary is just the name of the test");
my $facet_data = $ok->facet_data;
ok($facet_data->{about}, "got common facet data");
ok(!$facet_data->{amnesty}, "No amnesty by default");
is_deeply(
$facet_data->{assert},
{
no_debug => 1,
pass => 1,
details => 'the_test',
},
"Got assert facet",
);
$ok = Test2::Event::Ok->new(
trace => $trace,
pass => 1,
name => '',
);
is($ok->summary, "Nameless Assertion", "Nameless test");
$facet_data = $ok->facet_data;
ok($facet_data->{about}, "got common facet data");
ok(!$facet_data->{amnesty}, "No amnesty by default");
is_deeply(
$facet_data->{assert},
{
no_debug => 1,
pass => 1,
details => '',
},
"Got assert facet",
);
};
tests Failing => sub {
local $ENV{HARNESS_ACTIVE} = 1;
local $ENV{HARNESS_IS_VERBOSE} = 1;
my $ok = Test2::Event::Ok->new(
trace => $trace,
pass => 0,
name => 'the_test',
);
ok($ok->increments_count, "Bumps the count");
ok($ok->causes_fail, "A failing test causes failures");
is($ok->pass, 0, "got pass");
is($ok->name, 'the_test', "got name");
is($ok->effective_pass, 0, "effective pass");
is($ok->summary, "the_test", "Summary is just the name of the test");
my $facet_data = $ok->facet_data;
ok($facet_data->{about}, "got common facet data");
ok(!$facet_data->{amnesty}, "No amnesty by default");
is_deeply(
$facet_data->{assert},
{
no_debug => 1,
pass => 0,
details => 'the_test',
},
"Got assert facet",
);
};
tests "Failing TODO" => sub {
local $ENV{HARNESS_ACTIVE} = 1;
local $ENV{HARNESS_IS_VERBOSE} = 1;
my $ok = Test2::Event::Ok->new(
trace => $trace,
pass => 0,
name => 'the_test',
todo => 'A Todo',
);
ok($ok->increments_count, "Bumps the count");
is($ok->pass, 0, "got pass");
is($ok->name, 'the_test', "got name");
is($ok->effective_pass, 1, "effective pass is true from todo");
is($ok->summary, "the_test (TODO: A Todo)", "Summary is just the name of the test + todo");
my $facet_data = $ok->facet_data;
ok($facet_data->{about}, "got common facet data");
is_deeply(
$facet_data->{assert},
{
no_debug => 1,
pass => 0,
details => 'the_test',
},
"Got assert facet",
);
is_deeply(
$facet_data->{amnesty},
[{
tag => 'TODO',
details => 'A Todo',
}],
"Got amnesty facet",
);
$ok = Test2::Event::Ok->new(
trace => $trace,
pass => 0,
name => 'the_test2',
todo => '',
);
ok($ok->effective_pass, "empty string todo is still a todo");
is($ok->summary, "the_test2 (TODO)", "Summary is just the name of the test + todo");
$facet_data = $ok->facet_data;
ok($facet_data->{about}, "got common facet data");
is_deeply(
$facet_data->{assert},
{
no_debug => 1,
pass => 0,
details => 'the_test2',
},
"Got assert facet",
);
is_deeply(
$facet_data->{amnesty},
[{
tag => 'TODO',
details => '',
}],
"Got amnesty facet",
);
};
tests init => sub {
my $ok = Test2::Event::Ok->new(
trace => $trace,
pass => 1,
);
is($ok->effective_pass, 1, "set effective pass");
};
done_testing;
PK 1��\$�)�� � t/Test2/modules/Event/Pass.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::API qw/intercept context/;
use ok 'Test2::Event::Pass';
my $CLASS = 'Test2::Event::Pass';
my $one = $CLASS->new(name => 'soup for you', trace => {frame => ['foo', 'foo.pl', 42]});
is($one->summary, "pass", 'summary');
is($one->increments_count, 1, 'increments_count');
is($one->diagnostics, 0, 'diagnostics');
is($one->no_display, 0, 'no_display');
is($one->subtest_id, undef, 'subtest_id');
is($one->terminate, undef, 'terminate');
is($one->global, undef, 'global');
is($one->sets_plan, undef, 'sets_plan');
is($one->causes_fail, 0, 'causes_fail is false');
$one->add_amnesty({tag => 'blah', details => 'blah'});
$one->add_info({tag => 'xxx', details => 'yyy'});
is_deeply(
$one->facet_data,
{
trace => {frame => ['foo', 'foo.pl', 42]},
about => {package => $CLASS, details => 'pass', eid => $one->eid},
assert => {pass => 1, details => 'soup for you'},
amnesty => [{tag => 'blah', details => 'blah'}],
info => [{tag => 'xxx', details => 'yyy'}],
},
"Got facet data"
);
done_testing;
PK 1��\��
hV V t/Test2/modules/Event/Plan.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::Event::Plan;
use Test2::EventFacet::Trace;
my $plan = Test2::Event::Plan->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
max => 100,
);
is($plan->summary, "Plan is 100 assertions", "simple summary");
is_deeply( [$plan->sets_plan], [100, '', undef], "Got plan details");
ok(!$plan->global, "regular plan is not a global event");
is($plan->terminate, undef, "No terminate for normal plan");
$plan->set_max(0);
$plan->set_directive('SKIP');
$plan->set_reason('foo');
is($plan->terminate, 0, "Terminate 0 on skip_all");
is($plan->summary, "Plan is 'SKIP', foo", "skip summary");
is_deeply( [$plan->sets_plan], [0, 'SKIP', 'foo'], "Got skip details");
$plan->set_max(0);
$plan->set_directive('NO PLAN');
$plan->set_reason(undef);
is($plan->summary, "Plan is 'NO PLAN'", "NO PLAN summary");
is_deeply( [$plan->sets_plan], [0, 'NO PLAN', undef], "Got 'NO PLAN' details");
is($plan->terminate, undef, "No terminate for no_plan");
$plan->set_max(100);
$plan->set_directive(undef);
$plan = Test2::Event::Plan->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
max => 0,
directive => 'skip_all',
);
is($plan->directive, 'SKIP', "Change skip_all to SKIP");
$plan = Test2::Event::Plan->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
max => 0,
directive => 'no_plan',
);
is($plan->directive, 'NO PLAN', "Change no_plan to 'NO PLAN'");
ok(!$plan->global, "NO PLAN is not global");
like(
exception {
$plan = Test2::Event::Plan->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
max => 0,
directive => 'foo',
);
},
qr/'foo' is not a valid plan directive/,
"Invalid Directive"
);
like(
exception {
$plan = Test2::Event::Plan->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
max => 0,
reason => 'foo',
);
},
qr/Cannot have a reason without a directive!/,
"Reason without directive"
);
like(
exception {
$plan = Test2::Event::Plan->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
);
},
qr/No number of tests specified/,
"Nothing to do"
);
like(
exception {
$plan = Test2::Event::Plan->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
max => 'skip',
);
},
qr/Plan test count 'skip' does not appear to be a valid positive integer/,
"Max must be an integer"
);
$plan = Test2::Event::Plan->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
max => 100,
);
my $facet_data = $plan->facet_data;
ok($facet_data->{about}, "Got common facet data");
is($facet_data->{control}->{terminate}, undef, "no termination defined");
is_deeply(
$facet_data->{plan},
{count => 100},
"Set the count"
);
$plan = Test2::Event::Plan->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
max => 0,
directive => 'NO PLAN',
);
$facet_data = $plan->facet_data;
ok($facet_data->{about}, "Got common facet data");
is($facet_data->{control}->{terminate}, undef, "no termination defined");
is_deeply(
$facet_data->{plan},
{count => 0, none => 1},
"No plan"
);
$plan = Test2::Event::Plan->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
max => 0,
directive => 'SKIP',
);
$facet_data = $plan->facet_data;
ok($facet_data->{about}, "Got common facet data");
is($facet_data->{control}->{terminate}, 0, "terminate with 0");
is_deeply(
$facet_data->{plan},
{count => 0, skip => 1},
"Skip, no reason"
);
$plan = Test2::Event::Plan->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
max => 0,
directive => 'SKIP',
reason => 'because',
);
$facet_data = $plan->facet_data;
ok($facet_data->{about}, "Got common facet data");
is($facet_data->{control}->{terminate}, 0, "terminate with 0");
is_deeply(
$facet_data->{plan},
{count => 0, skip => 1, details => 'because'},
"Skip, no reason"
);
done_testing;
PK 1��\���;� � t/Test2/modules/Event/Skip.tnu �[��� use Test2::Tools::Tiny;
use strict;
use warnings;
use Test2::Event::Skip;
use Test2::EventFacet::Trace;
my $skip = Test2::Event::Skip->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__]),
name => 'skip me',
reason => 'foo',
);
my $facet_data = $skip->facet_data;
ok($facet_data->{about}, "Got basic data");
is_deeply(
$facet_data->{amnesty},
[
{
tag => 'skip',
details => 'foo',
inherited => 0,
}
],
"Added some amnesty for the skip",
);
is($skip->name, 'skip me', "set name");
is($skip->reason, 'foo', "got skip reason");
ok(!$skip->pass, "no default for pass");
ok($skip->effective_pass, "TODO always effectively passes");
is($skip->summary, "skip me (SKIP: foo)", "summary with reason");
$skip->set_reason('');
is($skip->summary, "skip me (SKIP)", "summary without reason");
done_testing;
PK 1��\��SH� � t/Test2/modules/Event/Subtest.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::Event::Subtest;
my $st = 'Test2::Event::Subtest';
my $trace = Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__, 'xxx']);
my $one = $st->new(
trace => $trace,
pass => 1,
buffered => 1,
name => 'foo',
subtest_id => "1-1-1",
);
ok($one->isa('Test2::Event::Ok'), "Inherit from Ok");
is_deeply($one->subevents, [], "subevents is an arrayref");
is($one->summary, "foo", "simple summary");
$one->set_todo('');
is($one->summary, "foo (TODO)", "simple summary + TODO");
$one->set_todo('foo');
is($one->summary, "foo (TODO: foo)", "simple summary + TODO + Reason");
$one->set_todo(undef);
$one->set_name('');
is($one->summary, "Nameless Subtest", "unnamed summary");
require Test2::Event::Pass;
push @{$one->subevents} => Test2::Event::Pass->new(name => 'xxx');
my $facet_data = $one->facet_data;
ok($facet_data->{about}, "got parent facet data");
is_deeply(
$facet_data->{parent},
{
hid => "1-1-1",
buffered => 1,
children => [
{
about => {
details => 'pass',
package => 'Test2::Event::Pass',
eid => $one->subevents->[0]->eid,
},
assert => {
details => 'xxx',
pass => 1
},
}
],
},
"Got facet data"
);
done_testing;
PK 1��\Upg+
t/Test2/modules/Event/V2.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::API qw/context intercept/;
use Test2::Event::V2();
my $CLASS = 'Test2::Event::V2';
ok($CLASS->isa('Test2::Event'), "Subclass of Test2::Event");
is_deeply(
[Test2::Event::V2->non_facet_keys],
['uuid', '_meta'],
"Got non-facet keys"
);
ok($CLASS->can($_), "has method $_") for qw{
causes_fail diagnostics global increments_count no_display sets_plan
subtest_id summary terminate
uuid set_uuid
meta
facet_data
about
};
ok(!exception { $CLASS->new(uuid => 2, about => {uuid => 2}) }, "Can have matching uuids");
like(
exception { $CLASS->new(uuid => 1, about => {uuid => 2}) },
qr/uuid '1' passed to constructor, but uuid '2' is already set in the 'about' facet/,
"Cannot have a uuid mismatch"
);
my $one = $CLASS->new(uuid => 123);
is($one->about->{uuid}, 123, "Set uuid in about facet");
$one = $CLASS->new(about => { uuid => 123 });
is($one->uuid, 123, "set uuid attribute");
my $trace = {frame => ['main', 'file.t', 42, 'foo'], tid => 0, pid => $$};
$one = $CLASS->new(trace => $trace);
ok($trace != $one->trace, "Did not keep or modify the original trace ref");
ok($one->trace->isa('Test2::EventFacet::Trace'), "Blessed the trace");
is_deeply($one->trace, $trace, "Trace has all data");
$one = $CLASS->new;
ok(!$one->uuid, "no uuid attribute");
ok(!$one->about->{uuid}, "no uuid in about facet");
$one->set_uuid(123);
is($one->about->{uuid}, 123, "Set uuid in about facet");
is($one->uuid, 123, "set uuid attribute");
$one = $CLASS->new(
uuid => '123',
trace => $trace,
assert => {pass => 1, details => 'pass'},
info => [{tag => 'NOTE', details => 'a note'}],
);
$one->set_meta('foo' => {'xyz' => 1});
$one->{_custom_sttr} = 'xxx';
is_deeply(
$one->facet_data,
{
trace => $trace,
assert => {pass => 1, details => 'pass'},
info => [{tag => 'NOTE', details => 'a note'}],
meta => {foo => {'xyz' => 1}},
about => {uuid => 123},
},
"Facet data has everything we want, and nothing we do not"
);
sub my_tool {
my $ctx = context();
my $event = $ctx->send_ev2(info => [{tag => 'NOTE', details => "This is a note"}]);
$ctx->release;
return $event;
}
my $events = intercept {
my_tool();
};
is(@$events, 1, "Got 1 event");
ok($events->[0]->isa($CLASS), "Created the right type of event");
is_deeply(
$events->[0]->facet_data->{info},
[{tag => 'NOTE', details => "This is a note"}],
"Got the specified info facet"
);
done_testing;
PK 1��\y_�Kv v t/Test2/modules/Event/Waiting.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::Event::Waiting;
my $waiting = Test2::Event::Waiting->new(
trace => {},
);
ok($waiting, "Created event");
ok($waiting->global, "waiting is global");
is($waiting->summary, "IPC is waiting for children to finish...", "Got summary");
my $facet_data = $waiting->facet_data;
ok($facet_data->{about}, "Got common facet data");
is_deeply(
$facet_data->{info},
[
{
tag => 'INFO',
debug => 0,
details => "IPC is waiting for children to finish...",
},
],
"Got added info facet"
);
done_testing;
PK 1��\�qM2 " t/Test2/modules/EventFacet/About.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use ok 'Test2::EventFacet::About';
my $CLASS = 'Test2::EventFacet::About';
my $one = $CLASS->new(details => 'foo', package => 'bar', no_display => 0);
is($one->details, "foo", "Got details");
is($one->package, "bar", "Got package");
is($one->no_display, 0, "Got no_display value");
is_deeply($one->clone, $one, "Cloning.");
isnt($one->clone, $one, "Clone is a new ref");
ok(!$CLASS->is_list, "Not a list");
is($CLASS->facet_key, 'about', "Got key");
done_testing;
PK 1��\�ѷ� $ t/Test2/modules/EventFacet/Amnesty.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use ok 'Test2::EventFacet::Amnesty';
my $CLASS = 'Test2::EventFacet::Amnesty';
my $one = $CLASS->new(details => 'foo', tag => 'bar', inherited => 0);
is($one->details, "foo", "Got details");
is($one->tag, "bar", "Got tag");
is($one->inherited, 0, "Got 'inherited' value");
is_deeply($one->clone, $one, "Cloning.");
isnt($one->clone, $one, "Clone is a new ref");
ok($CLASS->is_list, "is a list");
is($CLASS->facet_key, 'amnesty', "Got key");
done_testing;
PK 1��\���5 # t/Test2/modules/EventFacet/Assert.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use ok 'Test2::EventFacet::Assert';
my $CLASS = 'Test2::EventFacet::Assert';
my $one = $CLASS->new(details => 'foo', pass => 1, no_debug => 1);
is($one->details, "foo", "Got details");
is($one->pass, 1, "Got 'pass' value");
is($one->no_debug, 1, "Got 'no_debug' value");
is_deeply($one->clone, $one, "Cloning.");
isnt($one->clone, $one, "Clone is a new ref");
ok(!$CLASS->is_list, "is not a list");
is($CLASS->facet_key, 'assert', "Got key");
done_testing;
PK 1��\Ӫ :� � $ t/Test2/modules/EventFacet/Control.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use ok 'Test2::EventFacet::Control';
my $CLASS = 'Test2::EventFacet::Control';
my $one = $CLASS->new(details => 'foo', global => 0, terminate => undef, halt => 0, has_callback => 1, encoding => 'utf8');
is($one->details, "foo", "Got details");
is($one->global, 0, "Got 'global' value");
is($one->terminate, undef, "Got 'terminate' value");
is($one->halt, 0, "Got 'halt' value");
is($one->has_callback, 1, "Got 'has_callback' value");
is($one->encoding, 'utf8', "Got 'utf8' value");
is_deeply($one->clone, $one, "Cloning.");
isnt($one->clone, $one, "Clone is a new ref");
ok(!$CLASS->is_list, "is not a list");
is($CLASS->facet_key, 'control', "Got key");
done_testing;
PK 1��\i�y� � " t/Test2/modules/EventFacet/Error.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use ok 'Test2::EventFacet::Error';
my $CLASS = 'Test2::EventFacet::Error';
my $one = $CLASS->new(details => 'foo', tag => 'uhg', fail => 1);
is($one->details, "foo", "Got details");
is($one->tag, 'uhg', "Got 'tag' value");
is($one->fail, 1, "Got 'fail' value");
is_deeply($one->clone, $one, "Cloning.");
isnt($one->clone, $one, "Clone is a new ref");
ok($CLASS->is_list, "is a list");
is($CLASS->facet_key, 'errors', "Got key");
done_testing;
PK 1��\���� � ! t/Test2/modules/EventFacet/Info.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use ok 'Test2::EventFacet::Info';
my $CLASS = 'Test2::EventFacet::Info';
my $one = $CLASS->new(details => 'foo', tag => 'bar', debug => 0);
is($one->details, "foo", "Got details");
is($one->tag, "bar", "Got tag");
is($one->debug, 0, "Got 'debug' value");
is_deeply($one->clone, $one, "Cloning.");
isnt($one->clone, $one, "Clone is a new ref");
ok($CLASS->is_list, "is a list");
is($CLASS->facet_key, 'info', "Got key");
done_testing;
PK 1��\
q�c� � ! t/Test2/modules/EventFacet/Meta.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use ok 'Test2::EventFacet::Meta';
my $CLASS = 'Test2::EventFacet::Meta';
my $one = $CLASS->new(details => 'foo', a => 1, b => 'bar', x => undef, set_details => 'xxx');
is($one->details, "foo", "Got details");
is($one->set_details, "xxx", "set_details is a regular field, not a writer");
is($one->a, 1, "Got 'a'");
is($one->b, 'bar', "Got 'b'");
is($one->x, undef, "Got 'x'");
is($one->blah, undef, "Vivified 'blah'");
is_deeply($one->clone, $one, "Cloning.");
isnt($one->clone, $one, "Clone is a new ref");
ok(!$CLASS->is_list, "is not a list");
is($CLASS->facet_key, 'meta', "Got key");
done_testing;
PK 1��\X_��N N # t/Test2/modules/EventFacet/Parent.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use ok 'Test2::EventFacet::Parent';
my $CLASS = 'Test2::EventFacet::Parent';
my $one = $CLASS->new(details => 'foo', hid => 'abc', children => [], buffered => 1);
is($one->details, "foo", "Got details");
is($one->hid, 'abc', "Got 'hid' value");
is($one->buffered, 1, "Got 'buffered' value");
is_deeply($one->children, [], "Got 'children' value");
is_deeply($one->clone, $one, "Cloning.");
isnt($one->clone, $one, "Clone is a new ref");
ok(!$CLASS->is_list, "is not a list");
is($CLASS->facet_key, 'parent', "Got key");
done_testing;
PK 1��\�A�W) ) ! t/Test2/modules/EventFacet/Plan.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use ok 'Test2::EventFacet::Plan';
my $CLASS = 'Test2::EventFacet::Plan';
my $one = $CLASS->new(details => 'foo', count => 100, skip => 1, none => 0);
is($one->details, "foo", "Got details");
is($one->count, 100, "Got 'count' value");
is($one->skip, 1, "Got 'skip' value");
is($one->none, 0, "Got 'none' value");
is_deeply($one->clone, $one, "Cloning.");
isnt($one->clone, $one, "Clone is a new ref");
ok(!$CLASS->is_list, "is not a list");
is($CLASS->facet_key, 'plan', "Got key");
done_testing;
PK 1��\��
�� � " t/Test2/modules/EventFacet/Trace.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::EventFacet::Trace;
my $CLASS = 'Test2::EventFacet::Trace';
like(
exception { $CLASS->new() },
qr/The 'frame' attribute is required/,
"got error"
);
my $one = $CLASS->new(frame => ['Foo::Bar', 'foo.t', 5, 'Foo::Bar::foo']);
is_deeply($one->frame, ['Foo::Bar', 'foo.t', 5, 'Foo::Bar::foo'], "Got frame");
is_deeply([$one->call], ['Foo::Bar', 'foo.t', 5, 'Foo::Bar::foo'], "Got call");
is($one->package, 'Foo::Bar', "Got package");
is($one->file, 'foo.t', "Got file");
is($one->line, 5, "Got line");
is($one->subname, 'Foo::Bar::foo', "got subname");
is($one->debug, "at foo.t line 5", "got trace");
$one->set_detail("yo momma");
is($one->debug, "yo momma", "got detail for trace");
$one->set_detail(undef);
is(
exception { $one->throw('I died') },
"I died at foo.t line 5.\n",
"got exception"
);
is_deeply(
warnings { $one->alert('I cried') },
[ "I cried at foo.t line 5.\n" ],
"alter() warns"
);
my $snap = $one->snapshot;
is_deeply($snap, $one, "identical");
ok($snap != $one, "Not the same instance");
ok(!$CLASS->is_list, "is not a list");
is($CLASS->facet_key, 'trace', "Got key");
done_testing;
PK 1��\�fX��x �x t/Test2/modules/Formatter/TAP.tnu �[��� use strict;
use warnings;
# HARNESS-NO-PRELOAD
my $CLASS;
my %BEFORE_LOAD;
BEGIN {
my $old = select STDOUT;
$BEFORE_LOAD{STDOUT} = $|;
select STDERR;
$BEFORE_LOAD{STDERR} = $|;
select $old;
require Test2::Formatter::TAP;
$CLASS = 'Test2::Formatter::TAP';
*OUT_STD = $CLASS->can('OUT_STD') or die "Could not get OUT_STD constant";
*OUT_ERR = $CLASS->can('OUT_ERR') or die "Could not get OUT_ERR constant";
}
use Test2::Tools::Tiny;
use Test2::API qw/context/;
BEGIN {
eval {
require PerlIO;
PerlIO->VERSION(1.02); # required for PerlIO::get_layers
} or do {
print "1..0 # SKIP Don't have PerlIO 1.02\n";
exit 0;
}
}
sub grabber {
my ($std, $err);
open( my $stdh, '>', \$std ) || die "Ooops";
open( my $errh, '>', \$err ) || die "Ooops";
my $it = $CLASS->new(
handles => [$stdh, $errh, $stdh],
);
return ($it, \$std, \$err);
}
tests "IO handle stuff" => sub {
ok($CLASS->can($_), "$CLASS has the '$_' method") for qw/no_numbers handles/;
ok($CLASS->isa('Test2::Formatter'), "$CLASS isa Test2::Formatter");
ok(!$BEFORE_LOAD{STDOUT}, "AUTOFLUSH was not on for STDOUT before load");
ok(!$BEFORE_LOAD{STDERR}, "AUTOFLUSH was not on for STDERR before load");
my $old = select STDOUT;
ok($|, "AUTOFLUSH was turned on for STDOUT");
select STDERR;
ok($|, "AUTOFLUSH was turned on for STDERR");
select $old;
ok(my $one = $CLASS->new, "Created a new instance");
my $handles = $one->handles;
is(@$handles, 2, "Got 2 handles");
ok($handles->[0] != $handles->[1], "First and second handles are not the same");
my $layers = {map { $_ => 1 } PerlIO::get_layers($handles->[0])};
if (${^UNICODE} & 2) { # 2 means STDIN
ok($layers->{utf8}, "'S' is set in PERL_UNICODE, or in -C, honor it, utf8 should be on");
}
else {
ok(!$layers->{utf8}, "Not utf8 by default");
}
$one->encoding('utf8');
is($one->encoding, 'utf8', "Got encoding");
$handles = $one->handles;
is(@$handles, 2, "Got 2 handles");
$layers = {map { $_ => 1 } PerlIO::get_layers($handles->[OUT_STD])};
ok($layers->{utf8}, "Now utf8");
my $two = $CLASS->new(encoding => 'utf8');
$handles = $two->handles;
is(@$handles, 2, "Got 2 handles");
$layers = {map { $_ => 1 } PerlIO::get_layers($handles->[OUT_STD])};
ok($layers->{utf8}, "Now utf8");
$old = select $handles->[OUT_STD];
ok($|, "AUTOFLUSH was turned on for copy-STDOUT");
select select $handles->[OUT_ERR];
ok($|, "AUTOFLUSH was turned on for copy-STDERR");
select $old;
ok($CLASS->hide_buffered, "TAP will hide buffered events");
ok(!$CLASS->no_subtest_space, "Default formatter does not have subtest space");
};
tests optimal_pass => sub {
my ($it, $out, $err) = grabber();
my $fail = Test2::Event::Fail->new;
ok(!$it->print_optimal_pass($fail, 1), "Not gonna print a non-pass");
$fail = Test2::Event::Ok->new(pass => 0);
ok(!$it->print_optimal_pass($fail, 1), "Not gonna print a non-pass");
my $pass = Test2::Event::Pass->new();
$pass->add_amnesty({tag => 'foo', details => 'foo'});
ok(!$it->print_optimal_pass($pass, 1), "Not gonna print amnesty");
$pass = Test2::Event::Ok->new(pass => 1, todo => '');
ok(!$it->print_optimal_pass($pass, 1), "Not gonna print todo (even empty todo)");
$pass = Test2::Event::Ok->new(pass => 1, name => "foo # bar");
ok(!$it->print_optimal_pass($pass, 1), "Not gonna pritn a name with a hash");
$pass = Test2::Event::Ok->new(pass => 1, name => "foo \n bar");
ok(!$it->print_optimal_pass($pass, 1), "Not gonna pritn a name with a newline");
ok(!$$out, "No std output yet");
ok(!$$err, "No err output yet");
$pass = Test2::Event::Pass->new();
ok($it->print_optimal_pass($pass, 1), "Printed a simple pass without a name");
$pass = Test2::Event::Pass->new(name => 'xxx');
ok($it->print_optimal_pass($pass, 1), "Printed a simple pass with a name");
$pass = Test2::Event::Ok->new(pass => 1, name => 'xxx');
ok($it->print_optimal_pass($pass, 1), "Printed an 'Ok' pass with a name");
$pass = Test2::Event::Pass->new(name => 'xxx', trace => { nested => 1 });
ok($it->print_optimal_pass($pass, 1), "Printed a nested pass");
$pass = Test2::Event::Pass->new(name => 'xxx', trace => { nested => 3 });
ok($it->print_optimal_pass($pass, 1), "Printed a deeply nested pass");
$pass = Test2::Event::Pass->new(name => 'xxx');
$it->{no_numbers} = 1;
ok($it->print_optimal_pass($pass, 1), "Printed a simple pass with a name");
is($$out, <<" EOT", "Got expected TAP output");
ok 1
ok 1 - xxx
ok 1 - xxx
ok 1 - xxx
ok 1 - xxx
ok - xxx
EOT
is($it->{_last_fh}, $it->handles->[OUT_STD], "Set the last filehandle");
ok(!$$err, "No err output");
};
tests plan_tap => sub {
my ($it, $out, $err) = grabber();
is_deeply([$it->plan_tap({})], [], "Nothing with no plan facet");
is_deeply(
[$it->plan_tap({plan => { none => 1 }})],
[],
"no-plan has no output"
);
is_deeply(
[$it->plan_tap({plan => { count => 20 }})],
[[OUT_STD, "1..20\n"]],
"Wrote the plan from, count"
);
is_deeply(
[$it->plan_tap({plan => { count => 'anything', skip => 1 }})],
[[OUT_STD, "1..0 # SKIP\n"]],
"Skip, no reason"
);
is_deeply(
[$it->plan_tap({plan => { count => 'anything', skip => 1, details => 'I said so' }})],
[[OUT_STD, "1..0 # SKIP I said so\n"]],
"Skip with reason"
);
ok(!$$out, "No std output yet");
ok(!$$err, "No err output yet");
};
tests assert_tap => sub {
my ($it, $out, $err) = grabber();
is_deeply(
[$it->assert_tap({assert => {pass => 1}}, 1)],
[[OUT_STD, "ok 1\n"]],
"Pass",
);
is_deeply(
[$it->assert_tap({assert => {pass => 0}}, 1)],
[[OUT_STD, "not ok 1\n"]],
"Fail",
);
tests amnesty => sub {
tests pass_no_name => sub {
is_deeply(
[$it->assert_tap({assert => {pass => 1}, amnesty => [{tag => 'skip', details => 'xxx'}]}, 1)],
[[OUT_STD, "ok 1 # skip xxx\n"]],
"Pass with skip (with details)",
);
is_deeply(
[$it->assert_tap({assert => {pass => 1}, amnesty => [{tag => 'skip'}]}, 1)],
[[OUT_STD, "ok 1 # skip\n"]],
"Pass with skip (without details)",
);
is_deeply(
[$it->assert_tap({assert => {pass => 1}, amnesty => [{tag => 'TODO', details => 'xxx'}]}, 1)],
[[OUT_STD, "ok 1 # TODO xxx\n"]],
"Pass with TODO (with details)",
);
is_deeply(
[$it->assert_tap({assert => {pass => 1}, amnesty => [{tag => 'TODO'}]}, 1)],
[[OUT_STD, "ok 1 # TODO\n"]],
"Pass with TODO (without details)",
);
is_deeply(
[
$it->assert_tap(
{
assert => {pass => 1},
amnesty => [
{tag => 'TODO', details => 'xxx'},
{tag => 'skip', details => 'yyy'},
]
},
1
)
],
[[OUT_STD, "ok 1 # TODO & SKIP yyy\n"]],
"Pass with skip and TODO",
);
is_deeply(
[$it->assert_tap({assert => {pass => 1}, amnesty => [{tag => 'foo', details => 'xxx'}]}, 1)],
[[OUT_STD, "ok 1 # foo xxx\n"]],
"Pass with other amnesty",
);
};
tests pass_with_name => sub {
is_deeply(
[$it->assert_tap({assert => {pass => 1, details => 'bob'}, amnesty => [{tag => 'skip', details => 'xxx'}]}, 1)],
[[OUT_STD, "ok 1 - bob # skip xxx\n"]],
"Pass with skip (with details)",
);
is_deeply(
[$it->assert_tap({assert => {pass => 1, details => 'bob'}, amnesty => [{tag => 'skip'}]}, 1)],
[[OUT_STD, "ok 1 - bob # skip\n"]],
"Pass with skip (without details)",
);
is_deeply(
[$it->assert_tap({assert => {pass => 1, details => 'bob'}, amnesty => [{tag => 'TODO', details => 'xxx'}]}, 1)],
[[OUT_STD, "ok 1 - bob # TODO xxx\n"]],
"Pass with TODO (with details)",
);
is_deeply(
[$it->assert_tap({assert => {pass => 1, details => 'bob'}, amnesty => [{tag => 'TODO'}]}, 1)],
[[OUT_STD, "ok 1 - bob # TODO\n"]],
"Pass with TODO (without details)",
);
is_deeply(
[
$it->assert_tap(
{
assert => {pass => 1, details => 'bob'},
amnesty => [
{tag => 'TODO', details => 'xxx'},
{tag => 'skip', details => 'yyy'},
]
},
1
)
],
[[OUT_STD, "ok 1 - bob # TODO & SKIP yyy\n"]],
"Pass with skip and TODO",
);
is_deeply(
[$it->assert_tap({assert => {pass => 1, details => 'bob'}, amnesty => [{tag => 'foo', details => 'xxx'}]}, 1)],
[[OUT_STD, "ok 1 - bob # foo xxx\n"]],
"Pass with other amnesty",
);
};
tests fail_no_name => sub {
is_deeply(
[$it->assert_tap({assert => {pass => 0}, amnesty => [{tag => 'skip', details => 'xxx'}]}, 1)],
[[OUT_STD, "not ok 1 # skip xxx\n"]],
"Pass with skip (with details)",
);
is_deeply(
[$it->assert_tap({assert => {pass => 0}, amnesty => [{tag => 'skip'}]}, 1)],
[[OUT_STD, "not ok 1 # skip\n"]],
"Pass with skip (without details)",
);
is_deeply(
[$it->assert_tap({assert => {pass => 0}, amnesty => [{tag => 'TODO', details => 'xxx'}]}, 1)],
[[OUT_STD, "not ok 1 # TODO xxx\n"]],
"Pass with TODO (with details)",
);
is_deeply(
[$it->assert_tap({assert => {pass => 0}, amnesty => [{tag => 'TODO'}]}, 1)],
[[OUT_STD, "not ok 1 # TODO\n"]],
"Pass with TODO (without details)",
);
is_deeply(
[
$it->assert_tap(
{
assert => {pass => 0},
amnesty => [
{tag => 'TODO', details => 'xxx'},
{tag => 'skip', details => 'yyy'},
]
},
1
)
],
[[OUT_STD, "not ok 1 # TODO & SKIP yyy\n"]],
"Pass with skip and TODO",
);
is_deeply(
[$it->assert_tap({assert => {pass => 0}, amnesty => [{tag => 'foo', details => 'xxx'}]}, 1)],
[[OUT_STD, "not ok 1 # foo xxx\n"]],
"Pass with other amnesty",
);
};
tests fail_with_name => sub {
is_deeply(
[$it->assert_tap({assert => {pass => 0, details => 'bob'}, amnesty => [{tag => 'skip', details => 'xxx'}]}, 1)],
[[OUT_STD, "not ok 1 - bob # skip xxx\n"]],
"Pass with skip (with details)",
);
is_deeply(
[$it->assert_tap({assert => {pass => 0, details => 'bob'}, amnesty => [{tag => 'skip'}]}, 1)],
[[OUT_STD, "not ok 1 - bob # skip\n"]],
"Pass with skip (without details)",
);
is_deeply(
[$it->assert_tap({assert => {pass => 0, details => 'bob'}, amnesty => [{tag => 'TODO', details => 'xxx'}]}, 1)],
[[OUT_STD, "not ok 1 - bob # TODO xxx\n"]],
"Pass with TODO (with details)",
);
is_deeply(
[$it->assert_tap({assert => {pass => 0, details => 'bob'}, amnesty => [{tag => 'TODO'}]}, 1)],
[[OUT_STD, "not ok 1 - bob # TODO\n"]],
"Pass with TODO (without details)",
);
is_deeply(
[
$it->assert_tap(
{
assert => {pass => 0, details => 'bob'},
amnesty => [
{tag => 'TODO', details => 'xxx'},
{tag => 'skip', details => 'yyy'},
]
},
1
)
],
[[OUT_STD, "not ok 1 - bob # TODO & SKIP yyy\n"]],
"Pass with skip and TODO",
);
is_deeply(
[$it->assert_tap({assert => {pass => 0, details => 'bob'}, amnesty => [{tag => 'foo', details => 'xxx'}]}, 1)],
[[OUT_STD, "not ok 1 - bob # foo xxx\n"]],
"Pass with other amnesty",
);
};
};
tests newline_and_hash => sub {
tests pass => sub {
is_deeply(
[$it->assert_tap({assert => {pass => 1, details => "foo\nbar"}}, 1)],
[
[OUT_STD, "ok 1 - foo\n"],
[OUT_STD, "# bar\n"],
],
"Pass with newline",
);
is_deeply(
[$it->assert_tap({assert => {pass => 1, details => "foo\nbar"}, amnesty => [{tag => 'baz', details => 'bat'}]}, 1)],
[
[OUT_STD, "ok 1 - foo # baz bat\n"],
[OUT_STD, "# bar\n"],
],
"Pass with newline and amnesty",
);
is_deeply(
[$it->assert_tap({assert => {pass => 1, details => "foo#bar"}}, 1)],
[[OUT_STD, "ok 1 - foo\\#bar\n"]],
"Pass with hash",
);
is_deeply(
[$it->assert_tap({assert => {pass => 1, details => "foo#bar"}, amnesty => [{tag => 'baz', details => 'bat'}]}, 1)],
[[OUT_STD, "ok 1 - foo\\#bar # baz bat\n"]],
"Pass with hash and amnesty",
);
is_deeply(
[$it->assert_tap({assert => {pass => 1, details => "foo#x\nbar#boo"}}, 1)],
[
[OUT_STD, "ok 1 - foo\\#x\n"],
[OUT_STD, "# bar#boo\n"],
],
"Pass with newline and hash",
);
is_deeply(
[$it->assert_tap({assert => {pass => 1, details => "foo#x\nbar#boo"}, amnesty => [{tag => 'baz', details => 'bat'}]}, 1)],
[
[OUT_STD, "ok 1 - foo\\#x # baz bat\n"],
[OUT_STD, "# bar#boo\n"],
],
"Pass with newline and hash and amnesty",
);
};
tests fail => sub {
is_deeply(
[$it->assert_tap({assert => {pass => 0, details => "foo\nbar"}}, 1)],
[
[OUT_STD, "not ok 1 - foo\n"],
[OUT_STD, "# bar\n"],
],
"Pass with newline",
);
is_deeply(
[$it->assert_tap({assert => {pass => 0, details => "foo\nbar"}, amnesty => [{tag => 'baz', details => 'bat'}]}, 1)],
[
[OUT_STD, "not ok 1 - foo # baz bat\n"],
[OUT_STD, "# bar\n"],
],
"Pass with newline and amnesty",
);
is_deeply(
[$it->assert_tap({assert => {pass => 0, details => "foo#bar"}}, 1)],
[[OUT_STD, "not ok 1 - foo\\#bar\n"]],
"Pass with hash",
);
is_deeply(
[$it->assert_tap({assert => {pass => 0, details => "foo#bar"}, amnesty => [{tag => 'baz', details => 'bat'}]}, 1)],
[[OUT_STD, "not ok 1 - foo\\#bar # baz bat\n"]],
"Pass with hash and amnesty",
);
is_deeply(
[$it->assert_tap({assert => {pass => 0, details => "foo#x\nbar#boo"}}, 1)],
[
[OUT_STD, "not ok 1 - foo\\#x\n"],
[OUT_STD, "# bar#boo\n"],
],
"Pass with newline and hash",
);
is_deeply(
[$it->assert_tap({assert => {pass => 0, details => "foo#x\nbar#boo"}, amnesty => [{tag => 'baz', details => 'bat'}]}, 1)],
[
[OUT_STD, "not ok 1 - foo\\#x # baz bat\n"],
[OUT_STD, "# bar#boo\n"],
],
"Pass with newline and hash and amnesty",
);
};
};
tests parent => sub {
is_deeply(
[
$it->assert_tap(
{
assert => {pass => 1, details => 'bob'},
parent => {hid => 1, buffered => 1, children => [{assert => {pass => 1, details => 'bob2'}}]},
},
1
)
],
[
[OUT_STD, "ok 1 - bob {\n"],
[OUT_STD, " ok 1 - bob2\n"],
[OUT_STD, "}\n"],
],
"Parent (buffered)",
);
is_deeply(
[
$it->assert_tap(
{
assert => {pass => 1, details => 'bob'},
parent => {hid => 1, buffered => 0, children => [{assert => {pass => 1, details => 'bob2'}}]},
},
1
)
],
[[OUT_STD, "ok 1 - bob\n"]],
"Parent (un-buffered)",
);
};
ok(!$$out, "No std output yet");
ok(!$$err, "No err output yet");
};
tests debug_tap => sub {
my ($it, $out, $err) = grabber();
is_deeply(
[
$it->debug_tap(
{
assert => {pass => 0},
trace => {frame => ['foo', 'foo.t', 42]},
},
1
)
],
[
[OUT_ERR, "# Failed test at foo.t line 42.\n"],
],
"debug tap, nameless test"
);
is_deeply(
[
$it->debug_tap(
{
assert => {details => 'foo bar', pass => 0},
trace => {frame => ['foo', 'foo.t', 42]},
},
1
)
],
[
[OUT_ERR, "# Failed test 'foo bar'\n# at foo.t line 42.\n"],
],
"Debug tap, named test"
);
is_deeply(
[
$it->debug_tap(
{
assert => {details => 'foo bar', pass => 0},
trace => {frame => ['foo', 'foo.t', 42], details => 'I say hi!'},
},
1
)
],
[
[OUT_ERR, "# Failed test 'foo bar'\n# I say hi!\n"],
],
"Debug tap with details"
);
is_deeply(
[
$it->debug_tap(
{
assert => {details => 'foo bar', pass => 0},
},
1
)
],
[
[OUT_ERR, "# Failed test 'foo bar'\n# [No trace info available]\n"],
],
"Debug tap no trace"
);
is_deeply(
[
$it->debug_tap(
{
assert => {details => 'foo bar', pass => 0},
trace => {frame => ['foo', 'foo.t', 42]},
amnesty => [],
},
1
)
],
[
[OUT_ERR, "# Failed test 'foo bar'\n# at foo.t line 42.\n"],
],
"Debug empty amnesty"
);
is_deeply(
[
$it->debug_tap(
{
assert => {details => 'foo bar', pass => 0},
trace => {frame => ['foo', 'foo.t', 42]},
amnesty => [{tag => 'TODO', details => 'xxx'}],
},
1
)
],
[
[OUT_STD, "# Failed test (with amnesty) 'foo bar'\n# at foo.t line 42.\n"],
],
"Debug empty amnesty"
);
ok(!$$out, "No std output yet");
ok(!$$err, "No err output yet");
my $event = Test2::Event::Fail->new(trace => {frame => ['foo', 'foo.pl', 42]});
{
local $ENV{HARNESS_ACTIVE} = 0;
local $ENV{HARNESS_IS_VERBOSE} = 0;
$event->{name} = 'no harness';
$it->write($event, 1);
$ENV{HARNESS_ACTIVE} = 0;
$ENV{HARNESS_IS_VERBOSE} = 1;
$event->{name} = 'no harness, but strangely verbose';
$it->write($event, 1);
$ENV{HARNESS_ACTIVE} = 1;
$ENV{HARNESS_IS_VERBOSE} = 0;
$event->{name} = 'harness, but not verbose';
$it->write($event, 1);
$ENV{HARNESS_ACTIVE} = 1;
$ENV{HARNESS_IS_VERBOSE} = 1;
$event->{name} = 'harness that is verbose';
$it->write($event, 1);
}
is($$out, <<" EOT", "Got 4 failures to STDERR");
not ok 1 - no harness
not ok 1 - no harness, but strangely verbose
not ok 1 - harness, but not verbose
not ok 1 - harness that is verbose
EOT
is($$err, <<" EOT", "Got expected diag to STDERR, newline for non-verbose harness");
# Failed test 'no harness'
# at foo.pl line 42.
# Failed test 'no harness, but strangely verbose'
# at foo.pl line 42.
# Failed test 'harness, but not verbose'
# at foo.pl line 42.
# Failed test 'harness that is verbose'
# at foo.pl line 42.
EOT
};
tests halt_tap => sub {
my ($it, $out, $err) = grabber();
is_deeply(
[$it->halt_tap({trace => {nested => 1},})],
[],
"No output when nested"
);
is_deeply(
[$it->halt_tap({trace => {nested => 1, buffered => 1}})],
[[OUT_STD, "Bail out!\n" ]],
"Got tap for nested buffered bail"
);
is_deeply(
[$it->halt_tap({control => {details => ''}})],
[[OUT_STD, "Bail out!\n"]],
"Empty details"
);
is_deeply(
[$it->halt_tap({control => {details => undef}})],
[[OUT_STD, "Bail out!\n"]],
"undef details"
);
is_deeply(
[$it->halt_tap({control => {details => 0}})],
[[OUT_STD, "Bail out! 0\n"]],
"falsy details"
);
is_deeply(
[$it->halt_tap({control => {details => 'foo bar baz'}})],
[[OUT_STD, "Bail out! foo bar baz\n"]],
"full details"
);
ok(!$$out, "No std output yet");
ok(!$$err, "No err output yet");
};
tests summary_tap => sub {
my ($it, $out, $err) = grabber();
is_deeply(
[$it->summary_tap({about => { no_display => 1, details => "Should not see me"}})],
[],
"no display"
);
is_deeply(
[$it->summary_tap({about => { no_display => 0, details => ""}})],
[],
"no summary"
);
is_deeply(
[$it->summary_tap({about => { no_display => 0, details => "foo bar"}})],
[[OUT_STD, "# foo bar\n"]],
"summary"
);
ok(!$$out, "No std output yet");
ok(!$$err, "No err output yet");
};
tests info_tap => sub {
my ($it, $out, $err) = grabber();
is_deeply(
[
$it->info_tap(
{
info => [
{debug => 0, details => "foo"},
{debug => 1, details => "foo"},
{debug => 0, details => "foo\nbar\nbaz"},
{debug => 1, details => "foo\nbar\nbaz"},
]
}
)
],
[
[OUT_STD, "# foo\n"],
[OUT_ERR, "# foo\n"],
[OUT_STD, "# foo\n# bar\n# baz\n"],
[OUT_ERR, "# foo\n# bar\n# baz\n"],
],
"Got all infos"
);
my @TAP = $it->info_tap(
{
info => [
{debug => 0, details => {structure => 'yes'}},
{debug => 1, details => {structure => 'yes'}},
]
}
);
is($TAP[0]->[0], OUT_STD, "First went to STDOUT");
is($TAP[1]->[0], OUT_ERR, "Second went to STDOUT");
like($TAP[0]->[1], qr/structure.*=>.*yes/, "We see the structure in some form");
like($TAP[1]->[1], qr/structure.*=>.*yes/, "We see the structure in some form");
ok(!$$out, "No std output yet");
ok(!$$err, "No err output yet");
};
tests error_tap => sub {
my ($it, $out, $err) = grabber();
# Data::Dumper behavior can change from version to version, specifically
# the Data::Dumper in 5.8.9 produces different whitespace from other
# versions.
require Data::Dumper;
my $dumper = Data::Dumper->new([{structure => 'yes'}])->Indent(2)->Terse(1)->Pad('# ')->Useqq(1)->Sortkeys(1);
chomp(my $struct = $dumper->Dump);
is_deeply(
[
$it->error_tap(
{
errors => [
{details => "foo"},
{details => "foo\nbar\nbaz"},
{details => {structure => 'yes'}},
]
}
)
],
[
[OUT_ERR, "# foo\n"],
[OUT_ERR, "# foo\n# bar\n# baz\n"],
[OUT_ERR, "$struct\n"],
],
"Got all errors"
);
ok(!$$out, "No std output yet");
ok(!$$err, "No err output yet");
};
tests event_tap => sub {
my ($it, $out, $err) = grabber();
is_deeply(
[$it->event_tap({plan => {count => 5}, assert => {pass => 1}}, 1)],
[
[OUT_STD, "1..5\n"],
[OUT_STD, "ok 1\n"],
],
"Plan then assertion for first assertion"
);
$it->{made_assertion} = 1;
is_deeply(
[$it->event_tap({plan => {count => 5}, assert => {pass => 1}}, 2)],
[
[OUT_STD, "ok 2\n"],
[OUT_STD, "1..5\n"],
],
"Assertion then plan for additional assertions"
);
$it->{made_assertion} = 0;
is_deeply(
[
$it->event_tap(
{
plan => {count => 5},
assert => {pass => 0},
errors => [{details => "foo"}],
info => [
{tag => 'DIAG', debug => 1, details => 'xxx'},
{tag => 'NOTE', debug => 0, details => 'yyy'},
],
control => {halt => 1, details => 'blah'},
about => {details => 'xyz'},
},
1
)
],
[
[OUT_STD, "1..5\n"],
[OUT_STD, "not ok 1\n"],
[OUT_ERR, "# Failed test [No trace info available]\n"],
[OUT_ERR, "# foo\n"],
[OUT_ERR, "# xxx\n"],
[OUT_STD, "# yyy\n"],
[OUT_STD, "Bail out! blah\n"],
],
"All facets displayed"
);
is_deeply(
[
$it->event_tap(
{
plan => {count => 5},
about => {details => 'xyz'},
},
1
)
],
[[OUT_STD, "1..5\n"]],
"Plan blocks details"
);
is_deeply(
[
$it->event_tap(
{
assert => {pass => 0, no_debug => 1},
about => {details => 'xyz'},
},
1
)
],
[[OUT_STD, "not ok 1\n"]],
"Assert blocks details"
);
is_deeply(
[
$it->event_tap(
{
errors => [{details => "foo"}],
about => {details => 'xyz'},
},
1
)
],
[[OUT_ERR, "# foo\n"]],
"Error blocks details"
);
is_deeply(
[
$it->event_tap(
{
info => [
{tag => 'DIAG', debug => 1, details => 'xxx'},
{tag => 'NOTE', debug => 0, details => 'yyy'},
],
about => {details => 'xyz'},
},
1
)
],
[
[OUT_ERR, "# xxx\n"],
[OUT_STD, "# yyy\n"],
],
"Info blocks details"
);
is_deeply(
[
$it->event_tap(
{
control => {halt => 1, details => 'blah'},
about => {details => 'xyz'},
},
1
)
],
[[OUT_STD, "Bail out! blah\n"]],
"Halt blocks details"
);
is_deeply(
[$it->event_tap({about => {details => 'xyz'}}, 1)],
[[OUT_STD, "# xyz\n"]],
"Fallback to summary"
);
ok(!$$out, "No std output yet");
ok(!$$err, "No err output yet");
};
tests write => sub {
my ($it, $out, $err) = grabber();
local $ENV{HARNESS_ACTIVE} = 0;
local $ENV{HARNESS_IS_VERBOSE} = 0;
{
local $\ = 'oops1';
local $, = 'oops2';
$it->write(
undef, 1,
{
plan => {count => 5},
assert => {pass => 0},
errors => [{details => "foo"}],
info => [
{tag => 'DIAG', debug => 1, details => 'xxx'},
{tag => 'NOTE', debug => 0, details => 'yyy'},
],
control => {halt => 1, details => 'blah'},
about => {details => 'xyz'},
},
);
$it->write(undef, 2, {assert => {pass => 1}, trace => {nested => 1}});
}
is($it->{_last_fh}, $it->handles->[OUT_STD], "Set last handle");
is($$out, <<" EOT", "STDOUT is as expected");
1..5
not ok 1
# yyy
Bail out! blah
ok 2
EOT
is($$err, <<" EOT", "STDERR is as expected");
# Failed test [No trace info available]
# foo
# xxx
EOT
};
done_testing;
PK 1��\r�� � , t/Test2/modules/Hub/Interceptor/Terminator.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::Hub::Interceptor::Terminator;
ok($INC{'Test2/Hub/Interceptor/Terminator.pm'}, "loaded");
done_testing;
PK 1��\/�~ ~ ! t/Test2/modules/Hub/Interceptor.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::Hub::Interceptor;
my $one = Test2::Hub::Interceptor->new();
ok($one->isa('Test2::Hub'), "inheritence");;
my $e = exception { $one->terminate(55) };
ok($e->isa('Test2::Hub::Interceptor::Terminator'), "exception type");
like($$e, 'Label not found for "last T2_SUBTEST_WRAPPER"', "Could not find label");
done_testing;
PK 1��\Øu�
t/Test2/modules/Hub/Subtest.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::Hub::Subtest;
use Test2::Util qw/get_tid/;
use Carp qw/croak/;
my %TODO;
sub def {
my ($func, @args) = @_;
my @caller = caller(0);
$TODO{$caller[0]} ||= [];
push @{$TODO{$caller[0]}} => [$func, \@args, \@caller];
}
sub do_def {
my $for = caller;
my $tests = delete $TODO{$for} or croak "No tests to run!";
for my $test (@$tests) {
my ($func, $args, $caller) = @$test;
my ($pkg, $file, $line) = @$caller;
# Note: The '&' below is to bypass the prototype, which is important here.
eval <<" EOT" or die $@;
package $pkg;
# line $line "(eval in DeferredTests) $file"
\&$func(\@\$args);
1;
EOT
}
}
my $ran = 0;
my $event;
my $one = Test2::Hub::Subtest->new(
nested => 3,
);
ok($one->isa('Test2::Hub'), "inheritence");
{
no warnings 'redefine';
local *Test2::Hub::process = sub { $ran++; (undef, $event) = @_; 'P!' };
use warnings;
my $ok = Test2::Event::Ok->new(
pass => 1,
name => 'blah',
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__, 'xxx']),
);
def is => ($one->process($ok), 'P!', "processed");
def is => ($ran, 1, "ran the mocked process");
def is => ($event, $ok, "got our event");
def is => ($one->bailed_out, undef, "did not bail");
$ran = 0;
$event = undef;
my $bail = Test2::Event::Bail->new(
message => 'blah',
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__, 'xxx']),
);
def is => ($one->process($bail), 'P!', "processed");
def is => ($ran, 1, "ran the mocked process");
def is => ($event, $bail, "got our event");
}
do_def;
my $skip = Test2::Event::Plan->new(
trace => Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__], pid => $$, tid => get_tid),
directive => 'SKIP',
reason => 'foo',
);
$ran = 0;
T2_SUBTEST_WRAPPER: {
$ran++;
$one->terminate(100, $skip);
$ran++;
}
is($ran, 1, "did not get past the terminate");
$ran = 0;
T2_SUBTEST_WRAPPER: {
$ran++;
$one->send($skip);
$ran++;
}
is($ran, 1, "did not get past the terminate");
$one->reset_state;
$one->set_manual_skip_all(1);
$ran = 0;
T2_SUBTEST_WRAPPER: {
$ran++;
$one->terminate(100, $skip);
$ran++;
}
is($ran, 2, "did not automatically abort");
$one->reset_state;
$ran = 0;
T2_SUBTEST_WRAPPER: {
$ran++;
$one->send($skip);
$ran++;
}
is($ran, 2, "did not automatically abort");
done_testing;
PK 1��\��m<�B �B " t/Test2/modules/IPC/Driver/Files.tnu �[��� use Test2::Tools::Tiny;
use Test2::Util qw/get_tid USE_THREADS try ipc_separator/;
use File::Temp qw/tempfile/;
use File::Spec qw/catfile/;
use List::Util qw/shuffle/;
use strict;
use warnings;
if ($] lt "5.008") {
print "1..0 # SKIP Test cannot run on perls below 5.8.0\n";
exit 0;
}
sub simple_capture(&) {
my $code = shift;
my ($err, $out) = ("", "");
my ($ok, $e);
{
local *STDOUT;
local *STDERR;
($ok, $e) = try {
open(STDOUT, '>', \$out) or die "Failed to open a temporary STDOUT: $!";
open(STDERR, '>', \$err) or die "Failed to open a temporary STDERR: $!";
$code->();
};
}
die $e unless $ok;
return {
STDOUT => $out,
STDERR => $err,
};
}
require Test2::IPC::Driver::Files;
ok(my $ipc = Test2::IPC::Driver::Files->new, "Created an IPC instance");
ok($ipc->isa('Test2::IPC::Driver::Files'), "Correct type");
ok($ipc->isa('Test2::IPC::Driver'), "inheritence");
ok(-d $ipc->tempdir, "created temp dir");
is($ipc->pid, $$, "stored pid");
is($ipc->tid, get_tid(), "stored the tid");
my $hid = join ipc_separator, qw'12345 1 1 1';
$ipc->add_hub($hid);
my $hubfile = File::Spec->catfile($ipc->tempdir, "HUB" . ipc_separator . $hid);
ok(-f $hubfile, "wrote hub file");
if(ok(open(my $fh, '<', $hubfile), "opened hub file")) {
my @lines = <$fh>;
close($fh);
is_deeply(
\@lines,
[ "$$\n", get_tid() . "\n" ],
"Wrote pid and tid to hub file"
);
}
{
package Foo;
use base 'Test2::Event';
}
$ipc->send($hid, bless({ foo => 1 }, 'Foo'));
$ipc->send($hid, bless({ bar => 1 }, 'Foo'));
my $sep = ipc_separator;
opendir(my $dh, $ipc->tempdir) || die "Could not open tempdir: !?";
my @files = grep { $_ !~ m/^\.+$/ && $_ !~ m/^HUB${sep}$hid/ } readdir($dh);
closedir($dh);
is(@files, 2, "2 files added to the IPC directory");
my @events = $ipc->cull($hid);
is_deeply(
\@events,
[{ foo => 1 }, { bar => 1 }],
"Culled both events"
);
opendir($dh, $ipc->tempdir) || die "Could not open tempdir: !?";
@files = grep { $_ !~ m/^\.+$/ && $_ !~ m/^HUB$sep$hid/ } readdir($dh);
closedir($dh);
is(@files, 0, "All files collected");
$ipc->drop_hub($hid);
ok(!-f $ipc->tempdir . '/' . $hid, "removed hub file");
$ipc->send($hid, bless({global => 1}, 'Foo'), 'GLOBAL');
my @got = $ipc->cull($hid);
ok(@got == 0, "did not get our own global event");
my $tmpdir = $ipc->tempdir;
ok(-d $tmpdir, "still have temp dir");
$ipc = undef;
ok(!-d $tmpdir, "cleaned up temp dir");
{
my $ipc = Test2::IPC::Driver::Files->new();
my $tmpdir = $ipc->tempdir;
my $ipc_thread_clone = bless {%$ipc}, 'Test2::IPC::Driver::Files';
$ipc_thread_clone->set_tid(100);
$ipc_thread_clone = undef;
ok(-d $tmpdir, "Directory not removed (different thread)");
my $ipc_fork_clone = bless {%$ipc}, 'Test2::IPC::Driver::Files';
$ipc_fork_clone->set_pid($$ + 10);
$ipc_fork_clone = undef;
ok(-d $tmpdir, "Directory not removed (different proc)");
$ipc_thread_clone = bless {%$ipc}, 'Test2::IPC::Driver::Files';
$ipc_thread_clone->set_tid(undef);
$ipc_thread_clone = undef;
ok(-d $tmpdir, "Directory not removed (no thread)");
$ipc_fork_clone = bless {%$ipc}, 'Test2::IPC::Driver::Files';
$ipc_fork_clone->set_pid(undef);
$ipc_fork_clone = undef;
ok(-d $tmpdir, "Directory not removed (no proc)");
$ipc = undef;
ok(!-d $tmpdir, "Directory removed");
}
{
no warnings qw/once redefine/;
local *Test2::IPC::Driver::Files::driver_abort = sub {};
local *Test2::IPC::Driver::Files::abort = sub {
my $self = shift;
local $self->{no_fatal} = 1;
local $self->{no_bail} = 1;
$self->Test2::IPC::Driver::abort(@_);
die 255;
};
my $tmpdir;
my @lines;
my $file = __FILE__;
my $out = simple_capture {
local $ENV{T2_KEEP_TEMPDIR} = 1;
my $ipc = Test2::IPC::Driver::Files->new();
$tmpdir = $ipc->tempdir;
$ipc->add_hub($hid);
eval { $ipc->add_hub($hid) }; push @lines => __LINE__;
$ipc->send($hid, bless({ foo => 1 }, 'Foo'));
$ipc->cull($hid);
$ipc->drop_hub($hid);
eval { $ipc->drop_hub($hid) }; push @lines => __LINE__;
# Make sure having a hub file sitting around does not throw things off
# in T2_KEEP_TEMPDIR
$ipc->add_hub($hid);
$ipc = undef;
1;
};
my $cleanup = sub {
if (opendir(my $d, $tmpdir)) {
for my $f (readdir($d)) {
next if $f =~ m/^\.+$/;
my $file = File::Spec->catfile($tmpdir, $f);
next unless -f $file;
1 while unlink $file;
}
closedir($d);
rmdir($tmpdir) or warn "Could not remove temp dir '$tmpdir': $!";
}
};
$cleanup->();
like($out->{STDERR}, qr/IPC Temp Dir: \Q$tmpdir\E/m, "Got temp dir path");
like($out->{STDERR}, qr/^# Not removing temp dir: \Q$tmpdir\E$/m, "Notice about not closing tempdir");
like($out->{STDERR}, qr/^IPC Fatal Error: File for hub '$hid' already exists/m, "Got message for duplicate hub");
like($out->{STDERR}, qr/^IPC Fatal Error: File for hub '$hid' does not exist/m, "Cannot remove hub twice");
$out = simple_capture {
my $ipc = Test2::IPC::Driver::Files->new();
$ipc->add_hub($hid);
my $trace = Test2::EventFacet::Trace->new(frame => [__PACKAGE__, __FILE__, __LINE__, 'foo']);
my $e = eval { $ipc->send($hid, bless({glob => \*ok, trace => $trace}, 'Foo')); 1 };
print STDERR $@ unless $e || $@ =~ m/^255/;
$ipc->drop_hub($hid);
};
like($out->{STDERR}, qr/IPC Fatal Error:/, "Got fatal error");
like($out->{STDERR}, qr/There was an error writing an event/, "Explanation");
like($out->{STDERR}, qr/Destination: $hid/, "Got dest");
like($out->{STDERR}, qr/Origin PID:\s+$$/, "Got pid");
like($out->{STDERR}, qr/Error: Can't store GLOB items/, "Got cause");
$out = simple_capture {
my $ipc = Test2::IPC::Driver::Files->new();
local $@;
eval { $ipc->send($hid, bless({ foo => 1 }, 'Foo')) };
print STDERR $@ unless $@ =~ m/^255/;
$ipc = undef;
};
like($out->{STDERR}, qr/IPC Fatal Error: hub '$hid' is not available, failed to send event!/, "Cannot send to missing hub");
$out = simple_capture {
my $ipc = Test2::IPC::Driver::Files->new();
$tmpdir = $ipc->tempdir;
$ipc->add_hub($hid);
$ipc->send($hid, bless({ foo => 1 }, 'Foo'));
local $@;
eval { $ipc->drop_hub($hid) };
print STDERR $@ unless $@ =~ m/^255/;
};
$cleanup->();
like($out->{STDERR}, qr/IPC Fatal Error: Not all files from hub '$hid' have been collected/, "Leftover files");
like($out->{STDERR}, qr/IPC Fatal Error: Leftover files in the directory \(.*\.ready\)/, "What file");
$out = simple_capture {
my $ipc = Test2::IPC::Driver::Files->new();
$ipc->add_hub($hid);
eval { $ipc->send($hid, { foo => 1 }) };
print STDERR $@ unless $@ =~ m/^255/;
eval { $ipc->send($hid, bless({ foo => 1 }, 'xxx')) };
print STDERR $@ unless $@ =~ m/^255/;
};
like($out->{STDERR}, qr/IPC Fatal Error: 'HASH\(.*\)' is not a blessed object/, "Cannot send unblessed objects");
like($out->{STDERR}, qr/IPC Fatal Error: 'xxx=HASH\(.*\)' is not an event object!/, "Cannot send non-event objects");
$ipc = Test2::IPC::Driver::Files->new();
my ($fh, $fn) = tempfile();
print $fh "\n";
close($fh);
Storable::store({}, $fn);
$out = simple_capture { eval { $ipc->read_event_file($fn) } };
like(
$out->{STDERR},
qr/IPC Fatal Error: Got an unblessed object: 'HASH\(.*\)'/,
"Events must actually be events (must be blessed)"
);
Storable::store(bless({}, 'Test2::Event::FakeEvent'), $fn);
$out = simple_capture { eval { $ipc->read_event_file($fn) } };
like(
$out->{STDERR},
qr{IPC Fatal Error: Event has unknown type \(Test2::Event::FakeEvent\), tried to load 'Test2/Event/FakeEvent\.pm' but failed: Can't locate Test2/Event/FakeEvent\.pm},
"Events must actually be events (not a real module)"
);
Storable::store(bless({}, 'Test2::API'), $fn);
$out = simple_capture { eval { $ipc->read_event_file($fn) } };
like(
$out->{STDERR},
qr{'Test2::API=HASH\(.*\)' is not a 'Test2::Event' object},
"Events must actually be events (not an event type)"
);
Storable::store(bless({}, 'Foo'), $fn);
$out = simple_capture {
local @INC;
push @INC => ('t/lib', 'lib');
eval { $ipc->read_event_file($fn) };
};
ok(!$out->{STDERR}, "no problem", $out->{STDERR});
ok(!$out->{STDOUT}, "no problem", $out->{STDOUT});
unlink($fn);
}
{
my $ipc = Test2::IPC::Driver::Files->new();
$ipc->add_hub($hid);
$ipc->send($hid, bless({global => 1}, 'Foo'), 'GLOBAL');
$ipc->set_globals({});
my @events = $ipc->cull($hid);
is_deeply(
\@events,
[ {global => 1} ],
"Got global event"
);
@events = $ipc->cull($hid);
ok(!@events, "Did not grab it again");
$ipc->set_globals({});
@events = $ipc->cull($hid);
is_deeply(
\@events,
[ {global => 1} ],
"Still there"
);
$ipc->drop_hub($hid);
$ipc = undef;
}
{
my @list = shuffle (
{global => 0, pid => 2, tid => 1, eid => 1},
{global => 0, pid => 2, tid => 1, eid => 2},
{global => 0, pid => 2, tid => 1, eid => 3},
{global => 1, pid => 1, tid => 1, eid => 1},
{global => 1, pid => 12, tid => 1, eid => 3},
{global => 1, pid => 11, tid => 1, eid => 2},
{global => 0, pid => 2, tid => 3, eid => 1},
{global => 0, pid => 2, tid => 3, eid => 10},
{global => 0, pid => 2, tid => 3, eid => 100},
{global => 0, pid => 5, tid => 3, eid => 2},
{global => 0, pid => 5, tid => 3, eid => 20},
{global => 0, pid => 5, tid => 3, eid => 200},
);
my @sorted;
{
package Test2::IPC::Driver::Files;
@sorted = sort cmp_events @list;
}
is_deeply(
\@sorted,
[
{global => 1, pid => 1, tid => 1, eid => 1},
{global => 1, pid => 11, tid => 1, eid => 2},
{global => 1, pid => 12, tid => 1, eid => 3},
{global => 0, pid => 2, tid => 1, eid => 1},
{global => 0, pid => 2, tid => 1, eid => 2},
{global => 0, pid => 2, tid => 1, eid => 3},
{global => 0, pid => 2, tid => 3, eid => 1},
{global => 0, pid => 2, tid => 3, eid => 10},
{global => 0, pid => 2, tid => 3, eid => 100},
{global => 0, pid => 5, tid => 3, eid => 2},
{global => 0, pid => 5, tid => 3, eid => 20},
{global => 0, pid => 5, tid => 3, eid => 200},
],
"Sort by global, pid, tid and then eid"
);
}
{
my $ipc = 'Test2::IPC::Driver::Files';
is_deeply(
$ipc->parse_event_filename(join ipc_separator, qw'GLOBAL 123 456 789 Event Type Foo.ready.complete'),
{
ready => 1,
complete => 1,
global => 1,
type => "Event::Type::Foo",
hid => "GLOBAL",
pid => "123",
tid => "456",
eid => "789",
file => join ipc_separator, qw'GLOBAL 123 456 789 Event Type Foo',
},
"Parsed global complete"
);
is_deeply(
$ipc->parse_event_filename(join ipc_separator, qw'GLOBAL 123 456 789 Event Type Foo.ready'),
{
ready => 1,
complete => 0,
global => 1,
type => "Event::Type::Foo",
hid => "GLOBAL",
pid => "123",
tid => "456",
eid => "789",
file => join ipc_separator, qw'GLOBAL 123 456 789 Event Type Foo',
},
"Parsed global ready"
);
is_deeply(
$ipc->parse_event_filename(join ipc_separator, qw'GLOBAL 123 456 789 Event Type Foo'),
{
ready => 0,
complete => 0,
global => 1,
type => "Event::Type::Foo",
hid => "GLOBAL",
pid => "123",
tid => "456",
eid => "789",
file => join ipc_separator, qw'GLOBAL 123 456 789 Event Type Foo',
},
"Parsed global not ready"
);
is_deeply(
$ipc->parse_event_filename(join ipc_separator, qw'1 1 1 1 123 456 789 Event Type Foo.ready.complete'),
{
ready => 1,
complete => 1,
global => 0,
type => "Event::Type::Foo",
hid => "1${sep}1${sep}1${sep}1",
pid => "123",
tid => "456",
eid => "789",
file => join ipc_separator, qw'1 1 1 1 123 456 789 Event Type Foo',
},
"Parsed event complete"
);
is_deeply(
$ipc->parse_event_filename(join ipc_separator, qw'1 2 3 4 123 456 789 Event Type Foo.ready'),
{
ready => 1,
complete => 0,
global => 0,
type => "Event::Type::Foo",
hid => "1${sep}2${sep}3${sep}4",
pid => "123",
tid => "456",
eid => "789",
file => join ipc_separator, qw'1 2 3 4 123 456 789 Event Type Foo',
},
"Parsed event ready"
);
is_deeply(
$ipc->parse_event_filename(join ipc_separator, qw'3 2 11 12 123 456 789 Event'),
{
ready => 0,
complete => 0,
global => 0,
type => "Event",
hid => "3${sep}2${sep}11${sep}12",
pid => "123",
tid => "456",
eid => "789",
file => join ipc_separator, qw'3 2 11 12 123 456 789 Event',
},
"Parsed event not ready"
);
}
{
my $ipc = Test2::IPC::Driver::Files->new();
my $hid = join ipc_separator, qw"1 1 1 1";
is_deeply(
$ipc->should_read_event($hid, join ipc_separator, qw"GLOBAL 123 456 789 Event Type Foo.ready.complete") ? 1 : 0,
0,
"Do not read complete global"
);
is_deeply(
$ipc->should_read_event($hid, join ipc_separator, qw"GLOBAL 123 456 789 Event Type Foo.ready") ? 1 : 0,
1,
"Should read ready global the first time"
);
is_deeply(
$ipc->should_read_event($hid, join ipc_separator, qw"GLOBAL 123 456 789 Event Type Foo.ready") ? 1 : 0,
0,
"Should not read ready global again"
);
is_deeply(
$ipc->should_read_event($hid, join ipc_separator, qw"GLOBAL 123 456 789 Event Type Foo") ? 1 : 0,
0,
"Should not read un-ready global"
);
is_deeply(
$ipc->should_read_event($hid, join ipc_separator, $hid, qw"123 456 789 Event Type Foo.ready.complete") ? 1 : 0,
0,
"Do not read complete our hid"
);
is_deeply(
$ipc->should_read_event($hid, join ipc_separator, $hid, qw"123 456 789 Event Type Foo.ready") ? 1 : 0,
1,
"Should read ready our hid"
);
is_deeply(
$ipc->should_read_event($hid, join ipc_separator, $hid, qw"123 456 789 Event Type Foo.ready") ? 1 : 0,
1,
"Should read ready our hid (again, no duplicate checking)"
);
is_deeply(
$ipc->should_read_event($hid, join ipc_separator, $hid, qw"123 456 789 Event Type Foo") ? 1 : 0,
0,
"Should not read un-ready our hid"
);
is_deeply(
$ipc->should_read_event($hid, join ipc_separator, qw"1 2 3 123 456 789 Event Type Foo.ready.complete") ? 1 : 0,
0,
"Not ours - complete"
);
is_deeply(
$ipc->should_read_event($hid, join ipc_separator, qw"1 2 3 123 456 789 Event Type Foo.ready") ? 1 : 0,
0,
"Not ours - ready"
);
is_deeply(
$ipc->should_read_event($hid, join ipc_separator, qw"1 2 3 123 456 789 Event Type Foo") ? 1 : 0,
0,
"Not ours - unready"
);
my @got = $ipc->should_read_event($hid, join ipc_separator, $hid, qw"123 456 789 Event Type Foo");
ok(!@got, "return empty list for false");
@got = $ipc->should_read_event($hid, join ipc_separator, $hid, qw"123 456 789 Event Type Foo.ready");
is(@got, 1, "got 1 item on true");
like(delete $got[0]->{full_path}, qr{^.+\Q$hid\E${sep}123${sep}456${sep}789${sep}Event${sep}Type${sep}Foo\.ready$}, "Got full path");
is_deeply(
$got[0],
$ipc->parse_event_filename(join ipc_separator, $hid, qw"123 456 789 Event Type Foo.ready"),
"Apart from full_path we get entire parsed filename"
);
$ipc = undef;
}
done_testing;
PK 1��\��� � t/Test2/modules/IPC/Driver.tnu �[��� use strict;
use warnings;
use Test2::IPC::Driver::Files;
use Test2::Tools::Tiny;
use Test2::API qw/context test2_ipc_drivers/;
Test2::IPC::Driver::Files->import();
Test2::IPC::Driver::Files->import();
Test2::IPC::Driver::Files->import();
is_deeply(
[test2_ipc_drivers()],
['Test2::IPC::Driver::Files'],
"Driver not added multiple times"
);
for my $meth (qw/send cull add_hub drop_hub waiting is_viable/) {
my $one = Test2::IPC::Driver->new;
like(
exception { $one->$meth },
qr/'\Q$one\E' did not define the required method '$meth'/,
"Require override of method $meth"
);
}
SKIP: {
last SKIP if $] lt "5.008";
tests abort => sub {
my $one = Test2::IPC::Driver->new(no_fatal => 1);
my ($err, $out) = ("", "");
{
local *STDERR;
local *STDOUT;
open(STDERR, '>', \$err);
open(STDOUT, '>', \$out);
$one->abort('foo');
}
is($err, "IPC Fatal Error: foo\n", "Got error");
is($out, "Bail out! IPC Fatal Error: foo\n", "got 'bail-out' on stdout");
($err, $out) = ("", "");
{
local *STDERR;
local *STDOUT;
open(STDERR, '>', \$err);
open(STDOUT, '>', \$out);
$one->abort_trace('foo');
}
like($out, qr/Bail out! IPC Fatal Error: foo/, "got 'bail-out' on stdout");
like($err, qr/IPC Fatal Error: foo/, "Got error");
};
}
done_testing;
PK 1��\�h8� t/Test2/modules/Tools/Tiny.tnu �[��� use strict;
use warnings;
use Test2::IPC;
use Test2::Tools::Tiny;
use Test2::API qw/context intercept test2_stack/;
ok(__PACKAGE__->can($_), "imported '$_\()'") for qw{
ok
is isnt
like unlike
diag note
is_deeply
warnings
exception
plan
skip_all
done_testing
};
ok(1, "'ok' Test");
is("foo", "foo", "'is' test");
is(undef, undef, "'is' undef test");
isnt("foo", "bar", "'isnt' test");
isnt("foo", undef, "'isnt' undef test 1");
isnt(undef, "foo", "'isnt' undef test 2");
like("foo", qr/o/, "'like' test");
unlike("foo", qr/a/, "'unlike' test");
note("Testing Note");
my $str = "abc";
is_deeply(
{ a => 1, b => 2, c => { ref => \$str, obj => bless({x => 1}, 'XXX'), array => [1, 2, 3]}},
{ a => 1, b => 2, c => { ref => \$str, obj => {x => 1}, array => [1, 2, 3]}},
"'is_deeply' test"
);
is_deeply(
warnings { warn "aaa\n"; warn "bbb\n" },
[ "aaa\n", "bbb\n" ],
"Got warnings"
);
is_deeply(
warnings { 1 },
[],
"no warnings"
);
is(exception { die "foo\n" }, "foo\n", "got exception");
is(exception { 1 }, undef, "no exception");
my $main_events = intercept {
plan 8;
ok(0, "'ok' Test");
is("foo", "bar", "'is' test");
isnt("foo", "foo", "'isnt' test");
like("foo", qr/a/, "'like' test");
unlike("foo", qr/o/, "'unlike' test");
is_deeply(
{ a => 1, b => 2, c => {}},
{ a => 1, b => 2, c => []},
"'is_deeply' test"
);
};
my $other_events = intercept {
diag("Testing Diag");
note("Testing Note");
};
my ($plan, $ok, $is, $isnt, $like, $unlike, $is_deeply) = grep {!$_->isa('Test2::Event::Diag')} @$main_events;
my ($diag, $note) = @$other_events;
ok($plan->isa('Test2::Event::Plan'), "got plan");
is($plan->max, 8, "planned for 8 oks");
ok($ok->isa('Test2::Event::Fail'), "got 'ok' result");
is($ok->facets->{assert}->pass, 0, "'ok' test failed");
ok($is->isa('Test2::Event::Fail'), "got 'is' result");
is($ok->facets->{assert}->pass, 0, "test failed");
ok($isnt->isa('Test2::Event::Fail'), "got 'isnt' result");
is($ok->facets->{assert}->pass, 0, "test failed");
ok($like->isa('Test2::Event::Fail'), "got 'like' result");
is($ok->facets->{assert}->pass, 0, "test failed");
ok($unlike->isa('Test2::Event::Fail'), "got 'unlike' result");
is($ok->facets->{assert}->pass, 0, "test failed");
ok($is_deeply->isa('Test2::Event::Fail'), "got 'is_deeply' result");
is($ok->facets->{assert}->pass, 0, "test failed");
ok($diag->isa('Test2::Event::Diag'), "got 'diag' result");
is($diag->message, "Testing Diag", "got diag message");
ok($note->isa('Test2::Event::Note'), "got 'note' result");
is($note->message, "Testing Note", "got note message");
my $events = intercept {
skip_all 'because';
ok(0, "should not see me");
die "should not happen";
};
is(@$events, 1, "1 event");
ok($events->[0]->isa('Test2::Event::Plan'), "got plan");
is($events->[0]->directive, 'SKIP', "plan is skip");
is($events->[0]->reason, 'because', "skip reason");
$events = intercept {
is(undef, "");
is("", undef);
isnt(undef, undef);
like(undef, qr//);
unlike(undef, qr//);
};
@$events = grep {!$_->isa('Test2::Event::Diag')} @$events;
is(@$events, 5, "5 events");
ok(!$_->facets->{assert}->pass, "undef test - should not pass") for @$events;
sub tool { context() };
my %params;
my $ctx = context(level => -1);
my $ictx;
$events = intercept {
%params = @_;
$ictx = tool();
$ictx->ok(1, 'pass');
$ictx->ok(0, 'fail');
my $trace = Test2::EventFacet::Trace->new(
frame => [ __PACKAGE__, __FILE__, __LINE__],
);
$ictx->hub->finalize($trace, 1);
};
@$events = grep {!$_->isa('Test2::Event::Diag')} @$events;
is_deeply(
\%params,
{
context => { %$ctx, _is_canon => undef, _is_spawn => undef, _aborted => undef },
hub => $ictx->hub,
},
"Passed in some useful params"
);
ok($ctx != $ictx, "Different context inside intercept");
is(@$events, 3, "got 3 events");
$ctx->release;
$ictx->release;
# Test that a bail-out in an intercept does not exit.
$events = intercept {
$ictx = tool();
$ictx->bail("The world ends");
$ictx->ok(0, "Should not see this");
};
is(@$events, 1, "got 1 event");
ok($events->[0]->isa('Test2::Event::Bail'), "got the bail");
$events = intercept {
$ictx = tool();
};
$ictx->release;
like(
exception { intercept { die 'foo' } },
qr/foo/,
"Exception was propogated"
);
$events = intercept {
test2_stack()->top->set_no_ending(0);
ok(1);
};
is(@$events, 2, "2 events");
ok($events->[0]->isa('Test2::Event::Pass'), "got a pass");
ok($events->[1]->isa('Test2::Event::Plan'), "finalize was called");
$events = intercept {
test2_stack()->top->set_no_ending(0);
ok(1);
done_testing;
};
is(@$events, 2, "2 events");
ok($events->[0]->isa('Test2::Event::Pass'), "got a pass");
ok($events->[1]->isa('Test2::Event::Plan'), "finalize was called (only 1 plan)");
done_testing;
PK 1��\a < < # t/Test2/modules/Util/ExternalMeta.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
{
package Foo::Bar;
use Test2::Util::ExternalMeta;
use Test2::Util::HashBase qw/foo bar/;
}
ok(Foo::Bar->can($_), "Imported '$_'") for qw/meta get_meta set_meta delete_meta/;
my $one = Foo::Bar->new(foo => 1, bar => 2);
ok($one->isa('Foo::Bar'), "Got instance");
is_deeply($one, {foo => 1, bar => 2}, "nothing fishy.. yet");
is($one->get_meta('foo'), undef, "no meta-data for foo");
is($one->get_meta('bar'), undef, "no meta-data for bar");
is($one->get_meta('baz'), undef, "no meta-data for baz");
is($one->meta('foo'), undef, "no meta-data for foo");
is($one->meta('bar'), undef, "no meta-data for bar");
is($one->meta('baz'), undef, "no meta-data for baz");
is_deeply($one, {foo => 1, bar => 2}, "Still have not modified instance");
$one->set_meta('foo' => 123);
is($one->foo, 1, "did not change attribute");
is($one->meta('foo'), 123, "get meta-data for foo");
is($one->get_meta('foo'), 123, "get meta-data for foo again");
$one->meta('foo', 345);
is($one->foo, 1, "did not change attribute");
is($one->meta('foo', 678), 123, "did not alter already set meta-attribute");
is($one->get_meta('foo'), 123, "still did not alter already set meta-attribute");
is($one->meta('bar', 789), 789, "used default for bar");
is($one->bar, 2, "did not change attribute");
is_deeply(
$one,
{
foo => 1,
bar => 2,
Test2::Util::ExternalMeta::META_KEY() => {
foo => 123,
bar => 789,
},
},
"Stored meta-data"
);
is($one->delete_meta('foo'), 123, "got old value on delete");
is($one->meta('foo'), undef, "no more value");
is_deeply(
$one,
{
foo => 1,
bar => 2,
Test2::Util::ExternalMeta::META_KEY() => {
bar => 789,
},
},
"Deleted the meta key"
);
done_testing;
PK 1��\q-�6r r $ t/Test2/modules/Util/Facets2Legacy.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::Util::Facets2Legacy ':ALL';
my $CLASS;
BEGIN {
$CLASS = 'Test2::Util::Facets2Legacy';
# This private function is not exported, but we want to test it anyway
*_get_facet_data = $CLASS->can('_get_facet_data');
}
tests _get_facet_data => sub {
my $pass = Test2::Event::Pass->new(name => 'xxx');
is_deeply(
_get_facet_data($pass),
{
about => {package => 'Test2::Event::Pass', details => 'pass', eid => $pass->eid},
assert => {pass => 1, details => 'xxx'},
},
"Got facet data from event"
);
is_deeply(
_get_facet_data({assert => {pass => 1}}),
{assert => {pass => 1}},
"Facet data gets passed through"
);
my $file = __FILE__;
my $line;
like(
exception { $line = __LINE__; _get_facet_data([]) },
qr/'ARRAY\(.*\)' Does not appear to be either a Test::Event or an EventFacet hashref at \Q$file\E line $line/,
"Must provide sane input data"
);
{
package Fake::Event;
use base 'Test2::Event';
use Test2::Util::Facets2Legacy qw/causes_fail/;
}
my $e = Fake::Event->new();
like(
exception { $line = __LINE__; $e->causes_fail },
qr/Cycle between Facets2Legacy and Fake::Event=HASH\(.*\)->facet_data\(\) \(Did you forget to override the facet_data\(\) method\?\)/,
"Cannot depend on legacy facet_data and Facets2Legacy"
);
};
tests causes_fail => sub {
is(causes_fail({errors => [{fail => 1}]}), 1, "Fatal errors cause failure");
is(causes_fail({control => {terminate => 0}}), 0, "defined but 0 termination does not cause failure");
is(causes_fail({control => {terminate => 1}}), 1, "non-zero defined termination causes failure");
is(causes_fail({control => {halt => 1}}), 1, "A halt causes failure");
is(causes_fail({assert => {pass => 0}}), 1, "non-passign assert causes failure");
is(causes_fail({assert => {pass => 0}, amnesty => [{}]}), 0, "amnesty prevents assertion failure");
is(causes_fail({}), 0, "Default is no failure");
};
tests diagnostics => sub {
is(diagnostics({}), 0, "Default is no");
is(diagnostics({errors => [{}]}), 1, "Errors mean diagnostics");
is(diagnostics({info => [{}]}), 0, "Info alone does not make diagnostics");
is(diagnostics({info => [{debug => 1}]}), 1, "Debug flag makes info diagnostics");
};
tests global => sub {
is(global({}), 0, "not global by default");
is(global({control => {global => 0}}), 0, "global not set");
is(global({control => {global => 1}}), 1, "global is set");
};
tests increments_count => sub {
is(increments_count({}), 0, "No count bump without an assertion");
is(increments_count({assert => {}}), 1, "count bump with assertion");
};
tests no_display => sub {
is(no_display({}), 0, "default is no");
is(no_display({about => {no_display => 0}}), 0, "set to off");
is(no_display({about => {no_display => 1}}), 1, "set to on");
};
tests subtest_id => sub {
is(subtest_id({}), undef, "none by default");
is(subtest_id({parent => {hid => 123}}), 123, "use parent hid when present");
};
tests summary => sub {
is(summary({}), '', "no summary without about->details");
is(summary({about => {details => 'foo'}}), 'foo', "got about->details");
};
tests terminate => sub {
is(terminate({}), undef, "undef by default");
is(terminate({control => {terminate => undef}}), undef, "undef by choice");
is(terminate({control => {terminate => 100}}), 100, "got the terminate value");
is(terminate({control => {terminate => 0}}), 0, "0 is passed through");
};
tests sets_plan => sub {
is_deeply( [sets_plan({})], [], "No plan by default");
is_deeply(
[sets_plan({plan => {}})],
[0],
"Empty plan means count of 0, nothing extra"
);
is_deeply(
[sets_plan({plan => {count => 100}})],
[100],
"Got simple count"
);
is_deeply(
[sets_plan({plan => {count => 0, none => 1}})],
[0, 'NO PLAN'],
"No Plan"
);
is_deeply(
[sets_plan({plan => {count => 0, skip => 1}})],
[0, 'SKIP'],
"Skip"
);
is_deeply(
[sets_plan({plan => {count => 0, skip => 1, details => 'foo bar'}})],
[0, 'SKIP', 'foo bar'],
"Skip with reason"
);
};
done_testing;
PK 1��\c�&S� � t/Test2/modules/Util/Trace.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::EventFacet::Trace;
like(
exception { 'Test2::EventFacet::Trace'->new() },
qr/The 'frame' attribute is required/,
"got error"
);
my $one = 'Test2::EventFacet::Trace'->new(frame => ['Foo::Bar', 'foo.t', 5, 'Foo::Bar::foo']);
is_deeply($one->frame, ['Foo::Bar', 'foo.t', 5, 'Foo::Bar::foo'], "Got frame");
is_deeply([$one->call], ['Foo::Bar', 'foo.t', 5, 'Foo::Bar::foo'], "Got call");
is($one->package, 'Foo::Bar', "Got package");
is($one->file, 'foo.t', "Got file");
is($one->line, 5, "Got line");
is($one->subname, 'Foo::Bar::foo', "got subname");
is($one->debug, "at foo.t line 5", "got trace");
$one->set_detail("yo momma");
is($one->debug, "yo momma", "got detail for trace");
$one->set_detail(undef);
is(
exception { $one->throw('I died') },
"I died at foo.t line 5.\n",
"got exception"
);
is_deeply(
warnings { $one->alert('I cried') },
[ "I cried at foo.t line 5.\n" ],
"alter() warns"
);
my $snap = $one->snapshot;
is_deeply($snap, $one, "identical");
ok($snap != $one, "Not the same instance");
done_testing;
PK 1��\Ԋ���" �" t/Test2/modules/API.tnu �[��� use strict;
use warnings;
use Test2::API qw/context/;
my ($LOADED, $INIT);
BEGIN {
$INIT = Test2::API::test2_init_done;
$LOADED = Test2::API::test2_load_done;
};
use Test2::IPC;
use Test2::Tools::Tiny;
use Test2::Util qw/get_tid/;
my $CLASS = 'Test2::API';
# Ensure we do not break backcompat later by removing anything
ok(Test2::API->can($_), "$_ method is present") for qw{
context_do
no_context
test2_init_done
test2_load_done
test2_pid
test2_tid
test2_stack
test2_no_wait
test2_add_callback_context_init
test2_add_callback_context_release
test2_add_callback_exit
test2_add_callback_post_load
test2_list_context_init_callbacks
test2_list_context_release_callbacks
test2_list_exit_callbacks
test2_list_post_load_callbacks
test2_ipc
test2_ipc_disable
test2_ipc_disabled
test2_ipc_drivers
test2_ipc_add_driver
test2_ipc_polling
test2_ipc_disable_polling
test2_ipc_enable_polling
test2_formatter
test2_formatters
test2_formatter_add
test2_formatter_set
};
ok(!$LOADED, "Was not load_done right away");
ok(!$INIT, "Init was not done right away");
ok(Test2::API::test2_load_done, "We loaded it");
# Note: This is a check that stuff happens in an END block.
{
{
package FOLLOW;
sub DESTROY {
return if $_[0]->{fixed};
print "not ok - Did not run end ($_[0]->{name})!";
$? = 255;
exit 255;
}
}
our $kill1 = bless {fixed => 0, name => "Custom Hook"}, 'FOLLOW';
Test2::API::test2_add_callback_exit(
sub {
print "# Running END hook\n";
$kill1->{fixed} = 1;
}
);
our $kill2 = bless {fixed => 0, name => "set exit"}, 'FOLLOW';
my $old = Test2::API::Instance->can('set_exit');
no warnings 'redefine';
*Test2::API::Instance::set_exit = sub {
$kill2->{fixed} = 1;
print "# Running set_exit\n";
$old->(@_);
};
}
ok($CLASS->can('test2_init_done')->(), "init is done.");
ok($CLASS->can('test2_load_done')->(), "Test2 is finished loading");
is($CLASS->can('test2_pid')->(), $$, "got pid");
is($CLASS->can('test2_tid')->(), get_tid(), "got tid");
ok($CLASS->can('test2_stack')->(), 'got stack');
is($CLASS->can('test2_stack')->(), $CLASS->can('test2_stack')->(), "always get the same stack");
ok($CLASS->can('test2_ipc')->(), 'got ipc');
is($CLASS->can('test2_ipc')->(), $CLASS->can('test2_ipc')->(), "always get the same IPC");
is_deeply([$CLASS->can('test2_ipc_drivers')->()], [qw/Test2::IPC::Driver::Files/], "Got driver list");
# Verify it reports to the correct file/line, there was some trouble with this...
my $file = __FILE__;
my $line = __LINE__ + 1;
my $warnings = warnings { $CLASS->can('test2_ipc_add_driver')->('fake') };
my $sub1 = sub {
like(
$warnings->[0],
qr{^IPC driver fake loaded too late to be used as the global ipc driver at \Q$file\E line $line},
"got warning about adding driver too late"
);
};
if ($] le "5.006002") {
todo("TODO known to fail on $]", $sub1);
} else {
$sub1->();
}
is_deeply([$CLASS->can('test2_ipc_drivers')->()], [qw/fake Test2::IPC::Driver::Files/], "Got updated list");
ok($CLASS->can('test2_ipc_polling')->(), "Polling is on");
$CLASS->can('test2_ipc_disable_polling')->();
ok(!$CLASS->can('test2_ipc_polling')->(), "Polling is off");
$CLASS->can('test2_ipc_enable_polling')->();
ok($CLASS->can('test2_ipc_polling')->(), "Polling is on");
ok($CLASS->can('test2_formatter')->(), "Got a formatter");
is($CLASS->can('test2_formatter')->(), $CLASS->can('test2_formatter')->(), "always get the same Formatter (class name)");
my $ran = 0;
$CLASS->can('test2_add_callback_post_load')->(sub { $ran++ });
is($ran, 1, "ran the post-load");
like(
exception { $CLASS->can('test2_formatter_set')->() },
qr/No formatter specified/,
"formatter_set requires an argument"
);
like(
exception { $CLASS->can('test2_formatter_set')->('fake') },
qr/Global Formatter already set/,
"formatter_set doesn't work after initialization",
);
ok(!$CLASS->can('test2_no_wait')->(), "no_wait is not set");
$CLASS->can('test2_no_wait')->(1);
ok($CLASS->can('test2_no_wait')->(), "no_wait is set");
$CLASS->can('test2_no_wait')->(undef);
ok(!$CLASS->can('test2_no_wait')->(), "no_wait is not set");
ok($CLASS->can('test2_ipc_wait_enabled')->(), "IPC waiting enabled");
$CLASS->can('test2_ipc_wait_disable')->();
ok(!$CLASS->can('test2_ipc_wait_enabled')->(), "IPC waiting disabled");
$CLASS->can('test2_ipc_wait_enable')->();
ok($CLASS->can('test2_ipc_wait_enabled')->(), "IPC waiting enabled");
my $pctx;
sub tool_a($;$) {
Test2::API::context_do {
my $ctx = shift;
my ($bool, $name) = @_;
$pctx = wantarray;
die "xyz" unless $bool;
$ctx->ok($bool, $name);
return unless defined $pctx;
return (1, 2) if $pctx;
return 'a';
} @_;
}
$pctx = 'x';
tool_a(1, "void context test");
ok(!defined($pctx), "void context");
my $x = tool_a(1, "scalar context test");
ok(defined($pctx) && $pctx == 0, "scalar context");
is($x, 'a', "got scalar return");
my @x = tool_a(1, "array context test");
ok($pctx, "array context");
is_deeply(\@x, [1, 2], "Got array return");
like(
exception { tool_a(0) },
qr/^xyz/,
"got exception"
);
sub {
my $outer = context();
sub {
my $middle = context();
is($outer->trace, $middle->trace, "got the same context before calling no_context");
Test2::API::no_context {
my $inner = context();
ok($inner->trace != $outer->trace, "Got a different context inside of no_context()");
$inner->release;
};
$middle->release;
}->();
$outer->release;
}->();
sub {
my $outer = context();
sub {
my $middle = context();
is($outer->trace, $middle->trace, "got the same context before calling no_context");
Test2::API::no_context {
my $inner = context();
ok($inner->trace != $outer->trace, "Got a different context inside of no_context({}, hid)");
$inner->release;
} $outer->hub->hid;
$middle->release;
}->();
$outer->release;
}->();
sub {
my @warnings;
my $outer = context();
sub {
my $middle = context();
is($outer->trace, $middle->trace, "got the same context before calling no_context");
local $SIG{__WARN__} = sub { push @warnings => @_ };
Test2::API::no_context {
my $inner = context();
ok($inner->trace != $outer->trace, "Got a different context inside of no_context({}, hid)");
} $outer->hub->hid;
$middle->release;
}->();
$outer->release;
is(@warnings, 1, "1 warning");
like(
$warnings[0],
qr/A context appears to have been destroyed without first calling release/,
"Got warning about unreleased context"
);
}->();
sub {
my $hub = Test2::Hub->new();
my $ctx = context(hub => $hub);
is($ctx->hub,$hub, 'got the hub of context() argument');
$ctx->release;
}->();
my $sub = sub { };
Test2::API::test2_add_callback_context_acquire($sub);
Test2::API::test2_add_callback_context_init($sub);
Test2::API::test2_add_callback_context_release($sub);
Test2::API::test2_add_callback_exit($sub);
Test2::API::test2_add_callback_post_load($sub);
is((grep { $_ == $sub } Test2::API::test2_list_context_acquire_callbacks()), 1, "got the one instance of the hook");
is((grep { $_ == $sub } Test2::API::test2_list_context_init_callbacks()), 1, "got the one instance of the hook");
is((grep { $_ == $sub } Test2::API::test2_list_context_release_callbacks()), 1, "got the one instance of the hook");
is((grep { $_ == $sub } Test2::API::test2_list_exit_callbacks()), 1, "got the one instance of the hook");
is((grep { $_ == $sub } Test2::API::test2_list_post_load_callbacks()), 1, "got the one instance of the hook");
Test2::API::test2_add_callback_context_acquire($sub);
Test2::API::test2_add_callback_context_init($sub);
Test2::API::test2_add_callback_context_release($sub);
Test2::API::test2_add_callback_exit($sub);
Test2::API::test2_add_callback_post_load($sub);
is((grep { $_ == $sub } Test2::API::test2_list_context_acquire_callbacks()), 2, "got the two instances of the hook");
is((grep { $_ == $sub } Test2::API::test2_list_context_init_callbacks()), 2, "got the two instances of the hook");
is((grep { $_ == $sub } Test2::API::test2_list_context_release_callbacks()), 2, "got the two instances of the hook");
is((grep { $_ == $sub } Test2::API::test2_list_exit_callbacks()), 2, "got the two instances of the hook");
is((grep { $_ == $sub } Test2::API::test2_list_post_load_callbacks()), 2, "got the two instances of the hook");
done_testing;
PK 1��\���>T >T t/Test2/modules/Event.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::Event();
use Test2::EventFacet::Trace();
use Test2::Event::Generic;
use Test2::API qw/context/;
use Scalar::Util qw/reftype/;
tests old_api => sub {
{
package My::MockEvent;
use base 'Test2::Event';
use Test2::Util::HashBase qw/foo bar baz/;
}
ok(My::MockEvent->can($_), "Added $_ accessor") for qw/foo bar baz/;
my $one = My::MockEvent->new(trace => 'fake');
ok(!$one->causes_fail, "Events do not cause failures by default");
ok(!$one->$_, "$_ is false by default") for qw/increments_count terminate global/;
ok(!$one->get_meta('xxx'), "no meta-data associated for key 'xxx'");
$one->set_meta('xxx', '123');
is($one->meta('xxx'), '123', "got meta-data");
is($one->meta('xxx', '321'), '123', "did not use default");
is($one->meta('yyy', '1221'), '1221', "got the default");
is($one->meta('yyy'), '1221', "last call set the value to the default for future use");
is($one->summary, 'My::MockEvent', "Default summary is event package");
is($one->diagnostics, 0, "Not diagnostics by default");
};
tests deprecated => sub {
my $e = Test2::Event->new(trace => Test2::EventFacet::Trace->new(frame => ['foo', 'foo.pl', 42], nested => 2, hid => 'maybe'));
my $warnings = warnings {
local $ENV{AUTHOR_TESTING} = 1;
is($e->nested, 2, "Got nested from the trace");
is($e->in_subtest, 'maybe', "got hid from trace");
$e->trace->{nested} = 0;
local $ENV{AUTHOR_TESTING} = 0;
is($e->nested, 0, "Not nested");
is($e->in_subtest, undef, "Did not get hid");
};
is(@$warnings, 2, "got warnings once each");
like($warnings->[0], qr/Use of Test2::Event->nested\(\) is deprecated/, "Warned about deprecation");
like($warnings->[1], qr/Use of Test2::Event->in_subtest\(\) is deprecated/, "Warned about deprecation");
};
tests facet_data => sub {
my $e = Test2::Event::Generic->new(
causes_fail => 0,
increments_count => 0,
diagnostics => 0,
no_display => 0,
callback => undef,
terminate => undef,
global => undef,
sets_plan => undef,
summary => undef,
facet_data => undef,
);
is_deeply(
$e->facet_data,
{
about => {
package => 'Test2::Event::Generic',
details => 'Test2::Event::Generic',
eid => $e->eid,
no_display => undef,
},
control => {
has_callback => 0,
terminate => undef,
global => 0
},
},
"Facet data has control with only false values, and an about"
);
$e->set_trace(Test2::EventFacet::Trace->new(frame => ['foo', 'foo.t', 42]));
is_deeply(
$e->facet_data,
{
about => {
package => 'Test2::Event::Generic',
details => 'Test2::Event::Generic',
eid => $e->eid,
no_display => undef,
},
control => {
has_callback => 0,
terminate => undef,
global => 0
},
trace => {
frame => ['foo', 'foo.t', 42],
pid => $$,
tid => 0,
},
},
"Got a trace now"
);
$e->set_causes_fail(1);
is_deeply(
$e->facet_data,
{
about => {
package => 'Test2::Event::Generic',
details => 'Test2::Event::Generic',
eid => $e->eid,
no_display => undef
},
control => {
has_callback => 0,
terminate => undef,
global => 0
},
trace => {
frame => ['foo', 'foo.t', 42],
pid => $$,
tid => 0,
},
errors => [
{
tag => 'FAIL',
details => 'Test2::Event::Generic',
fail => 1,
}
],
},
"Got an error"
);
$e->set_increments_count(1);
is_deeply(
$e->facet_data,
{
about => {
package => 'Test2::Event::Generic',
details => 'Test2::Event::Generic',
eid => $e->eid,
no_display => undef
},
control => {
has_callback => 0,
terminate => undef,
global => 0
},
trace => {
frame => ['foo', 'foo.t', 42],
pid => $$,
tid => 0,
},
assert => {
no_debug => 1,
pass => 0,
details => 'Test2::Event::Generic',
},
},
"Got an assert now"
);
$e->set_causes_fail(0);
is_deeply(
$e->facet_data,
{
about => {
package => 'Test2::Event::Generic',
details => 'Test2::Event::Generic',
eid => $e->eid,
no_display => undef
},
control => {
has_callback => 0,
terminate => undef,
global => 0
},
trace => {
frame => ['foo', 'foo.t', 42],
pid => $$,
tid => 0,
},
assert => {
no_debug => 1,
pass => 1,
details => 'Test2::Event::Generic',
},
},
"Got a passing assert now"
);
$e->set_global(1);
$e->set_terminate(255);
$e->set_callback(sub {1});
is_deeply(
$e->facet_data,
{
about => {
package => 'Test2::Event::Generic',
details => 'Test2::Event::Generic',
eid => $e->eid,
no_display => undef
},
control => {
has_callback => 1,
terminate => 255,
global => 1,
},
trace => {
frame => ['foo', 'foo.t', 42],
pid => $$,
tid => 0,
},
assert => {
no_debug => 1,
pass => 1,
details => 'Test2::Event::Generic',
},
},
"control fields were altered"
);
my $data;
{
no warnings 'once';
local *Test2::Event::Generic::subtest_id = sub { 123 };
$data = $e->facet_data;
}
is_deeply(
$data,
{
about => {
package => 'Test2::Event::Generic',
details => 'Test2::Event::Generic',
eid => $e->eid,
no_display => undef
},
control => {
has_callback => 1,
terminate => 255,
global => 1,
},
trace => {
frame => ['foo', 'foo.t', 42],
pid => $$,
tid => 0,
},
assert => {
no_debug => 1,
pass => 1,
details => 'Test2::Event::Generic',
},
parent => {hid => 123},
},
"Added parent"
);
$e->set_meta('foo', {a => 1});
is_deeply(
$e->facet_data,
{
about => {
package => 'Test2::Event::Generic',
details => 'Test2::Event::Generic',
eid => $e->eid,
no_display => undef
},
control => {
has_callback => 1,
terminate => 255,
global => 1,
},
trace => {
frame => ['foo', 'foo.t', 42],
pid => $$,
tid => 0,
},
assert => {
no_debug => 1,
pass => 1,
details => 'Test2::Event::Generic',
},
meta => {foo => {a => 1}},
},
"Grabbed meta"
);
$e->set_sets_plan([5]);
is_deeply(
$e->facet_data,
{
about => {
package => 'Test2::Event::Generic',
details => 'Test2::Event::Generic',
eid => $e->eid,
no_display => undef
},
control => {
has_callback => 1,
terminate => 255,
global => 1,
},
trace => {
frame => ['foo', 'foo.t', 42],
pid => $$,
tid => 0,
},
assert => {
no_debug => 1,
pass => 1,
details => 'Test2::Event::Generic',
},
meta => {foo => {a => 1}},
plan => { count => 5 },
},
"Plan facet added"
);
$e->set_terminate(undef);
$e->set_sets_plan([0, SKIP => 'because']);
is_deeply(
$e->facet_data,
{
about => {
package => 'Test2::Event::Generic',
details => 'Test2::Event::Generic',
eid => $e->eid,
no_display => undef
},
control => {
has_callback => 1,
terminate => 0,
global => 1,
},
trace => {
frame => ['foo', 'foo.t', 42],
pid => $$,
tid => 0,
},
assert => {
no_debug => 1,
pass => 1,
details => 'Test2::Event::Generic',
},
meta => {foo => {a => 1}},
plan => { count => 0, skip => 1, details => 'because' },
},
"Plan set terminate, skip, and details"
);
$e->set_sets_plan([0, 'NO PLAN' => 'because']);
is_deeply(
$e->facet_data,
{
about => {
package => 'Test2::Event::Generic',
details => 'Test2::Event::Generic',
eid => $e->eid,
no_display => undef
},
control => {
has_callback => 1,
terminate => undef,
global => 1,
},
trace => {
frame => ['foo', 'foo.t', 42],
pid => $$,
tid => 0,
},
assert => {
no_debug => 1,
pass => 1,
details => 'Test2::Event::Generic',
},
meta => {foo => {a => 1}},
plan => { count => 0, none => 1, details => 'because' },
},
"Plan does not set terminate, but sets 'none' and 'details'"
);
$e->add_amnesty({tag => 'foo', details => 'bar'});
$e->add_amnesty({tag => 'baz', details => 'bat'});
is_deeply(
$e->facet_data,
{
about => {
package => 'Test2::Event::Generic',
details => 'Test2::Event::Generic',
eid => $e->eid,
no_display => undef
},
control => {
has_callback => 1,
terminate => undef,
global => 1,
},
trace => {
frame => ['foo', 'foo.t', 42],
pid => $$,
tid => 0,
},
assert => {
no_debug => 1,
pass => 1,
details => 'Test2::Event::Generic',
},
meta => {foo => {a => 1}},
plan => { count => 0, none => 1, details => 'because' },
amnesty => [
{ tag => 'foo', details => 'bar' },
{ tag => 'baz', details => 'bat' },
],
},
"Amnesty added"
);
$e = Test2::Event::Generic->new();
$e->set_diagnostics(1);
$e->set_no_display(1);
is_deeply(
$e->facet_data,
{
about => {
package => 'Test2::Event::Generic',
details => 'Test2::Event::Generic',
eid => $e->eid,
no_display => 1,
},
control => {
has_callback => 0,
terminate => undef,
global => 0,
},
},
"No Info"
);
$e->set_no_display(0);
is_deeply(
$e->facet_data,
{
about => {
package => 'Test2::Event::Generic',
details => 'Test2::Event::Generic',
eid => $e->eid,
no_display => undef,
},
control => {
has_callback => 0,
terminate => undef,
global => 0,
},
info => [{
details => 'Test2::Event::Generic',
tag => 'DIAG',
debug => 1,
}],
},
"Got debug Info"
);
$e->set_summary("foo bar baz");
is_deeply(
$e->facet_data,
{
about => {
package => 'Test2::Event::Generic',
details => 'foo bar baz',
eid => $e->eid,
no_display => undef,
},
control => {
has_callback => 0,
terminate => undef,
global => 0,
},
info => [{
details => 'foo bar baz',
tag => 'DIAG',
debug => 1,
}],
},
"Got debug Info with summary change"
);
};
tests facets => sub {
my $data = {
about => {
package => 'Test2::Event::Generic',
details => 'Test2::Event::Generic',
no_display => undef
},
control => {
has_callback => 1,
terminate => undef,
global => 1,
},
trace => {
frame => ['foo', 'foo.t', 42],
pid => $$,
tid => 0,
},
assert => {
no_debug => 1,
pass => 1,
details => 'Test2::Event::Generic',
},
meta => {foo => {a => 1}},
plan => {count => 0, none => 1, details => 'because'},
parent => {hid => 123, children => []},
amnesty => [
{tag => 'foo', details => 'bar'},
{tag => 'baz', details => 'bat'},
],
info => [
{
details => 'foo bar baz',
tag => 'DIAG',
debug => 1,
}
],
errors => [{
tag => 'FAIL',
details => 'Test2::Event::Generic',
fail => 1,
}],
};
my $e = Test2::Event::Generic->new(facet_data => $data);
is_deeply(
$e->facet_data,
$e->facets,
"Facets and facet_data have the same structure"
);
my $facets = $e->facets;
for my $key (sort keys %$facets) {
my $type = "Test2::EventFacet::" . ucfirst($key);
$type =~ s/s$//;
my $val = $facets->{$key};
if ($type->is_list) {
for my $f (@$val) {
ok($f->isa('Test2::EventFacet'), "'$key' has a blessed facet");
ok($f->isa("$type"), "'$key' is a '$type'") or diag("$f");
}
}
else {
ok($val->isa('Test2::EventFacet'), "'$key' has a blessed facet");
ok($val->isa($type), "'$key' is a '$type'");
}
}
};
tests common_facet_data => sub {
my $e = Test2::Event::Generic->new(
causes_fail => 0,
increments_count => 0,
diagnostics => 0,
no_display => 0,
callback => undef,
terminate => undef,
global => undef,
sets_plan => undef,
summary => undef,
facet_data => undef,
);
is_deeply(
$e->common_facet_data,
{
about => {
package => 'Test2::Event::Generic',
eid => $e->eid,
},
},
"Facet data has an about"
);
$e->set_trace(Test2::EventFacet::Trace->new(frame => ['foo', 'foo.t', 42]));
is_deeply(
$e->common_facet_data,
{
about => {
package => 'Test2::Event::Generic',
eid => $e->eid,
},
trace => {
frame => ['foo', 'foo.t', 42],
pid => $$,
tid => 0,
},
},
"Got a trace now"
);
$e->set_meta('foo', {a => 1});
is_deeply(
$e->common_facet_data,
{
about => {
package => 'Test2::Event::Generic',
eid => $e->eid,
},
trace => {
frame => ['foo', 'foo.t', 42],
pid => $$,
tid => 0,
},
meta => {foo => {a => 1}},
},
"Grabbed meta"
);
$e->add_amnesty({tag => 'foo', details => 'bar'});
$e->add_amnesty({tag => 'baz', details => 'bat'});
is_deeply(
$e->common_facet_data,
{
about => {
package => 'Test2::Event::Generic',
eid => $e->eid,
},
trace => {
frame => ['foo', 'foo.t', 42],
pid => $$,
tid => 0,
},
meta => {foo => {a => 1}},
amnesty => [
{tag => 'foo', details => 'bar'},
{tag => 'baz', details => 'bat'},
],
},
"Amnesty added"
);
};
tests related => sub {
my $ctx = context();
my $ev_a = $ctx->build_ev2(about => {});
my $ev_b = $ctx->build_ev2(about => {});
$ctx->release;
$ctx = context();
my $ev_c = $ctx->build_ev2(about => {});
$ctx->release;
delete $ev_a->{trace}->{uuid};
delete $ev_b->{trace}->{uuid};
delete $ev_c->{trace}->{uuid};
ok($ev_a->related($ev_b), "Related as they were created with the same context (no uuid)");
ok(!$ev_a->related($ev_c), "Not related as they were created with a different context (no uuid)");
$ev_a->{trace}->{uuid} = 'xxx'; # Yes I know it is not valid.
$ev_b->{trace}->{uuid} = 'yyy'; # Yes I know it is not valid.
$ev_c->{trace}->{uuid} = 'xxx'; # Yes I know it is not valid.
ok(!$ev_a->related($ev_b), "Not related, traces have different UUID's");
ok($ev_a->related($ev_c), "Related, traces have the same UUID's");
};
tests verify_facet_data => sub {
my $ev1 = Test2::Event::V2->new(
assert => { pass => 1 },
info => [{tag => 'NOTE', details => 'oops' }],
'a custom one' => {},
);
is_deeply(
[$ev1->validate_facet_data],
[],
"No errors"
);
my $ev2 = Test2::Event::V2->new(
assert => [{ pass => 1 }],
info => {tag => 'NOTE', details => 'oops' },
'a custom one' => {},
);
my @errors = $ev2->validate_facet_data;
is(@errors, 2, "Got 2 errors");
like($errors[0], qr/^Facet 'assert' should not be a list, but got a a list/, "Got a list for a non-list type");
like($errors[1], qr/^Facet 'info' should be a list, but got a single item/, "Got a single item when a list is needed");
@errors = $ev2->validate_facet_data(require_facet_class => 1);
is(@errors, 3, "Got 3 errors");
is($errors[0], "Could not find a facet class for facet 'a custom one'", "Classes required");
like($errors[1], qr/^Facet 'assert' should not be a list, but got a a list/, "Got a list for a non-list type");
like($errors[2], qr/^Facet 'info' should be a list, but got a single item/, "Got a single item when a list is needed");
is_deeply(
[Test2::Event->validate_facet_data($ev1->facet_data)],
[],
"No errors"
);
@errors = Test2::Event->validate_facet_data($ev2->facet_data);
is(@errors, 2, "Got 2 errors");
like($errors[0], qr/^Facet 'assert' should not be a list, but got a a list/, "Got a list for a non-list type");
like($errors[1], qr/^Facet 'info' should be a list, but got a single item/, "Got a single item when a list is needed");
@errors = Test2::Event->validate_facet_data($ev2->facet_data, require_facet_class => 1);
is(@errors, 3, "Got 3 errors");
is($errors[0], "Could not find a facet class for facet 'a custom one'", "Classes required");
like($errors[1], qr/^Facet 'assert' should not be a list, but got a a list/, "Got a list for a non-list type");
like($errors[2], qr/^Facet 'info' should be a list, but got a single item/, "Got a single item when a list is needed");
};
done_testing;
PK 1��\���% % t/Test2/modules/EventFacet.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use ok 'Test2::EventFacet';
my $CLASS = 'Test2::EventFacet';
my $one = $CLASS->new(details => 'foo');
is($one->details, "foo", "Got details");
is_deeply($one->clone, $one, "Cloning.");
isnt($one->clone, $one, "Clone is a new ref");
my $two = $one->clone(details => 'bar');
is($one->details, 'foo', "Original details unchanged");
is($two->details, 'bar', "Clone details changed");
ok(!$CLASS->is_list, "Not a list by default");
ok(!$CLASS->facet_key, "No key for base class");
done_testing;
PK 1��\<�2��. �. t/Test2/modules/Hub.tnu �[��� use strict;
use warnings;
use Test2::IPC;
use Test2::Tools::Tiny;
use Test2::API qw/context test2_ipc_drivers/;
use Test2::Util qw/CAN_FORK CAN_THREAD CAN_REALLY_FORK/;
{
package My::Formatter;
sub new { bless [], shift };
my $check = 1;
sub write {
my $self = shift;
my ($e, $count) = @_;
push @$self => $e;
}
}
{
package My::Event;
use base 'Test2::Event';
use Test2::Util::HashBase qw{msg};
}
tests basic => sub {
my $hub = Test2::Hub->new(
formatter => My::Formatter->new,
);
my $send_event = sub {
my ($msg) = @_;
my $e = My::Event->new(msg => $msg, trace => Test2::EventFacet::Trace->new(frame => ['fake', 'fake.t', 1]));
$hub->send($e);
};
ok(my $e1 = $send_event->('foo'), "Created event");
ok(my $e2 = $send_event->('bar'), "Created event");
ok(my $e3 = $send_event->('baz'), "Created event");
my $old = $hub->format(My::Formatter->new);
ok($old->isa('My::Formatter'), "old formatter");
is_deeply(
$old,
[$e1, $e2, $e3],
"Formatter got all events"
);
};
tests follow_ups => sub {
my $hub = Test2::Hub->new;
$hub->set_count(1);
my $trace = Test2::EventFacet::Trace->new(
frame => [__PACKAGE__, __FILE__, __LINE__],
);
my $ran = 0;
$hub->follow_up(sub {
my ($d, $h) = @_;
is_deeply($d, $trace, "Got trace");
is_deeply($h, $hub, "Got hub");
ok(!$hub->ended, "Hub state has not ended yet");
$ran++;
});
like(
exception { $hub->follow_up('xxx') },
qr/follow_up only takes coderefs for arguments, got 'xxx'/,
"follow_up takes a coderef"
);
$hub->finalize($trace);
is($ran, 1, "ran once");
is_deeply(
$hub->ended,
$trace->frame,
"Ended at the expected place."
);
eval { $hub->finalize($trace) };
is($ran, 1, "ran once");
$hub = undef;
};
tests IPC => sub {
my ($driver) = test2_ipc_drivers();
is($driver, 'Test2::IPC::Driver::Files', "Default Driver");
my $ipc = $driver->new;
my $hub = Test2::Hub->new(
formatter => My::Formatter->new,
ipc => $ipc,
);
my $build_event = sub {
my ($msg) = @_;
return My::Event->new(msg => $msg, trace => Test2::EventFacet::Trace->new(frame => ['fake', 'fake.t', 1]));
};
my $e1 = $build_event->('foo');
my $e2 = $build_event->('bar');
my $e3 = $build_event->('baz');
my $do_send = sub {
$hub->send($e1);
$hub->send($e2);
$hub->send($e3);
};
my $do_check = sub {
my $name = shift;
my $old = $hub->format(My::Formatter->new);
ok($old->isa('My::Formatter'), "old formatter");
is(@$old, 3, "Formatter got all events ($name)");
ok($_->{hubs}, "Set the hubs") for @$old;
};
if (CAN_REALLY_FORK) {
my $pid = fork();
die "Could not fork!" unless defined $pid;
if ($pid) {
is(waitpid($pid, 0), $pid, "waited properly");
ok(!$?, "child exited with success");
$hub->cull();
$do_check->('Fork');
}
else {
$do_send->();
exit 0;
}
}
if (CAN_THREAD && $] ge '5.010') {
require threads;
my $thr = threads->new(sub { $do_send->() });
$thr->join;
$hub->cull();
$do_check->('Threads');
}
$do_send->();
$hub->cull();
$do_check->('no IPC');
};
tests listen => sub {
my $hub = Test2::Hub->new();
my @events;
my @counts;
my $it = $hub->listen(sub {
my ($h, $e, $count) = @_;
is_deeply($h, $hub, "got hub");
push @events => $e;
push @counts => $count;
});
my $second;
my $it2 = $hub->listen(sub { $second++ });
my $ok1 = Test2::Event::Ok->new(
pass => 1,
name => 'foo',
trace => Test2::EventFacet::Trace->new(
frame => [ __PACKAGE__, __FILE__, __LINE__ ],
),
);
my $ok2 = Test2::Event::Ok->new(
pass => 0,
name => 'bar',
trace => Test2::EventFacet::Trace->new(
frame => [ __PACKAGE__, __FILE__, __LINE__ ],
),
);
my $ok3 = Test2::Event::Ok->new(
pass => 1,
name => 'baz',
trace => Test2::EventFacet::Trace->new(
frame => [ __PACKAGE__, __FILE__, __LINE__ ],
),
);
$hub->send($ok1);
$hub->send($ok2);
$hub->unlisten($it);
$hub->send($ok3);
is_deeply(\@counts, [1, 2], "Got counts");
is_deeply(\@events, [$ok1, $ok2], "got events");
is($second, 3, "got all events in listener that was not removed");
like(
exception { $hub->listen('xxx') },
qr/listen only takes coderefs for arguments, got 'xxx'/,
"listen takes a coderef"
);
};
tests metadata => sub {
my $hub = Test2::Hub->new();
my $default = { foo => 1 };
my $meta = $hub->meta('Foo', $default);
is_deeply($meta, $default, "Set Meta");
$meta = $hub->meta('Foo', {});
is_deeply($meta, $default, "Same Meta");
$hub->delete_meta('Foo');
is($hub->meta('Foo'), undef, "No Meta");
$hub->meta('Foo', {})->{xxx} = 1;
is($hub->meta('Foo')->{xxx}, 1, "Vivified meta and set it");
like(
exception { $hub->meta(undef) },
qr/Invalid META key: undef, keys must be true, and may not be references/,
"Cannot use undef as a meta key"
);
like(
exception { $hub->meta(0) },
qr/Invalid META key: '0', keys must be true, and may not be references/,
"Cannot use 0 as a meta key"
);
like(
exception { $hub->delete_meta(undef) },
qr/Invalid META key: undef, keys must be true, and may not be references/,
"Cannot use undef as a meta key"
);
like(
exception { $hub->delete_meta(0) },
qr/Invalid META key: '0', keys must be true, and may not be references/,
"Cannot use 0 as a meta key"
);
};
tests filter => sub {
my $hub = Test2::Hub->new();
my @events;
my $it = $hub->filter(sub {
my ($h, $e) = @_;
is($h, $hub, "got hub");
push @events => $e;
return $e;
});
my $count;
my $it2 = $hub->filter(sub { $count++; $_[1] });
my $ok1 = Test2::Event::Ok->new(
pass => 1,
name => 'foo',
trace => Test2::EventFacet::Trace->new(
frame => [ __PACKAGE__, __FILE__, __LINE__ ],
),
);
my $ok2 = Test2::Event::Ok->new(
pass => 0,
name => 'bar',
trace => Test2::EventFacet::Trace->new(
frame => [ __PACKAGE__, __FILE__, __LINE__ ],
),
);
my $ok3 = Test2::Event::Ok->new(
pass => 1,
name => 'baz',
trace => Test2::EventFacet::Trace->new(
frame => [ __PACKAGE__, __FILE__, __LINE__ ],
),
);
$hub->send($ok1);
$hub->send($ok2);
$hub->unfilter($it);
$hub->send($ok3);
is_deeply(\@events, [$ok1, $ok2], "got events");
is($count, 3, "got all events, even after other filter was removed");
$hub = Test2::Hub->new();
@events = ();
$hub->filter(sub { undef });
$hub->listen(sub {
my ($hub, $e) = @_;
push @events => $e;
});
$hub->send($ok1);
$hub->send($ok2);
$hub->send($ok3);
ok(!@events, "Blocked events");
like(
exception { $hub->filter('xxx') },
qr/filter only takes coderefs for arguments, got 'xxx'/,
"filter takes a coderef"
);
};
tests pre_filter => sub {
my $hub = Test2::Hub->new();
my @events;
my $it = $hub->pre_filter(sub {
my ($h, $e) = @_;
is($h, $hub, "got hub");
push @events => $e;
return $e;
});
my $count;
my $it2 = $hub->pre_filter(sub { $count++; $_[1] });
my $ok1 = Test2::Event::Ok->new(
pass => 1,
name => 'foo',
trace => Test2::EventFacet::Trace->new(
frame => [ __PACKAGE__, __FILE__, __LINE__ ],
),
);
my $ok2 = Test2::Event::Ok->new(
pass => 0,
name => 'bar',
trace => Test2::EventFacet::Trace->new(
frame => [ __PACKAGE__, __FILE__, __LINE__ ],
),
);
my $ok3 = Test2::Event::Ok->new(
pass => 1,
name => 'baz',
trace => Test2::EventFacet::Trace->new(
frame => [ __PACKAGE__, __FILE__, __LINE__ ],
),
);
$hub->send($ok1);
$hub->send($ok2);
$hub->pre_unfilter($it);
$hub->send($ok3);
is_deeply(\@events, [$ok1, $ok2], "got events");
is($count, 3, "got all events, even after other pre_filter was removed");
$hub = Test2::Hub->new();
@events = ();
$hub->pre_filter(sub { undef });
$hub->listen(sub {
my ($hub, $e) = @_;
push @events => $e;
});
$hub->send($ok1);
$hub->send($ok2);
$hub->send($ok3);
ok(!@events, "Blocked events");
like(
exception { $hub->pre_filter('xxx') },
qr/pre_filter only takes coderefs for arguments, got 'xxx'/,
"pre_filter takes a coderef"
);
};
tests state => sub {
my $hub = Test2::Hub->new;
is($hub->count, 0, "count starts at 0");
is($hub->failed, 0, "failed starts at 0");
is($hub->is_passing, 1, "start off passing");
is($hub->plan, undef, "no plan yet");
$hub->is_passing(0);
is($hub->is_passing, 0, "Can Fail");
$hub->is_passing(1);
is($hub->is_passing, 1, "Passes again");
$hub->set_count(1);
is($hub->count, 1, "Added a passing result");
is($hub->failed, 0, "still no fails");
is($hub->is_passing, 1, "Still passing");
$hub->set_count(2);
$hub->set_failed(1);
is($hub->count, 2, "Added a result");
is($hub->failed, 1, "new failure");
is($hub->is_passing, 0, "Not passing");
$hub->is_passing(1);
is($hub->is_passing, 0, "is_passing always false after a failure");
$hub->set_failed(0);
$hub->is_passing(1);
is($hub->is_passing, 1, "Passes again");
$hub->set_failed(1);
is($hub->count, 2, "No new result");
is($hub->failed, 1, "new failure");
is($hub->is_passing, 0, "Not passing");
ok(!eval { $hub->plan('foo'); 1 }, "Could not set plan to 'foo'");
like($@, qr/'foo' is not a valid plan! Plan must be an integer greater than 0, 'NO PLAN', or 'SKIP'/, "Got expected error");
ok($hub->plan(5), "Can set plan to integer");
is($hub->plan, 5, "Set the plan to an integer");
$hub->set__plan(undef);
ok($hub->plan('NO PLAN'), "Can set plan to 'NO PLAN'");
is($hub->plan, 'NO PLAN', "Set the plan to 'NO PLAN'");
$hub->set__plan(undef);
ok($hub->plan('SKIP'), "Can set plan to 'SKIP'");
is($hub->plan, 'SKIP', "Set the plan to 'SKIP'");
ok(!eval { $hub->plan(5); 1 }, "Cannot change plan");
like($@, qr/You cannot change the plan/, "Got error");
my $trace = Test2::EventFacet::Trace->new(frame => ['Foo::Bar', 'foo.t', 42, 'blah']);
$hub->finalize($trace);
my $ok = eval { $hub->finalize($trace) };
my $err = $@;
ok(!$ok, "died");
is($err, <<" EOT", "Got expected error");
Test already ended!
First End: foo.t line 42
Second End: foo.t line 42
EOT
$hub = Test2::Hub->new;
$hub->plan(5);
$hub->set_count(5);
$hub->set_failed(1);
$hub->set_ended($trace);
$hub->set_bailed_out("foo");
$hub->set_skip_reason('xxx');
ok(!$hub->is_passing, "not passing");
$hub->reset_state;
ok(!$hub->plan, "no plan");
is($hub->count, 0, "count reset to 0");
is($hub->failed, 0, "reset failures");
ok(!$hub->ended, "not ended");
ok(!$hub->bailed_out, "did not bail out");
ok(!$hub->skip_reason, "no skip reason");
};
done_testing;
PK 1��\�- Ѧ � t/Test2/modules/IPC.tnu �[��� use strict;
use warnings;
use Test2::IPC qw/cull/;
use Test2::API qw/context test2_ipc_drivers test2_ipc intercept/;
use Test2::Tools::Tiny;
test2_ipc();
is_deeply(
[test2_ipc_drivers()],
['Test2::IPC::Driver::Files'],
"Default driver"
);
ok(__PACKAGE__->can('cull'), "Imported cull");
ok(eval { intercept { Test2::IPC->import }; 1 }, "Can re-import Test2::IPC without error") or diag $@;
done_testing;
PK 1��\J��� � t/Test2/modules/Util.tnu �[��� use strict;
use warnings;
our $TIME;
BEGIN {
*CORE::GLOBAL::time = sub() {
return CORE::time() unless defined $TIME;
return $TIME;
};
}
use Config qw/%Config/;
use Test2::Tools::Tiny;
use Test2::Util qw/
try
get_tid USE_THREADS
pkg_to_file
CAN_FORK
CAN_THREAD
CAN_REALLY_FORK
ipc_separator
gen_uid
CAN_SIGSYS
IS_WIN32
clone_io
/;
BEGIN {
if ($] lt "5.008") {
require Test::Builder::IO::Scalar;
}
}
{
for my $try (\&try, Test2::Util->can('_manual_try'), Test2::Util->can('_local_try')) {
my ($ok, $err) = $try->(sub { die "xxx" });
ok(!$ok, "cought exception");
like($err, qr/xxx/, "expected exception");
($ok, $err) = $try->(sub { 0 });
ok($ok, "Success");
ok(!$err, "no error");
}
}
is(pkg_to_file('A::Package::Name'), 'A/Package/Name.pm', "Converted package to file");
# Make sure running them does not die
# We cannot really do much to test these.
CAN_THREAD();
CAN_FORK();
CAN_REALLY_FORK();
IS_WIN32();
is(IS_WIN32(), ($^O eq 'MSWin32') ? 1 : 0, "IS_WIN32 is correct ($^O)");
my %sigs = map {$_ => 1} split /\s+/, $Config{sig_name};
if ($sigs{SYS}) {
ok(CAN_SIGSYS, "System has SIGSYS");
}
else {
ok(!CAN_SIGSYS, "System lacks SIGSYS");
}
my $check_for_sig_sys = Test2::Util->can('_check_for_sig_sys');
ok($check_for_sig_sys->("FOO SYS BAR"), "Found SIGSYS in the middle");
ok($check_for_sig_sys->("SYS FOO BAR"), "Found SIGSYS at start");
ok($check_for_sig_sys->("FOO BAR SYS"), "Found SIGSYS at end");
ok(!$check_for_sig_sys->("FOO SYSX BAR"), "SYSX is not SYS");
ok(!$check_for_sig_sys->("FOO XSYS BAR"), "XSYS is not SYS");
my $io = clone_io(\*STDOUT);
ok($io, "Cloned the filehandle");
close($io);
my $fh;
my $out = '';
if ($] ge "5.008") {
open($fh, '>', \$out) or die "Could not open filehandle";
} else {
$fh = Test::Builder::IO::Scalar->new(\$out) or die "Could not open filehandle";
}
$io = clone_io($fh);
is($io, $fh, "For a scalar handle we simply return the original handle, no other choice");
print $io "Test\n";
is($out, "Test\n", "wrote to the scalar handle");
is(ipc_separator(), '~', "Got ipc_separator");
{
local $TIME = time;
my $id1 = gen_uid();
my $id2 = gen_uid();
like($id1, qr/^\Q$$~0~$TIME~\E\d+$/, "Got a UID ($id1)");
my ($inc) = ($id1 =~ m/(\d+)$/g);
$inc++;
is($id2, "$$~0~$TIME~$inc", "Next id is next in sequence ($id2)");
}
done_testing;
PK 1��\�!�.b b % t/Test2/regression/693_ipc_ordering.tnu �[��� use Test2::Tools::Tiny;
use strict;
use warnings;
skip_all("Test cannot run on perls below 5.8.8") unless "$]" > 5.008007;
use Test2::Util qw/CAN_THREAD/;
use Test2::IPC;
use Test2::API qw/context intercept/;
skip_all('System does not have threads') unless CAN_THREAD();
require threads;
threads->import;
my $events = intercept {
threads->create(
sub {
ok 1, "something $_ nonlocal" for (1 .. 15);
}
)->join;
};
is_deeply(
[map { $_->{name} } @$events],
[map "something $_ nonlocal", 1 .. 15],
"Culled sub-thread events in correct order"
);
done_testing;
PK 1��\s� ( ( ( t/Test2/regression/746-forking-subtest.tnu �[��� use strict;
use warnings;
use Test2::IPC;
use Test2::Tools::Tiny;
use Test2::API qw/context intercept test2_stack/;
use Test2::Util qw/CAN_FORK/;
BEGIN {
skip_all "System cannot fork" unless CAN_FORK;
}
my $events = intercept {
Test2::API::run_subtest("this subtest forks" => sub {
if (fork) {
wait;
isnt($?, 0, "subprocess died");
} else {
# Prevent the exception from being rendered to STDERR, people have
# complained about STDERR noise in tests before.
close STDERR;
die "# Expected warning from subtest";
};
}, {no_fork => 1});
};
my @subtests = grep {; $_->isa('Test2::Event::Subtest') } @$events;
if (is(@subtests, 1, "only one subtest run, effectively")) {
my @subokay = grep {; $_->facets->{assert} }
@{ $subtests[0]->subevents };
is(@subokay, 1, "we got one test result inside the subtest");
ok(! $subokay[0]->causes_fail, "...and it passed");
} else {
# give up, we're already clearly broken
}
done_testing;
PK 1��\]��� � t/Test2/regression/gh_16.tnu �[��� use strict;
use warnings;
# This test checks for a pretty rare condition, one that was mainly a problem
# on 5.20+ (though a 5.8 also had the problem). I am not too worried about this
# breaking again. That said I still want it run on newer perls (where it is
# less likely to fail for an unrelated reason) and when I have AUTHOR_TESTING
# set.
BEGIN {
unless($ENV{AUTHOR_TESTING} || eval "no warnings 'portable'; require 5.20; 1") {
print "1..0 # Skip Crazy test, only run on 5.20+, or when AUTHOR_TESTING is set\n";
exit 0;
}
}
# This test is for gh #16
# Also see https://rt.perl.org/Public/Bug/Display.html?id=127774
# Ceate this END before anything else so that $? gets set to 0
END { $? = 0 }
BEGIN {
print "\n1..1\n";
close(STDERR);
open(STDERR, '>&STDOUT');
}
use Test2::API;
eval(' sub { die "xxx" } ')->();
END {
sub { my $ctx = Test2::API::context(); $ctx->release; }->();
print "ok 1 - Did not segv\n";
$? = 0;
}
PK 1��\IJ�'� � ) t/Test2/regression/ipc_files_abort_exit.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::Util qw/CAN_FORK/;
BEGIN {
skip_all "Set AUTHOR_TESTING to run this test" unless $ENV{AUTHOR_TESTING};
skip_all "System cannot fork" unless CAN_FORK;
skip_all "known to fail on $]" if $] le "5.006002";
}
use IPC::Open3 qw/open3/;
use File::Temp qw/tempdir/;
my $tempdir = tempdir(CLEANUP => 1);
open(my $stdout, '>', "$tempdir/stdout") or die "Could not open: $!";
open(my $stderr, '>', "$tempdir/stderr") or die "Could not open: $!";
my $pid = open3(undef, ">&" . fileno($stdout), ">&" . fileno($stderr), $^X, '-Ilib', '-e', <<'EOT');
use Test2::IPC::Driver::Files;
use Test2::IPC;
use Test2::Tools::Tiny;
use Test2::API qw/test2_ipc/;
plan 1;
ok(1);
my $tmpdir = test2_ipc()->tempdir;
open(my $fh, '>', "$tmpdir/leftover") or die "Could not open file: $!";
print $fh "XXX\n";
close($fh) or die "Could not clone file";
print "TEMPDIR: $tmpdir\n";
exit 100;
EOT
waitpid($pid, 0);
my $exit = $?;
open($stdout, '<', "$tempdir/stdout") or die "Could not open: $!";
open($stderr, '<', "$tempdir/stderr") or die "Could not open: $!";
$stdout = join "" => <$stdout>;
$stderr = join "" => <$stderr>;
is(($exit >> 8), 255, "exited 255");
like($stderr, qr{^IPC Fatal Error: Leftover files in the directory \(.*/leftover\)!$}m, "Got expected error");
like($stdout, qr{^Bail out! IPC Fatal Error: Leftover files in the directory \(.*leftover\)!$}m, "Got a bail printed");
if(ok($stdout =~ m/^TEMPDIR: (.*)$/m, "Found temp dir")) {
chomp(my $tmpdir = $1);
if (-d $tmpdir) {
note "Cleaning up temp dir\n";
opendir(my $dh, $tmpdir) or diag "Could not open temp dir: $!";
for my $file (readdir($dh)) {
next if $file =~ m/^\./;
unlink("$tmpdir/$file") or diag "Could not remove $tmpdir/$file: $!";
}
closedir($dh);
rmdir($tmpdir) or diag "Could not remove temp dir: $!";
}
}
done_testing;
PK 1��\���aW W t/lib/Dev/Null.pmnu �[��� package Dev::Null;
use strict;
sub TIEHANDLE { bless {}, shift }
sub PRINT { 1 }
1;
PK 1��\6$��� � t/lib/Test/Builder/NoOutput.pmnu �[��� package Test::Builder::NoOutput;
use strict;
use warnings;
use Symbol qw(gensym);
use base qw(Test::Builder);
=head1 NAME
Test::Builder::NoOutput - A subclass of Test::Builder which prints nothing
=head1 SYNOPSIS
use Test::Builder::NoOutput;
my $tb = Test::Builder::NoOutput->new;
...test as normal...
my $output = $tb->read;
=head1 DESCRIPTION
This is a subclass of Test::Builder which traps all its output.
It is mostly useful for testing Test::Builder.
=head3 read
my $all_output = $tb->read;
my $output = $tb->read($stream);
Returns all the output (including failure and todo output) collected
so far. It is destructive, each call to read clears the output
buffer.
If $stream is given it will return just the output from that stream.
$stream's are...
out output()
err failure_output()
todo todo_output()
all all outputs
Defaults to 'all'.
=cut
my $Test = __PACKAGE__->new;
sub create {
my $class = shift;
my $self = $class->SUPER::create(@_);
require Test::Builder::Formatter;
$self->{Stack}->top->format(Test::Builder::Formatter->new);
my %outputs = (
all => '',
out => '',
err => '',
todo => '',
);
$self->{_outputs} = \%outputs;
my($out, $err, $todo) = map { gensym() } 1..3;
tie *$out, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{out};
tie *$err, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{err};
tie *$todo, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{todo};
$self->output($out);
$self->failure_output($err);
$self->todo_output($todo);
return $self;
}
sub read {
my $self = shift;
my $stream = @_ ? shift : 'all';
my $out = $self->{_outputs}{$stream};
$self->{_outputs}{$stream} = '';
# Clear all the streams if 'all' is read.
if( $stream eq 'all' ) {
my @keys = keys %{$self->{_outputs}};
$self->{_outputs}{$_} = '' for @keys;
}
return $out;
}
package Test::Builder::NoOutput::Tee;
# A cheap implementation of IO::Tee.
sub TIEHANDLE {
my($class, @refs) = @_;
my @fhs;
for my $ref (@refs) {
my $fh = Test::Builder->_new_fh($ref);
push @fhs, $fh;
}
my $self = [@fhs];
return bless $self, $class;
}
sub PRINT {
my $self = shift;
print $_ @_ for @$self;
}
sub PRINTF {
my $self = shift;
my $format = shift;
printf $_ @_ for @$self;
}
1;
PK 1��\� 7� � ( t/lib/Test/Simple/sample_tests/death.plxnu �[��� require Test::Simple;
push @INC, 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
require Dev::Null;
Test::Simple->import(tests => 5);
tie *STDERR, 'Dev::Null';
ok(1);
ok(1);
ok(1);
$! = 0;
die "This is a test";
PK 1��\�yy� 0 t/lib/Test/Simple/sample_tests/death_in_eval.plxnu �[��� require Test::Simple;
use Carp;
push @INC, 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
Test::Simple->import(tests => 5);
ok(1);
ok(1);
ok(1);
eval {
die "Foo";
};
ok(1);
eval "die 'Bar'";
ok(1);
eval {
croak "Moo";
};
PK 1��\T�;�X X 5 t/lib/Test/Simple/sample_tests/death_with_handler.plxnu �[��� require Test::Simple;
push @INC, 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
Test::Simple->import(tests => 2);
# Test we still get the right exit code despite having a die
# handler.
$SIG{__DIE__} = sub {};
require Dev::Null;
tie *STDERR, 'Dev::Null';
ok(1);
ok(1);
$! = 0;
die "This is a test";
PK 1��\��K� ' t/lib/Test/Simple/sample_tests/exit.plxnu �[��� require Test::Builder;
exit 1;
PK 1��\��3�� � ) t/lib/Test/Simple/sample_tests/extras.plxnu �[��� require Test::Simple;
push @INC, 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
Test::Simple->import(tests => 5);
ok(1);
ok(1);
ok(1);
ok(1);
ok(0);
ok(1);
ok(0);
PK 1��\�ǭ�� � , t/lib/Test/Simple/sample_tests/five_fail.plxnu �[��� require Test::Simple;
use lib 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
Test::Simple->import(tests => 5);
ok(0);
ok(0);
ok('');
ok(0);
ok(0);
PK 1��\�< 4 t/lib/Test/Simple/sample_tests/last_minute_death.plxnu �[��� require Test::Simple;
push @INC, 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
Test::Simple->import(tests => 5);
require Dev::Null;
tie *STDERR, 'Dev::Null';
ok(1);
ok(1);
ok(1);
ok(1);
ok(1);
$! = 0;
die "This is a test";
PK 1��\+Ρ � � 7 t/lib/Test/Simple/sample_tests/missing_done_testing.plxnu �[��� require Test::Simple;
push @INC, 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
Test::Simple->import();
ok(1);
PK 1��\GCI� � + t/lib/Test/Simple/sample_tests/one_fail.plxnu �[��� require Test::Simple;
push @INC, 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
Test::Simple->import(tests => 5);
ok(1);
ok(2);
ok(0);
ok(1);
ok(2);
PK 1��\N� �� � 8 t/lib/Test/Simple/sample_tests/one_fail_without_plan.plxnu �[��� require Test::Simple;
push @INC, 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
Test::Simple->import();
ok(0);
PK 1��\�)�! ! 1 t/lib/Test/Simple/sample_tests/pre_plan_death.plxnu �[��� # ID 20020716.013, the exit code would become 0 if the test died
# before a plan.
require Test::Simple;
push @INC, 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
close STDERR;
die "Knife?";
Test::Simple->import(tests => 3);
ok(1);
ok(1);
ok(1);
PK 1��\Ё� * t/lib/Test/Simple/sample_tests/require.plxnu �[��� require Test::Simple;
PK 1��\T��� � * t/lib/Test/Simple/sample_tests/success.plxnu �[��� require Test::Simple;
push @INC, 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
Test::Simple->import(tests => 5);
ok(1);
ok(5, 'yep');
ok(3, 'beer');
ok("wibble", "wibble");
ok(1);
PK 1��\�ڼ3� � * t/lib/Test/Simple/sample_tests/too_few.plxnu �[��� require Test::Simple;
push @INC, 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
Test::Simple->import(tests => 5);
ok(1);
ok(1);
PK 1��\G�s�� � / t/lib/Test/Simple/sample_tests/too_few_fail.plxnu �[��� require Test::Simple;
push @INC, 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
Test::Simple->import(tests => 5);
ok(0);
ok(1);
ok(0);
PK 1��\q6 � � + t/lib/Test/Simple/sample_tests/two_fail.plxnu �[��� require Test::Simple;
push @INC, 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
Test::Simple->import(tests => 5);
ok(0);
ok(1);
ok(1);
ok(0);
ok(1);
PK 1��\P��� � t/lib/Test/Simple/Catch.pmnu �[��� # For testing Test::Simple;
package Test::Simple::Catch;
use strict;
use Symbol;
use TieOut;
my( $out_fh, $err_fh ) = ( gensym, gensym );
my $out = tie *$out_fh, 'TieOut';
my $err = tie *$err_fh, 'TieOut';
use Test::Builder;
require Test::Builder::Formatter;
my $t = Test::Builder->new;
$t->{Stack}->top->format(Test::Builder::Formatter->new);
$t->output($out_fh);
$t->failure_output($err_fh);
$t->todo_output($err_fh);
sub caught { return( $out, $err ) }
1;
PK 1��\D&C 7 7 t/lib/Dummy.pmnu �[��� package Dummy;
use strict;
our $VERSION = '0.01';
1;
PK 1��\�WhC_ _ t/lib/MyOverload.pmnu �[��� package Overloaded; ##no critic (Modules::RequireFilenameMatchesPackage)
use strict;
sub new {
my $class = shift;
bless { string => shift, num => shift }, $class;
}
package Overloaded::Compare;
use strict;
our @ISA = qw(Overloaded);
# Sometimes objects have only comparison ops overloaded and nothing else.
# For example, DateTime objects.
use overload
q{eq} => sub { $_[0]->{string} eq $_[1] },
q{==} => sub { $_[0]->{num} == $_[1] };
package Overloaded::Ify;
use strict;
our @ISA = qw(Overloaded);
use overload
q{""} => sub { $_[0]->{string} },
q{0+} => sub { $_[0]->{num} };
1;
PK 1��\
� l t/lib/MyTest.pmnu �[��� use strict;
use warnings;
package MyTest;
use Test::Builder;
my $Test = Test::Builder->new;
sub ok
{
$Test->ok(@_);
}
1;
PK 1��\{��W� � t/lib/NoExporter.pmnu �[��� package NoExporter;
use strict;
our $VERSION = 1.02;
sub import {
shift;
die "NoExporter exports nothing. You asked for: @_" if @_;
}
1;
PK 1��\a�gO O t/lib/SigDie.pmnu �[��� package SigDie;
use strict;
our $DIE;
$SIG{__DIE__} = sub { $DIE = $@ };
1;
PK 1��\ 8�G G t/lib/SkipAll.pmnu �[��� package SkipAll;
use strict;
use warnings;
main::skip_all("foo");
1;
PK 1��\��rP P t/lib/SmallTest.pmnu �[��� use strict;
use warnings;
package SmallTest;
require Exporter;
use vars qw( @ISA @EXPORT );
@ISA = qw( Exporter );
@EXPORT = qw( ok is_eq is_num );
use Test::Builder;
my $Test = Test::Builder->new;
sub ok
{
$Test->ok(@_);
}
sub is_eq
{
$Test->is_eq(@_);
}
sub is_num
{
$Test->is_num(@_);
}
sub getTest
{
return $Test;
}
1;
PK 1��\˼]Zt t t/lib/TieOut.pmnu �[��� package TieOut;
use strict;
sub TIEHANDLE {
my $scalar = '';
bless( \$scalar, $_[0] );
}
sub PRINT {
my $self = shift;
$$self .= join( '', @_ );
}
sub PRINTF {
my $self = shift;
my $fmt = shift;
$$self .= sprintf $fmt, @_;
}
sub FILENO { }
sub read {
my $self = shift;
my $data = $$self;
$$self = '';
return $data;
}
1;
PK 1��\�J⨽ � ! t/regression/642_persistent_end.tnu �[��� use Test::More;
use strict;
use warnings;
use Test2::API qw{
test2_set_is_end
test2_get_is_end
intercept
};
my %res;
intercept {
my $tb = Test::Builder->new;
$res{before} = test2_get_is_end();
test2_set_is_end();
$res{isset} = test2_get_is_end();
$tb->reset;
$res{reset} = test2_get_is_end();
};
ok(!$res{before}, "Not the end");
ok($res{isset}, "the end");
ok(!$res{reset}, "Not the end");
done_testing;
PK 1��\�$S�4 4 t/regression/662-tbt-no-plan.tnu �[��� use Test::Builder::Tester;
use Test::More tests => 1;
use strict;
use warnings;
BEGIN {
package Example::Tester;
use base 'Test::Builder::Module';
$INC{'Example/Tester.pm'} = 1;
sub import {
my $package = shift;
my %args = @_;
my $callerpack = caller;
my $tb = __PACKAGE__->builder;
$tb->exported_to($callerpack);
local $SIG{__WARN__} = sub { };
$tb->no_plan;
}
}
test_out('ok 1 - use Example::Tester;');
use_ok('Example::Tester');
test_test("use Example::Tester;");
PK 1��\�� ^ # t/regression/684-nested_todo_diag.tnu �[��� use Test::More;
use strict;
use warnings;
use Test2::API qw/intercept/;
my @events;
intercept {
local $TODO = "broken";
Test2::API::test2_stack->top->listen(sub { push @events => $_[1] }, inherit => 1);
subtest foo => sub {
subtest bar => sub {
ok(0, 'oops');
};
};
};
my ($event) = grep { $_->trace->line == 16 && ref($_) eq 'Test::Builder::TodoDiag'} @events;
ok($event, "nested todo diag on line 16 was changed to TodoDiag (STDOUT instead of STDERR)");
done_testing;
PK 1��\�[Α � * t/regression/694_note_diag_return_values.tnu �[��� use Test::More;
use strict;
use warnings;
use Test2::API qw/intercept/;
my @returns;
intercept {
push @returns => diag('foo');
push @returns => note('foo');
my $tb = Test::Builder->new;
push @returns => $tb->diag('foo');
push @returns => $tb->note('foo');
};
is(@returns, 4, "4 return values");
is_deeply(\@returns, [0, 0, 0, 0], "All note/diag returns are 0");
done_testing;
PK 1��\˰ok� � % t/regression/696-intercept_skip_all.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
use Test2::API qw/intercept/;
tests in_eval => sub {
my $events = intercept {
eval { skip_all "foo" };
die "Should not see this: $@";
};
is(@$events, 1, "got 1 event");
ok($events->[0]->isa('Test2::Event::Plan'), "Plan is only event");
is($events->[0]->directive, 'SKIP', "Plan is to skip");
};
tests no_eval => sub {
my $events = intercept {
skip_all "foo";
die "Should not see this: $@";
};
is(@$events, 1, "got 1 event");
ok($events->[0]->isa('Test2::Event::Plan'), "Plan is only event");
is($events->[0]->directive, 'SKIP', "Plan is to skip");
};
tests in_require => sub {
my $events = intercept {
require './t/lib/SkipAll.pm';
die "Should not see this: $@";
};
is(@$events, 1, "got 1 event");
ok($events->[0]->isa('Test2::Event::Plan'), "Plan is only event");
is($events->[0]->directive, 'SKIP', "Plan is to skip");
};
done_testing;
PK 1��\��nό � * t/regression/721-nested-streamed-subtest.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
# This module's exports interfere with the ones in t/tools.pl
use Test::More ();
use Test::Builder::Formatter();
use Test2::API qw/run_subtest test2_stack/;
{
test2_stack->top;
my $temp_hub = test2_stack->new_hub();
$temp_hub->format(Test::Builder::Formatter->new());
my $output = capture {
run_subtest(
'parent',
sub {
run_subtest(
'buffered',
sub {
ok(1, 'b1');
ok(1, 'b2');
},
{buffered => 1},
);
run_subtest(
'streamed',
sub {
ok(1, 's1');
ok(1, 's2');
},
{buffered => 0},
);
},
{buffered => 1},
);
};
test2_stack->pop($temp_hub);
Test::More::subtest(
'Test2::API::run_subtest',
sub {
is($output->{STDERR}, q{}, 'no output on stderr');
like($output->{STDOUT}, qr/ +ok 1 - b1/, 'got ok output for tests in buffered subtest');
like($output->{STDOUT}, qr/ +ok 2 - b2/, 'got ok output for tests in buffered subtest');
like($output->{STDOUT}, qr/ +ok 1 - s1/, 'got ok output for tests in streamed subtest');
like($output->{STDOUT}, qr/ +ok 2 - s2/, 'got ok output for tests in streamed subtest');
}
);
}
{
test2_stack->top;
my $temp_hub = test2_stack->new_hub();
$temp_hub->format(Test::Builder::Formatter->new());
my $output = capture {
run_subtest(
'parent',
sub {
run_subtest(
'buffered',
sub {
ok(1, 'b1');
ok(1, 'b2');
},
{buffered => 1},
);
Test::More::subtest(
'streamed',
sub {
ok(1, 's1');
ok(1, 's2');
},
{buffered => 0},
);
},
{buffered => 1},
);
};
test2_stack->pop($temp_hub);
Test::More::subtest(
'Test::More::subtest and Test2::API::run_subtest',
sub {
is($output->{STDERR}, q{}, 'no output on stderr');
like($output->{STDOUT}, qr/ +ok 1 - b1/, 'got ok output for tests in buffered subtest');
like($output->{STDOUT}, qr/ +ok 2 - b2/, 'got ok output for tests in buffered subtest');
like($output->{STDOUT}, qr/ +ok 1 - s1/, 'got ok output for tests in streamed subtest');
like($output->{STDOUT}, qr/ +ok 2 - s2/, 'got ok output for tests in streamed subtest');
}
);
}
done_testing;
PK 1��\��J�! ! # t/regression/757-reset_in_subtest.tnu �[��� use strict;
use warnings;
use Test::More;
subtest 'subtest' => sub {
Test::Builder->new->reset;
ok 1;
};
subtest 'subtest' => sub {
Test::Builder->new->reset;
subtest 'subtest' => sub {
Test::Builder->new->reset;
ok 1;
};
ok 1;
};
done_testing;
PK 1��\�&��p p - t/regression/buffered_subtest_plan_buffered.tnu �[��� use Test2::Tools::Tiny;
use strict;
use warnings;
use Test2::API qw/intercept test2_stack/;
use Data::Dumper;
sub hide_buffered { 0 }
sub write {
my $self = shift;
my ($e) = @_;
push @{$self->{events}} => $e;
}
sub finalize { }
my $events;
intercept {
my $hub = test2_stack()->top;
my $formatter = bless({}, __PACKAGE__);
$hub->format($formatter);
tests xxx => sub {
ok(1, "pass");
};
$events = $formatter->{events};
};
pop @$events;
for my $e (@$events) {
ok($e->trace->buffered, "Buffered events are all listed as buffered") || diag(Dumper($e));
}
done_testing;
PK 1��\���~j j $ t/regression/builder_does_not_init.tnu �[��� use strict;
use warnings;
use Carp qw/confess/;
use Test2::API::Instance;
BEGIN {
no warnings 'redefine';
local *Test2::API::Instance::_finalize = sub { confess "_finalize called\n" };
local *Test2::API::Instance::load = sub { confess "load called\n" };
require Test::Builder;
}
use Test2::Tools::Tiny;
ok(1, "Did not die");
done_testing();
PK 1��\�z A� � t/regression/errors_facet.tnu �[��� use Test2::Tools::Tiny;
use Test2::API qw/intercept context/;
{
$INC{'My/Event.pm'} = 1;
package My::Event;
use base 'Test2::Event';
use Test2::Util::Facets2Legacy ':ALL';
sub facet_data {
my $self = shift;
my $out = $self->common_facet_data;
$out->{errors} = [{tag => 'OOPS', fail => !$ENV{FAILURE_DO_PASS}, details => "An error occured"}];
return $out;
}
}
sub error {
my $ctx = context();
my $e = $ctx->send_event('+My::Event');
$ctx->release;
return $e;
}
my $events = intercept {
tests foo => sub {
ok(1, "need at least 1 assertion");
error();
};
};
ok(!$events->[0]->pass, "Subtest did not pass");
my ($passing_a, $passing_b);
intercept {
my $hub = Test2::API::test2_stack->top;
$passing_a = $hub->is_passing;
error();
$passing_b = $hub->is_passing;
};
ok($passing_a, "Passign before error");
ok(!$passing_b, "Not passing after error");
done_testing;
PK 1��\���$ $ t/regression/inherit_trace.tnu �[��� use Test2::Tools::Tiny;
use strict;
use warnings;
use Test2::API qw/context run_subtest intercept/;
sub do_it {
my $ctx = context();
run_subtest foo => sub {
ok(1, "pass");
}, {inherit_trace => 1};
$ctx->release;
}
do_it();
do_it();
my $events = intercept {
do_it();
do_it();
};
for my $st (@$events) {
next unless $st->isa('Test2::Event::Subtest');
is($st->trace->nested, 0, "base subtest is not nested");
is($_->trace->nested, 1, "subevent is nested") for @{$st->subevents};
}
done_testing;
PK 1��\2�z�� � ! t/regression/no_name_in_subtest.tnu �[��� use strict;
use warnings;
use Test2::Tools::Tiny;
ok(1, "");
tests foo => sub {
ok(1, "name");
ok(1, "");
};
done_testing;
PK 1��\4 ��� � t/regression/todo_and_facets.tnu �[��� use strict;
use warnings;
use Test2::API qw/context/;
use Test2::Tools::Tiny qw/done_testing todo/;
use Test::More();
BEGIN {
*tm_ok = \&Test::More::ok;
*tm_pass = \&Test::More::pass;
*tm_fail = \&Test::More::fail;
}
use vars qw/$TODO/;
sub leg_ok($;$@) {
my ($bool, $name, @diag);
my $ctx = context();
$ctx->ok($bool, $name, \@diag);
$ctx->release;
return $bool;
}
sub new_ok($;$@) {
my ($bool, $name, @diag) = @_;
my $ctx = context();
return $ctx->pass_and_release($name) if $bool;
return $ctx->fail_and_release($name, @diag);
}
{
local $TODO = "Testing TODO";
tm_ok(0, "tm_ok fail");
tm_fail('tm_fail');
leg_ok(0, "legacy ok fail");
new_ok(0, "new ok fail");
}
todo new_todo_test => sub {
tm_ok(0, "tm_ok fail");
tm_fail('tm_fail');
leg_ok(0, "legacy ok fail");
new_ok(0, "new ok fail");
};
done_testing;
PK 1��\τ.�� �
t/00-report.tnu �[��� use strict;
use warnings;
my $exit = 0;
END{ $? = $exit }
use File::Spec;
my ($stderr, $stdout);
BEGIN {
$exit = 0;
END{ $? = $exit }
print STDOUT "ok 1\n";
print STDOUT "1..1\n";
open($stdout, '>&STDOUT') or die "Could not clone STDOUT: $!";
open($stderr, '>&STDERR') or die "Could not clone STDERR: $!";
close(STDOUT) or die "Could not close STDOUT";
unless(close(STDERR)) {
print $stderr "Could not close STDERR\n";
$exit = 255;
exit $exit;
}
open(STDOUT, '>', File::Spec->devnull);
open(STDERR, '>', File::Spec->devnull);
}
use Test2::Util qw/CAN_FORK CAN_REALLY_FORK CAN_THREAD/;
use Test2::API;
sub diag {
print $stderr "\n" unless @_;
print $stderr "# $_\n" for @_;
}
diag;
diag "DIAGNOSTICS INFO IN CASE OF FAILURE:";
diag;
diag "Perl: $]";
diag;
diag "CAPABILITIES:";
diag 'CAN_FORK ' . (CAN_FORK ? 'Yes' : 'No');
diag 'CAN_REALLY_FORK ' . (CAN_REALLY_FORK ? 'Yes' : 'No');
diag 'CAN_THREAD ' . (CAN_THREAD ? 'Yes' : 'No');
diag;
diag "DEPENDENCIES:";
my @depends = sort qw{
Carp
File::Spec
File::Temp
PerlIO
Scalar::Util
Storable
Test2
overload
threads
utf8
};
my %deps;
my $len = 0;
for my $dep (@depends) {
my $l = length($dep);
$len = $l if $l > $len;
$deps{$dep} = eval "require $dep" ? ($dep->VERSION || '0') : 'N/A';
}
diag sprintf("%-${len}s %s", $_, $deps{$_}) for @depends;
END{ $? = $exit }
PK 1��\�l^ ^
t/00compile.tnu �[��� #!/usr/bin/perl -w
BEGIN {
if( $ENV{PERL_CORE} ) {
@INC = ('../lib', 'lib');
}
else {
unshift @INC, 't/lib';
}
}
chdir 't';
use Test::More;
my $Has_Test_Pod;
BEGIN {
$Has_Test_Pod = eval 'use Test::Pod 0.95; 1';
}
chdir "..";
my $manifest = "MANIFEST";
open(my $manifest_fh, "<", $manifest) or plan(skip_all => "Can't open $manifest: $!");
my @modules = map { m{^lib/(\S+)}; $1 }
grep { m{^lib/Test/\S*\.pm} }
grep { !m{/t/} } <$manifest_fh>;
chomp @modules;
close $manifest_fh;
chdir 'lib';
plan tests => scalar @modules * 2;
foreach my $file (@modules) {
# Make sure we look at the local files and do not reload them if
# they're already loaded. This avoids recompilation warnings.
local @INC = @INC;
unshift @INC, ".";
my @warnings;
ok eval {
local $SIG{__WARN__} = sub { push @warnings => @_ };
require($file);
1
} or diag "require $file failed.", "\n", @warnings, "\n", $@;
SKIP: {
skip "Test::Pod not installed", 1 unless $Has_Test_Pod;
pod_file_ok($file);
}
}
PK 1��\�[K�� � t/HashBase.tnu �[��� use strict;
use warnings;
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{'Object/HashBase/Test/HBase.pm'} = __FILE__;
package
main::HBase;
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");
}
BEGIN {
package
main::HBaseSub;
use base 'main::HBase';
use Test2::Util::HashBase qw/apple pear/;
main::is(FOO, 'foo', "FOO CONSTANT");
main::is(BAR, 'bar', "BAR CONSTANT");
main::is(BAZ, 'baz', "BAZ CONSTANT");
main::is(APPLE, 'apple', "APPLE CONSTANT");
main::is(PEAR, 'pear', "PEAR CONSTANT");
}
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");
$one->set_foo('x');
is($one->foo, 'x', "Accessor set");
$one->set_foo(undef);
is_deeply(
$one,
{
foo => undef,
bar => 'b',
baz => 'c',
},
'hash'
);
BEGIN {
package
main::Const::Test;
use Test2::Util::HashBase qw/foo/;
sub do_it {
if (FOO()) {
return 'const';
}
return 'not const'
}
}
my $pkg = 'main::Const::Test';
is($pkg->do_it, 'const', "worked as expected");
{
local $SIG{__WARN__} = sub { };
*main::Const::Test::FOO = sub { 0 };
}
ok(!$pkg->FOO, "overrode const sub");
{
local $TODO = "known to fail on $]" if $] le "5.006002";
is($pkg->do_it, 'const', "worked as expected, const was constant");
}
BEGIN {
$INC{'Object/HashBase/Test/HBase/Wrapped.pm'} = __FILE__;
package
main::HBase::Wrapped;
use Test2::Util::HashBase qw/foo bar dup/;
my $foo = __PACKAGE__->can('foo');
no warnings 'redefine';
*foo = sub {
my $self = shift;
$self->set_bar(1);
$self->$foo(@_);
};
}
BEGIN {
$INC{'Object/HashBase/Test/HBase/Wrapped/Inherit.pm'} = __FILE__;
package
main::HBase::Wrapped::Inherit;
use base 'main::HBase::Wrapped';
use Test2::Util::HashBase qw/baz dup/;
}
my $o = main::HBase::Wrapped::Inherit->new(foo => 1);
my $foo = $o->foo;
is($o->bar, 1, 'parent attribute sub not overridden');
{
package
Foo;
sub new;
use Test2::Util::HashBase qw/foo bar baz/;
sub new { 'foo' };
}
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");
is_deeply(
[Test2::Util::HashBase::attr_list('main::HBase::Wrapped::Inherit')],
[qw/foo bar dup baz/],
"Got a list of attributes in order starting from base class, duplicates removed",
);
my $x = main::HBase::Wrapped::Inherit->new(foo => 1, baz => 2);
is($x->foo, 1, "set foo via pairs");
is($x->baz, 2, "set baz via pairs");
# Now with hashref
my $y = main::HBase::Wrapped::Inherit->new({foo => 1, baz => 2});
is($y->foo, 1, "set foo via hashref");
is($y->baz, 2, "set baz via hashref");
# Now with hashref
my $z = main::HBase::Wrapped::Inherit->new([
1, # foo
2, # bar
3, # dup
4, # baz
]);
is($z->foo, 1, "set foo via arrayref");
is($z->baz, 4, "set baz via arrayref");
like(
exception { main::HBase::Wrapped::Inherit->new([1 .. 10]) },
qr/Too many arguments for main::HBase::Wrapped::Inherit constructor/,
"Too many args in array form"
);
my $CAN_COUNT = 0;
my $CAN_COUNT2 = 0;
my $INIT_COUNT = 0;
BEGIN {
$INC{'Object/HashBase/Test/HBase3.pm'} = __FILE__;
package
main::HBase3;
use Test2::Util::HashBase qw/foo/;
sub can {
my $self = shift;
$CAN_COUNT++;
$self->SUPER::can(@_);
}
$INC{'Object/HashBase/Test/HBase4.pm'} = __FILE__;
package
main::HBase4;
use Test2::Util::HashBase qw/foo/;
sub can {
my $self = shift;
$CAN_COUNT2++;
$self->SUPER::can(@_);
}
sub init { $INIT_COUNT++ }
}
is($CAN_COUNT, 0, "->can has not been called yet");
my $it = main::HBase3->new;
is($CAN_COUNT, 1, "->can has been called once to check for init");
$it = main::HBase3->new;
is($CAN_COUNT, 1, "->can was not called again, we cached it");
is($CAN_COUNT2, 0, "->can has not been called yet");
is($INIT_COUNT, 0, "->init has not been called yet");
$it = main::HBase4->new;
is($CAN_COUNT2, 1, "->can has been called once to check for init");
is($INIT_COUNT, 1, "->init has been called once");
$it = main::HBase4->new;
is($CAN_COUNT2, 1, "->can was not called again, we cached it");
is($INIT_COUNT, 2, "->init has been called again");
done_testing;
1;
PK 1��\��L� � t/zzz-check-breaks.tnu �[��� use strict;
use warnings;
# Must not fail!
END { $? = 0 }
# this test is very similar to what is generated by Dist::Zilla::Plugin::Test::CheckBreaks
use Test::More;
eval {
require CPAN::Meta;
require CPAN::Meta::Requirements;
CPAN::Meta::Requirements->VERSION(2.120920);
require Module::Metadata;
1
} or plan skip_all => 'breakage test requires CPAN::Meta, CPAN::Meta::Requirements and Module::Metadata';
my $metafile = -e 'MYMETA.json' ? 'MYMETA.json'
: -e 'META.json' ? 'META.json'
: undef;
unless ($metafile) {
plan skip_all => "can't check breakages without some META file";
}
eval {
my $breaks = CPAN::Meta->load_file($metafile)->custom('x_breaks');
my $reqs = CPAN::Meta::Requirements->new;
$reqs->add_string_requirement($_, $breaks->{$_}) foreach keys %$breaks;
my $result = check_breaks($reqs);
if (my @breaks = grep { defined $result->{$_} } keys %$result) {
diag 'You have the following modules installed, which are not compatible with the latest Test::More:';
diag "$result->{$_}" for sort @breaks;
diag "\n", 'You should now update these modules!';
diag "You should also see Test2::Transition!";
}
pass 'conflicting modules checked';
1;
} or plan skip_all => "Could not check conflicting modules: $@";
# this is an inlined simplification of CPAN::Meta::Check.
sub check_breaks {
my $reqs = shift;
return +{
map { $_ => _check_break($reqs, $_) } $reqs->required_modules,
};
}
sub _check_break {
my ($reqs, $module) = @_;
my $metadata = Module::Metadata->new_from_module($module);
return undef if not defined $metadata;
my $version = eval { $metadata->version };
return "Missing version info for module '$module'" if not $version;
return sprintf 'Installed version (%s) of %s is in range \'%s\'', $version, $module, $reqs->requirements_for_module($module) if $reqs->accepts_module($module, $version);
return undef;
}
done_testing;
PK 1��\�jc��8 �8 Changesnu �[��� 1.302135 2018-03-29 22:53:00-07:00 America/Los_Angeles
- No changes since last trial
1.302134 2018-03-19 21:20:08-07:00 America/Los_Angeles (TRIAL RELEASE)
- Make sure all hubs, events, and contexts get a unique (per run) id.
- Use a common generator for unique(enough) id's (not UUIDs)
1.302133 2018-03-11 12:48:37-07:00 America/Los_Angeles
- No changes since last trial
1.302132 2018-03-09 15:43:51-08:00 America/Los_Angeles (TRIAL RELEASE)
- Add method to validate facet data
- Add Test2::Event::V2 event class, and context helpers
- Improve how events handle facets
- Break out meta_facet_data
- Document and fix Facets2Legacy
- Fix nested and in_subtest to look at hub facets
- Fix event->related and trace with uuid
1.302131 2018-03-07 09:36:16-08:00 America/Los_Angeles (TRIAL RELEASE)
- Make sure event puts the uuid into the about facet
1.302130 2018-03-07 08:07:54-08:00 America/Los_Angeles
- No changes since last trial
1.302129 2018-03-06 13:43:22-08:00 America/Los_Angeles (TRIAL RELEASE)
- Make hubs tag events with a new facet
1.302128 2018-03-05 09:26:53-08:00 America/Los_Angeles
- No changes since the trial
1.302127 2018-03-02 12:43:56-08:00 America/Los_Angeles (TRIAL RELEASE)
- Fix missing UUID in Test::Builder subtests
1.302126 2018-03-01 23:15:52-08:00 America/Los_Angeles (TRIAL RELEASE)
- Add optional UUID tagging
1.302125 2018-02-21 23:10:39-08:00 America/Los_Angeles
- No changes since trial
1.302124 2018-02-13 22:02:48-08:00 America/Los_Angeles (TRIAL RELEASE)
- Fix a test to skip without threads
1.302123 2018-02-13 21:39:31-08:00 America/Los_Angeles (TRIAL RELEASE)
- Make it possible to disable IPC
1.302122 2018-02-05 08:13:56-08:00 America/Los_Angeles
- Add 'mode' ro render facet
1.302121 2018-02-04 13:27:41-08:00 America/Los_Angeles
- Update Copyright
- Add 'render' facet
1.302120 2017-11-29 18:49:15-08:00 America/Los_Angeles
- No Changes since last trial
1.302119 2017-11-28 15:35:42-08:00 America/Los_Angeles (TRIAL RELEASE)
- Fix IPC reload bug
1.302118 2017-11-28 10:14:12-08:00 America/Los_Angeles
- No Changes since last trial
1.302117 2017-11-27 14:10:53-08:00 America/Los_Angeles (TRIAL RELEASE)
- Fix event Out of Order bug
- Add driver_abort() hook for IPC Drivers
1.302116 2017-11-23 15:14:26-08:00 America/Los_Angeles (TRIAL RELEASE)
- add better interface for ipc_wait
1.302115 2017-11-22 21:14:55-08:00 America/Los_Angeles (TRIAL RELEASE)
- ipc_wait now reports exit and signal values
1.302114 2017-11-21 15:28:39-08:00 America/Los_Angeles (TRIAL RELEASE)
- Added pre-subtest hook to Test2::API (#801 from dakkar)
1.302113 2017-11-20 14:04:16-08:00 America/Los_Angeles
- Fix SIGPIPE in IPC test
- Mark a test as usually AUTHOR_TESTING only
1.302112 2017-11-20 06:43:16-08:00 America/Los_Angeles
- Fix test on threaded 5.8
1.302111 2017-11-18 09:54:33-08:00 America/Los_Angeles
- Remove debugging from previous trial
1.302110 2017-11-17 09:47:23-08:00 America/Los_Angeles (TRIAL RELEASE)
- Fix test breakage (from previous trial) on older perls
1.302109 2017-11-17 09:35:48-08:00 America/Los_Angeles (TRIAL RELEASE)
- Fix some fragile tests
- Add debugging to API/Instance.t for a cpan-testers failure
1.302108 2017-11-16 14:19:24-08:00 America/Los_Angeles (TRIAL RELEASE)
- Apply p5p test patch from Craig A. Berry <craigberry@mac.com>
1.302107 2017-11-16 07:44:59-08:00 America/Los_Angeles (TRIAL RELEASE)
- Allow regexp in Test::Tester
1.302106 2017-10-20 20:42:43-07:00 America/Los_Angeles
- Make version number in HashBase sane.
1.302105 2017-10-20 07:09:45-07:00 America/Los_Angeles
- No changes since last trial
1.302104 2017-10-19 11:39:01-07:00 America/Los_Angeles (TRIAL RELEASE)
- Combine multiple diags into one event
1.302103 2017-10-15 10:11:29-07:00 America/Los_Angeles
- No changes since last TRIAL
1.302102 2017-10-14 20:05:45-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix some TODO edge cases that were not previously accounted for
1.302101 2017-10-12 07:43:16-07:00 America/Los_Angeles
- Bump Test::Builder::IO::Scalar version for core
1.302100 2017-10-10 14:30:18-07:00 America/Los_Angeles
- No changes since last TRIAL
1.302099 2017-10-10 09:29:40-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix run_subtest inherit_trace option
1.302098 2017-10-03 06:13:49-07:00 America/Los_Angeles
- Add docs for test2_stdout and test2_stderr
- Fix 5.6 support
1.302097 2017-10-02 19:35:08-07:00 America/Los_Angeles
- Fix hub->process bug that could let an error pass
- Fix #789 (Modification of read only value)
- Fix typo in Test::Builder when looking for IPC (#777)
- Fix #791, clone_io broke on scalar io layer
- Fix #790 and #756, Exception event stingify exception
- Localize $^E in context (#780)
- Fix test that failed in verbose mode (#770)
1.302096 2017-09-10 21:16:18-07:00 America/Los_Angeles
- Fix to work with subref-in-stash optimisation (Father C.)
1.302095 2017-08-31 20:35:22-07:00 America/Los_Angeles (TRIAL RELEASE)
- Make several tests work with preload
1.302094 2017-08-30 21:27:23-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix Test::Builder in a preload scenario
1.302093 2017-08-29 21:05:20-07:00 America/Los_Angeles (TRIAL RELEASE)
- Make sure Test::Builder does not initialize Test2 too soon.
1.302092 2017-08-28 21:30:06-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix bug in Facets for TodoDiag
- Add API command to reset after a fork
- Add 'important' flag to info event facet
1.302091 2017-08-08 19:50:55-07:00 America/Los_Angeles (TRIAL RELEASE)
- Add 'new_root' constructor for formatters
- Add intercept_deep() to the API
- Fix bug in Version event
- Add 'number' attribute to assertion facet
1.302090 2017-07-09 21:10:08-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix test that unintentionally required Test2::Suite
1.302089 2017-07-09 20:51:19-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix plan in buffered subtest so that the facts say it is buffered
1.302088 2017-06-28 21:55:21-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix tests on perl 5.25+ with newer Data::Dumper
1.302087 2017-06-26 20:32:21-07:00 America/Los_Angeles (TRIAL RELEASE)
- Introduce 'Facets' for events
- Performance enhancements
- Upgrade inline HashBase
- Move Test2::Util::Trace to Test2::EventFacet::Trace
- Track hub id in Trace
- Remove Info event
- Add Pass and Fail events
- Remove Event JSON interface
1.302086 2017-06-20 10:43:13-07:00 America/Los_Angeles
- Make it possible to turn off result logging in Test::Builder
1.302085 2017-05-01 19:24:37-07:00 America/Los_Angeles
- No Changes since last TRIAL
1.302084 2017-04-29 20:42:48-07:00 America/Los_Angeles (TRIAL RELEASE)
- Better IO management
- Allow access to the STDERR/STDOUT Test2::API uses
- Formatters should use the Test2::API handles
1.302083 2017-04-14 10:55:26-07:00 America/Los_Angeles
- Update some breakage info for Test::More::Prefix and Test::DBIx::Class::Schema
1.302082 2017-04-11 12:56:24-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix test that incorrectly called private function as method
1.302081 2017-04-06 10:39:37-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix threads timeout for older perls (as best we can)
1.302080 2017-04-04 20:24:55-07:00 America/Los_Angeles (TRIAL RELEASE)
- Timeout when waiting for child procs and threads (#765)
- Fix SIGSYS localization issue (#758)
- Fix outdated docs (#759, #754)
- Fix bail-out in buffered subtest (#747)
1.302079 2017-04-03 12:12:02-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fixes for '. in @INC' changes (#768)
1.302078 2017-03-01 15:24:12-08:00 America/Los_Angeles
- No changes since last trial
1.302077 2017-02-19 14:34:30-08:00 America/Los_Angeles (TRIAL RELEASE)
- Fix #762, newlines for todo subtest
- Revisit #637, fix rare race condition it created
1.302076 2017-02-01 19:38:42-08:00 America/Los_Angeles (TRIAL RELEASE)
- Fix crash when TB->reset used inside subtest
1.302075 2017-01-10 19:39:28-08:00 America/Los_Angeles
- No changes, just marking a stable release
1.302074 2017-01-08 11:41:44-08:00 America/Los_Angeles (TRIAL RELEASE)
- Add 'cid' to trace
- Add signatures to trace
- Add related() to events
- Now it is possible to check if events are related
- Add 'no_fork' option to run_subtest()
1.302073 2016-12-18 23:02:54-08:00 America/Los_Angeles
- No changes from last trial
1.302072 2016-12-18 01:08:12-08:00 America/Los_Angeles (TRIAL RELEASE)
- Expose tools.pl as Test2::Tools::Tiny
1.302071 2016-12-17 12:08:29-08:00 America/Los_Angeles
- No changes since last trial release
1.302070 2016-12-14 21:32:47-08:00 America/Los_Angeles (TRIAL RELEASE)
- Added two new event classes, Test2::Event::Encoding and
Test2::Event::TAP::Version. These are primarily being added for the
benefit of Test2::Harness now, but they could be useful for other Test2
event consumer tools in the future. Implemented by Dave Rolsky (#743).
1.302069 2016-12-12 15:03:04-08:00 America/Los_Angeles (TRIAL RELEASE)
- Generate HashBase from Object::HashBase which has been split out
- When a subtest is marked as todo, all of its contained Ok and Subtest
events are now updated so that they return true for
$e->effective_pass. Implemented by Dave Rolsky. (#742)
1.302068 2016-12-03 13:50:01-08:00 America/Los_Angeles (TRIAL RELEASE)
- Add TO_JSON and from_json methods to Test2::Event and Test2::Trace::Util
to faciliate transferring event data between processes. Implemented by
Dave Rolsky. (#741).
1.302067 2016-11-23 07:37:56-08:00 America/Los_Angeles
- Fix context test for recent blead.
1.302066 2016-11-08 07:58:39-08:00 America/Los_Angeles (TRIAL RELEASE)
- Handle cases where SysV IPC can be available but not enabled
- Import 'context' into Test2::IPC, it is used by 'cull'
- Propogate warnings settings to use_ok (#736)
1.302065 2016-10-30 11:54:37-07:00 America/Los_Angeles (TRIAL RELEASE)
- Set the TEST_ACTIVE env var to true
- Set the TEST2_ACTIVE env var to true
- Fix the oldest bug still in the bug list (#6)
This fixes cmp_ok output is some confusing cases
- Update travis config
- Add missing author deps
- Fix handling of negative pid's on windows
- Add can() to Test::Tester::Delegate (despite deprecation)
- Fix some minor test issues
1.302064 2016-10-24 21:03:24-07:00 America/Los_Angeles (TRIAL RELEASE)
- Repo management improvements
- Better handling of info vs diag in ->send_event
- Fix test that used 'parent'
- Better handling of non-bumping failures (#728)
1.302063 2016-10-23 21:31:20-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix double release when 'throw' is used in context_do()
1.302062 2016-10-20 06:16:08-07:00 America/Los_Angeles
- No changes from last trial
1.302061 2016-09-30 14:49:19-07:00 America/Los_Angeles (TRIAL RELEASE)
- Removed a warning when using a non-TAP formatter with Test::Builder
about the formatter not "no_header" and "no_diag". This happened even if
the alternative formatter class implemented these attributes.
- When finalize is called on a formatter, it now receives one more
argument, a boolean indicating whether or not the call is for a subtest
or not.
1.302060 2016-09-25 12:46:46-07:00 America/Los_Angeles (TRIAL RELEASE)
- Formatters now have terminate() and finalize() methods. These are called
when there is a skip_all or bail event (terminate) or when a test suite
is exiting normally (finalize). This allows formatters to finalize their
output, which is important for any sort of document-oriented format (as
opposed to a stream format like TAP). (#723)
1.302059 2016-09-25 12:32:21-07:00 America/Los_Angeles
- No changes from last trial
1.302058 2016-09-21 10:46:13-07:00 America/Los_Angeles (TRIAL RELEASE)
- Mask warning when comparing $@ in Test2::API::Context
1.302057 2016-09-18 12:12:18-07:00 America/Los_Angeles (TRIAL RELEASE)
- Doc fixes
- Win32 color support in Test::Builder::Tester
- Support v-strings in is_deeply
- A streamed subtest run inside a buffered subtest will be automatically
converted to a buffered subtest. Otherwise the output from inside the
subtest is lost entirely. (#721)
1.302056 2016-09-12 09:03:49-07:00 America/Los_Angeles
- Minor typo fix
- No logic chnges since last trial
1.302055 2016-08-30 12:13:32-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix special case of ok line ending in \
- Improve a test that captures STDERR/STDOUT (Thanks HAARG)
1.302054 2016-08-20 16:21:44-07:00 America/Los_Angeles (TRIAL RELEASE)
- Allow '#' and '\n' in ok names
1.302053 2016-08-17 21:22:55-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix skip_all in require in intercept (#696)
- Documentation of what is better in Test2 (#663)
- Document Test::Builder::Tester plan limitations
- Document limitations in is_deeply (#595)
- Better documentation of done_testing purpose (#151)
- Make ctx->send_event detect termination events (#707)
1.302052 2016-08-13 14:34:07-07:00 America/Los_Angeles
- No Changes from last trial
1.302051 2016-08-11 20:26:22-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix setting hub when getting context
1.302050 2016-08-10 22:12:19-07:00 America/Los_Angeles (TRIAL RELEASE)
- Add contact info to main doc and readme
1.302049 2016-07-28 07:03:31-07:00 America/Los_Angeles
- No Changes from last trial
1.302048 2016-07-27 07:42:14-07:00 America/Los_Angeles (TRIAL RELEASE)
- Add 'active' attribute to hub
1.302047 2016-07-22 22:36:29-07:00 America/Los_Angeles
- No Changes from last trial
1.302046 2016-07-19 06:58:43-07:00 America/Los_Angeles (TRIAL RELEASE)
- Restore traditional note/diag return values (#694)
1.302045 2016-07-18 09:05:15-07:00 America/Los_Angeles
- No changes from last TRIAL release
1.302044 2016-07-13 17:56:20-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix test that segv'd on older perls
1.302043 2016-07-12 09:37:31-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix TODO in mixed T2/TB subtests
1.302042 2016-07-11 20:30:35-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix IPC event ordering bug
1.302041 2016-07-09 17:01:45-07:00 America/Los_Angeles (TRIAL RELEASE)
- Work around IPC bug on windows
1.302040 2016-07-09 16:55:00-07:00 America/Los_Angeles
- No changes from last trial
1.302039 2016-07-07 22:01:02-07:00 America/Los_Angeles (TRIAL RELEASE)
- Add Info event for better diagnostics
1.302038 2016-07-05 07:00:18-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix broken MANIFEST.SKIP entries (#689)
1.302037 2016-07-04 10:09:00-07:00 America/Los_Angeles
- No changes from trial
1.302036 2016-07-03 11:52:45-07:00 America/Los_Angeles (TRIAL RELEASE)
- Restore PerlIO layer cloning on STDERR and STDOUT
1.302035 2016-06-27 08:55:55-07:00 America/Los_Angeles
- No changes since TRIAL release
1.302034 2016-06-25 13:51:00-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix some breakage info (Thanks Dolman!)
- POD Fixes (Thanks cpansprout!)
1.302033 2016-06-24 05:56:54-07:00 America/Los_Angeles
- No changes from last trial release
1.302032 2016-06-22 11:30:46-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix nested TODO handling of Diags (#684)
1.302031 2016-06-21 09:51:27-07:00 America/Los_Angeles
- Remove carp from dep list #682
1.302030 2016-06-18 19:02:55-07:00 America/Los_Angeles
- No changes from last DEV release
1.302029 2016-06-17 06:56:54-07:00 America/Los_Angeles (TRIAL RELEASE)
- Properly skip thread test when threads are broken
1.302028 2016-06-16 19:21:58-07:00 America/Los_Angeles (TRIAL RELEASE)
- Add 'inherit_trace' param to run_subtest
1.302027 2016-06-15 09:42:32-07:00 America/Los_Angeles (TRIAL RELEASE)
- use pre_filter instead of filter for TODO in Test::Builder (Fix $683)
- Fix typos in transitions doc (#681)
1.302026 2016-06-07 07:53:30-07:00 America/Los_Angeles
- No Changes from 1.302025-TRIAL
1.302025 2016-06-06 22:38:12-07:00 America/Los_Angeles (TRIAL RELEASE)
- Make sure enabling culling/shm sets pid and tid (Fix #679)
1.302024 2016-06-02 20:27:35-07:00 America/Los_Angeles (TRIAL RELEASE)
- Add Generic event type
1.302023 2016-06-02 08:09:54-07:00 America/Los_Angeles (TRIAL RELEASE)
- Do not fail if Test2::API::Breakage cannot load (rare 5.10.0 issue)
- Potential fix for t/Legacy/Regression/637.t
- Make t/Legacy/Regression/637.t AUTHOR_TESTING for now
1.302022 2016-05-28 17:53:11-07:00 America/Los_Angeles
- Improve thread checks to better detect broken 5.10 builds
- Use thread checks to skip/run t/Legacy/Regression/637.t
1.302021 2016-05-20 21:47:17-07:00 America/Los_Angeles (TRIAL RELEASE)
- Files.t should warn, not die, if it cannot remove its temp dir.
- VMS fixes for Files.t and IPC system
1.302020 2016-05-18 11:54:15-07:00 America/Los_Angeles (TRIAL RELEASE)
- Many micro-opts from Graham Knop (haarg)
- Spelling fixes and tests from Karen Etheridge (ether)
- Fix leaky File.t file so that tmp doesn't fill up
- Move some modules out of the known broken list in xt tests
- Add Test2 based tools to downstream testing
- Change when PID/TID are stashed (for forkprove)
1.302019 2016-05-18 08:16:39-07:00 America/Los_Angeles
- POD Spelling fixes
1.302018 2016-05-14 09:08:05-07:00 America/Los_Angeles (TRIAL RELEASE)
- Handle Test::Builder::Exception properly
- Silence noisy STDERR in test suite
1.302017 2016-05-13 08:09:58-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix util.t win32 bug
1.302016 2016-05-12 19:43:38-07:00 America/Los_Angeles (TRIAL RELEASE)
- Block signals in critical IPC section (Fix #661 and #668)
- Merge Examples and examples into one dir (#660)
- Documentation and typo fixes
- Make Test2::Util::get_tid have a consistent prototype (#665)
- Make TB->no_plan a no-op if a plan is set
1.302015 2016-05-09 07:46:54-07:00 America/Los_Angeles
- Add Test::Alien to breakage info
- Add Device::Chip to breakage info
- Add subtest outdent to transition.pod
1.302014_010 2016-05-03 12:09:14-07:00 America/Los_Angeles (TRIAL RELEASE)
- RC10
- Update x-breaks, Breakage.pm, and Transition.POD
- Fix shared memory leak
- Fix typos and clarify docs.
1.302014_009 2016-04-27 10:05:18-07:00 America/Los_Angeles (TRIAL RELEASE)
- RC9
- No logic changes
- Update x-breaks stuff
- Update email addresses
1.302014_008 2016-04-26 11:40:40-07:00 America/Los_Angeles (TRIAL RELEASE)
- RC8
- Fix bug when using defined, but empty (or space) as a test name in a subtest
- Better notificatons for late Test::Builder load
- Recommend Test2::Transition if you have outdated modules
- Document Test::Builder::TodoDiag and Test::Builder::Formatter
1.302014_007 2016-04-24 13:09:03-07:00 America/Los_Angeles (TRIAL RELEASE)
- RC7
- Fix #642 - Persistent environments need to have ENDING flag cleared
1.302014_006 2016-04-24 02:31:13-07:00 America/Los_Angeles (TRIAL RELEASE)
- RC6
- Remove reduntant and problematic parts of 00-report.t
- No changes to actual code, just a test that provides diags
1.302014_005 2016-04-24 01:55:55-07:00 America/Los_Angeles (TRIAL RELEASE)
- RC5
- Prevent the breakage reporter from being a test failure
- No changes to actual code, just a test that provides diags
1.302014_004 2016-04-23 16:21:34-07:00 America/Los_Angeles (TRIAL RELEASE)
- RC4
- Update breakage info
- Fix IPC files driver to use the most significant data in the shm (needs test)
1.302014_003 2016-04-23 03:20:36-07:00 America/Los_Angeles (TRIAL RELEASE)
- RC3
- Localize $@ and $! when loading Data::Dumper in explain()
1.302014_002 2016-04-22 14:54:51-07:00 America/Los_Angeles (TRIAL RELEASE)
- RC2
- Restore X-Breaks meta info
- Keep dist.ini in the tarball
1.302014_001 2016-04-22 04:01:50-07:00 America/Los_Angeles (TRIAL RELEASE)
- RC1
- Merge Test2 into the Test-Simple dist
- Remove experimental status
- Update copyright dates
- Better error messages when using Carp in Hashbase init()
- Document 2 methods on Events
- Fix Test2 #17 (typo fix in docs)
- Report version mismatches between Test::Builder and Test2
- Update transition docs
- Breakage library and warnings
*****************************************************************************
* *
* BELOW THIS POINT ARE THE SEPERATE CHANGELOGS FOR Test-Simple, Test2, AND *
* Test-Stream. *
* *
*****************************************************************************
Test-Simple 1.302013_019 2016-04-13 20:23:18-07:00 America/Los_Angeles (TRIAL RELEASE)
- Expand no_numbers support to custom formatters
Test-Simple 1.302013_018 2016-04-07 21:23:03-07:00 America/Los_Angeles (TRIAL RELEASE)
- Support Test2 using an alternative formatter
Test-Simple 1.302013_017 2016-04-05 11:13:50-07:00 America/Los_Angeles (TRIAL RELEASE)
- Support subtest identification for events
- Bump minimum Test2 version
Test-Simple 1.302013_016 2016-04-04 21:33:20-07:00 America/Los_Angeles (TRIAL RELEASE)
- Support some newer event features from Test2
- Bump minimum Test2 version
Test-Simple 1.302013_015 2016-03-29 09:24:10-07:00 America/Los_Angeles (TRIAL RELEASE)
- Bump minimum Test2 version to protect from segv
Test-Simple 1.302013_014 2016-03-08 10:00:50-08:00 America/Los_Angeles (TRIAL RELEASE)
- Skip test added in last release when threading is not avilable
Test-Simple 1.302013_013 2016-03-08 09:19:39-08:00 America/Los_Angeles (TRIAL RELEASE)
- Test::Builder->reset now resets hub's idea of root pid/tid (#637)
Test-Simple 1.302013_012 2016-01-28 20:38:16-08:00 America/Los_Angeles (TRIAL RELEASE)
- $Level effects all contexts once Test::Builder is loaded
- Requires Test2 0.000023
Test-Simple 1.302013_011 2016-01-14 21:55:28-08:00 America/Los_Angeles (TRIAL RELEASE)
- Performance enhancements
Test-Simple 1.302013_010 2016-01-12 05:57:43-08:00 America/Los_Angeles (TRIAL RELEASE)
- Changes needed for Test2 0.000018
Test-Simple 1.302013_009 2016-01-11 16:35:57-08:00 America/Los_Angeles (TRIAL RELEASE)
- Make skip work without a count w/ done_testing (#629)
- Require newer Test2 that fixes $! squashing (#628)
Test-Simple 1.302013_008 2016-01-10 13:21:02-08:00 America/Los_Angeles (TRIAL RELEASE)
- Bump minimum Test2 version requirement (to fix downstream)
Test-Simple 1.302013_007 2016-01-07 19:30:04-08:00 America/Los_Angeles (TRIAL RELEASE)
- Bump minimum Test2 version requirement
Test-Simple 1.302013_006 2016-01-06 11:21:48-08:00 America/Los_Angeles (TRIAL RELEASE)
- Update for Test2 0.000013
- Delay loading Data::Dumper
- Test2::API::test2_no_wait(1) when threads/forking are on
- Fix Test::Tester to use context
- More downstream dists for testing
Test-Simple 1.302013_005 2015-12-29 13:01:32-08:00 America/Los_Angeles (TRIAL RELEASE)
- Updates for Test2 0.000012
- Helper for Test::SharedFork
Test-Simple 1.302013_004 2015-12-28 13:12:23-08:00 America/Los_Angeles (TRIAL RELEASE)
- Fix diag/note bugs from refactor
Test-Simple 1.302013_003 2015-12-22 09:41:46-08:00 America/Los_Angeles (TRIAL RELEASE)
- Fix bug in details() structure for subtests when the parent is todo
Test-Simple 1.302013_002 2015-12-21 13:21:51-08:00 America/Los_Angeles (TRIAL RELEASE)
- Updates for Test2 0.000010
Test-Simple 1.302013_001 2015-12-21 10:07:42-08:00 America/Los_Angeles (TRIAL RELEASE)
- Switch to using Test2 under the hood
- Use Dist::Zilla for releases
- Reformat Changes file
Test-Simple 1.302012_004 2015-Nov-16 07:45:11-08:00 PST
* Fix #600 - done_testing($count)
Test-Simple 1.302012_003 2015-Oct-27 00:02:44-08:00 PST
* Fix typo that called wrong 'try'
Test-Simple 1.302012_002 2015-Oct-02 21:57:19-08:00 PST
* Add version eval to several modules (#605)
Test-Simple 1.302012_001 2015-Oct-01 15:47:39-08:00 PST
* Support for Test::Stream 1.302012
Test-Simple 1.302010_001 2015-Sep-29 21:18:38-08:00 PST
* Support for Test::Stream 1.302010
* Some upstream package names changed
* Test::Stream's interface changed, tests needed to change too.
Test-Simple 1.302007_004 2015-Jul-27 21:13:39-08:00 PST
* Work around perlbug 125702
Test-Simple 1.302007_003 2015-Jul-24 08:34:46-08:00 PST
* Remove singleton from closure
Test-Simple 1.302007_002 2015-Jul-18 17:38:26-08:00 PST
* Fix subtest + Test::Stream::Tester
Test-Simple 1.302007_001 2015-Jun-24 08:06:00-08:00 PST
* Tests no longer copy thread/fork checks
* Bump minimum Test::Stream version
Test-Simple 1.302004_001 2015-Jun-17 08:33:00-08:00 PST
* Update for newer Test-Stream with XS support
* Use 'fudge' in Test::Stream instead of doing level adjustments here
* Fix minor POD encoding issue #593
* Some performance enhancements in T::B->ok
Test-Simple 1.302003_001 2015-Jan-06 21:52:00-08:00 PST
* Convert internals to use Test-Stream
* Optimizations for performance
* Note this is a completely new branch off of legacy/master, not taken from the old stream branches
Test-Simple 1.001014 2014-Dec-28 08:31:00-08:00 PST
* Write a test to ensure this changes file gets updated
* Update changes file for 1.001013
Test-Simple 1.001013 2014-Dec-28 08:00:00-08:00 PST
* Fix a unit test that broke on some platforms with spaces in the $^X path
Test-Simple 1.001012 2014-Dec-23 07:39:00-08:00 PST
* Move test that was dropped in the wrong directory
Test-Simple 1.001011 2014-Dec-20 09:08:00-08:00 PST
* Remove POD Coverage test
Test-Simple 1.001010 2014-Dec-19 20:16:00-08:00 PST
* Fix windows test bug #491
* Integrate Test::Tester and Test::use::ok for easier downgrade from trial
Test-Simple 1.001009 2014-Nov-2 22:31:08-08:00 PST
* Fix bug in cmp_ok
Test-Simple 1.001008 2014-Oct-15 20:10:22-08:00 PST
* Updated Changes file
Test-Simple 1.001007 2014-Oct-15 16:37:11-08:00 PST
* Fix subtest name when skip_all is used
Test-Simple 1.001006 2014-Sep-2 14:39:05-08:00 PST
* Reverted change that is now part of alpha branch
Test-Simple 1.001005 2014-Sep-2 19:47:19-08:00 JST
* Changed install path for perl 5.12 or higher.
Test-Simple 1.001004_003 2014-May-17 13:43-08:00 PST
* Another Minor doc fix to solve test bug
* Fix #399, conflict with strawberry-portable
Test-Simple 1.001004_002 2014-May-17 13:43-08:00 PST
* Minor doc fix to solve test bug
Test-Simple 1.001004_001 2014-May-10 08:39-08:00 PST
* Doc updates
* Subtests accept args
* Outdent subtest diag
Test-Simple 1.001003 2014-Mar-21 21:12-08:00 PST
* Doc updates for maintainer change
Test-Simple 1.001002 2013-Nov-4 15:13-08:00 EST
* no changes since 0.99
Test-Simple 1.001001_001 2013-Oct-30 20:47-08:00 EDT
* no code changes, just a new version number with more room to grow
Test-Simple 0.99 2013-Oct-29 13:21:03-08:00 EDT
* restore ability to use regex with test_err and test_out
(Zefram) [rt.cpan.org #89655] [github #389] [github #387]
Test-Simple 0.99 2013-Oct-12 15:05-08:00 EDT
* no changes since 0.98_06
Test-Simple 0.98_06 2013-Sep-27 10:11-08:00 EDT
Bug Fixes
* Fix precedence error with (return ... and ...)
(nthykier) [github #385]
Test-Simple 0.98_05 2013-Apr-23 17:33-08:00 PDT
Doc Changes
* Add a shorter work around for the UTF-8 output problem.
(Michael G Schwern)
Bug Fixes
* Test::Builder::Tester now works with subtests.
(Michael G Schwern) [github 350]
* Fix test_fail() inside a do statement.
(nnutter) [github #369]
New Features
* A subtest will put its name at the front of its results to make
subtests easier to read. [github #290] [github #364]
(Brendan Byrd)
Feature Changes
* like() and unlike() no longer warn about undef. [github #335]
(Michael G Schwern)
Test-Simple 0.98_04 2013-Apr-14 10:54-08:00 BST
Distribution Changes
* Scalar::Util 1.13 (ships with Perl 5.8.1) is now required.
(Michael G Schwern)
Feature Changes
* The default name and diagnostics for isa_ok() and new_ok() have
changed. (Michael G Schwern)
Docs Fixes
* Added a COMPATIBILITY section so users know what major features were
added with what version of Test::More or perl. [github 343] [github 344]
(pdl)
* Fix the ok() example with grep(). (derek.mead@gmail.com)
Bug Fixes
* A test with no plan and missing done_testing() now exits with non-zero.
[github #341] (tokuhirom)
* isa_ok() tests were broken in 5.17 because of a change in
method resolution. [github #353] (Michael G Schwern)
Test-Simple 0.98_03 2012-Jun-21 13:04-08:00 PDT
New Features
* cmp_ok() will error when used with something which is not a
comparison operator, including =, += and the like.
[github 141] (Matthew Horsfall)
Bug Fixes
* use_ok() was calling class->import without quoting which could
cause problems if "class" is also a function.
Doc Fixes
* use_ok() has been discouraged and de-emphasized as a general
replacement for `use` in tests. [github #288]
* $thing is now $this in the docs to avoid confusing users of
other languages. [Karen Etheridge]
Incompatible Changes With Previous Alphas (0.98_01)
* use_ok() will no longer apply lexical pragams. The incompatibilities
and extra complexity is not worth the marginal use.
[github #287]
Test-Simple 0.98_02 2011-Nov-24 01:13-08:00 PST
Bug Fixes
* use_ok() in 0.98_01 was leaking pragmas from inside Test::More.
This looked like Test::More was forcing strict. [rt.cpan.org 67538]
(Father Chrysostomos)
Test-Simple 0.98_01 2011-Nov-8 17:07-08:00 PST
Bug Fixes
* BAIL_OUT works inside a subtest. (Larry Leszczynski) [github #138]
* subtests now work with threads turned on. [github #145]
Feature Changes
* use_ok() will now apply lexical effects. [rt.cpan.org 67538]
(Father Chrysostomos)
Misc
* Test::More, Test::Simple and Test::Builder::Module now require
a minimum version of Test::Builder. This avoids Test::More and
Test::Builder from getting out of sync. [github #89]
Test-Simple 0.98 2011-Fev-23 14:38:02 +1100
Bug Fixes
* subtest() should not fail if $? is non-zero. (Aaron Crane)
Docs
* The behavior of is() and undef has been documented. (Pedro Melo)
Test-Simple 0.97_01 2010-Aug-27 22:50-08:00 PDT
Test Fixes
* Adapted the tests for the new Perl 5.14 regex stringification.
(Karl Williamson) [github 44]
Doc Fixes
* Document how to test "use Foo ()". (Todd Rinaldo) [github 41]
Feature Changes
* subtest() no longer has a prototype. It was just getting in the way.
[rt.cpan.org 54239]
* The filehandles used by default will now inherit any filehandle
disciplines from STDOUT and STDERR IF AND ONLY IF they were applied
before Test::Builder is loaded. More later. [rt.cpan.org 46542]
Test-Simple 0.96 2010-Aug-10 21:13-08:00 PDT
Bug Fixes
* You can call done_testing() again after reset() [googlecode 59]
Other
* Bug tracker moved to github
Test-Simple 0.95_02 2010-May-19 15:46-08:00 PDT
Bug Fixes
* Correct various typos and spelling errors (Nick Cleaton)
* Fix alignment of indented multi-line diagnostics from subtests
(Nick Cleaton)
* Fix incorrect operation when subtest called from within a todo block
(Nick Cleaton)
* Avoid spurious output after a fork within a subtest
(Nick Cleaton)
Test-Simple 0.95_01 2010-Mar-3 15:36-08:00 PST
Bug Fixes
* is_deeply() didn't see a difference in regexes [rt.cpan.org 53469]
* Test::Builder::Tester now sets $tb->todo_output to the output handle and
not the error handle (to be in accordance with the default behaviour of
Test::Builder and allow for testing TODO test behaviour).
* Fixed file/line in failing subtest() diagnostics. (Nick Cleaton)
* Protect against subtests setting $Level (Nick Cleaton)
New Features
* subtests without a 'plan' or 'no_plan' have an implicit 'done_testing()'
added to them.
* is_deeply() performance boost for large structures consisting of
mostly non-refs (Nick Cleaton)
Feature Changes
* is() and others will no longer stringify its arguments before
comparing. Overloaded objects will make use of their eq
overload rather than their "" overload. This can break tests of
impolitely string overloaded objects. DateTime prior to 0.54 is
the biggest example.
Test-Simple 0.94 2009-Sep-2 11:17-08:00 PDT
Releasing 0.93_01 as stable.
Test-Simple 0.93_01 2009-Jul-20 09:51-08:00 PDT
Bug Fixes
* Make sure that subtest works with Test:: modules which call
Test::Builder->new at the top of their code. (Ovid)
Other
* subtest() returns!
Test-Simple 0.92 2009-Jul-3 11:08-08:00 PDT
Test Fixes
* Silence noise on VMS in exit.t (Craig Berry)
* Skip Builder/fork_with_new_stdout.t on systems without fork (Craig Berry)
Test-Simple 0.90 2009-Jul-2 13:18-08:00 PDT
Docs
* Note the IO::Stringy license in our copy of it.
[test-more.googlecode.com 47]
Other
* This is a stable release for 5.10.1. It does not include
the subtest() work in 0.89_01.
Test-Simple 0.89_01 2009-Jun-23 15:13-08:00 EDT
New Features
* subtest() allows you to run more tests in their own plan.
(Thanks Ovid!)
* Test::Builder->is_passing() will let you check if the test is
currently passing.
Docs
* Finally added a note about the "Wide character in print" warning and
how to work around it.
Test Fixes
* Small fixes for integration with the Perl core
[bleadperl eaa0815147e13cd4ab5b3d6ca8f26544a9f0c3b4]
* exit code tests could be effected by errno when PERLIO=stdio
[bleadperl c76230386fc5e6fba9fdbeab473abbf4f4adcbe3]
Test-Simple 0.88 2009-May-30 12:31-08:00 PDT
Turing 0.87_03 into a stable release.
Test-Simple 0.87_03 2009-May-24 13:41-08:00 PDT
New Features
* isa_ok() now works on classes. (Peter Scott)
Test-Simple 0.87_02 2009-Apr-11 12:54-08:00 PDT
Test Fixes
* Some filesystems don't like it when you open a file for writing multiple
times. Fixes t/Builder/reset.t. [rt.cpan.org 17298]
* Check how an operating system is going to map exit codes. Some OS'
will map them... sometimes. [rt.cpan.org 42148]
* Fix Test::Builder::NoOutput on 5.6.2.
Test-Simple 0.87_01 2009-Mar-29 09:56-08:00 BST
New Features
* done_testing() allows you to declare that you have finished running tests,
and how many you ran. It is a safer no_plan and effectively replaces it.
* output() now supports scalar references.
Feature Changes
* You can now run a test without first declaring a plan. This allows
done_testing() to work.
* You can now call current_test() without first declaring a plan.
Bug Fixes
* skip_all() with no reason would output "1..0" which is invalid TAP. It will
now always include the SKIP directive.
Other
* Repository moved to github.
Test-Simple 0.86 2008-Nov-9 01:09-08:00 PST
Same as 0.85_01
Test-Simple 0.85_01 2008-Oct-23 18:57-08:00 PDT
New Features
* cmp_ok() now displays the error if the comparison throws one.
For example, broken overloaded objects.
Bug Fixes
* cmp_ok() no longer stringifies or numifies its arguments before comparing.
This makes cmp_ok() properly test overloaded ops.
[rt.cpan.org 24186] [code.google.com 16]
* diag() properly escapes blank lines.
Feature Changes
* cmp_ok() now reports warnings and errors as coming from inside cmp_ok,
as well as reporting the caller's file and line. This let's the user
know where cmp_ok() was called from while reminding them that it is
being run in a different context.
Other
* Dependency on ExtUtils::MakeMaker 6.27 only on Windows otherwise the
nested tests won't run.
Test-Simple 0.84 2008-Oct-15 09:06-08:00 EDT
Other
* 0.82 accidentally shipped with experimental Mouse dependency.
Test-Simple 0.82 2008-Oct-14 23:06-08:00 EDT
Bug Fixes
- 0.81_01 broke $TODO such that $TODO = '' was considered todo.
Test-Simple 0.81_02 2008-Sep-9 04:35-08:00 PDT
New Features
* Test::Builder->reset_outputs() to reset all the output methods back to
their defaults.
Bug Fixes
- Fixed the file and line number reported by like when it gets a bad
regex.
Feature Changes
- Now preserves the tests' exit code if it exits abnormally, rather than
setting it to 255.
- Changed the "Looks like your test died" message to
"Looks like your test exited with $exit_code"
- no_plan now only warns if given an argument. There were a lot of people
doing that, and it's a sensible mistake. [test-more.googlecode.com 13]
Test-Simple 0.81_01 2008-Sep-6 15:13-08:00 PDT
New Features
* Adam Kennedy bribed me to add new_ok(). The price was one DEFCON license key.
[rt.cpan.org 8891]
* TODO tests can now start and end with 'todo_start' and 'todo_end'
Test::Builder methods. [rt.cpan.org 38018]
* Added Test::Builder->in_todo() for a safe way to check if a test is inside a
TODO block. This allows TODO tests with no reason.
* Added note() and explain() to both Test::More and Test::Builder.
[rt.cpan.org 14764] [test-more.googlecode.com 3]
Feature Changes
* Changed the message for extra tests run to show the number of tests run rather than
the number extra to avoid the user having to do mental math.
[rt.cpan.org 7022]
Bug fixes
- using a relative path to perl broke tests [rt.cpan.org 34050]
- use_ok() broke $SIG{__DIE__} in the used module [rt.cpan.org 34065]
- diagnostics for isnt() were confusing on failure [rt.cpan.org 33642]
- warnings when MakeMaker's version contained _ [rt.cpan.org 33626]
- add explicit test that non-integer plans die correctly [rt.cpan.org 28836]
(Thanks to Hans Dieter Pearcey [confound] for fixing the above)
- die if no_plan is given an argument [rt.cpan.org 27429]
Test-Simple 0.80 2008-Apr-6 17:25-08:00 CEST
Test fixes
- Completely disable the utf8 test. It was causing perl to panic on some OS's.
Test-Simple 0.79_01 2008-Feb-27 03:04-08:00 PST
Bug fixes
- Let's try the IO layer copying again, this time with the test
fixed for 5.10.
Test-Simple 0.78 2008-Feb-27 01:59-08:00 PST
Bug fixes
* Whoops, the version of Test::Builder::Tester got moved backwards.
Test-Simple 0.77 2008-Feb-27 01:55-08:00 PST
Bug fixes
- "use Test::Builder::Module" no longer sets exported_to() or does
any other importing.
- Fix the $TODO finding code so it can find $TODO without the benefit
of exported_to(), which is often wrong.
- Turn off the filehandle locale stuff for the moment, there's a
problem on 5.10. We'll try it again next release.
Doc improvements
- Improve the Test::Builder SYNOPSIS to use Test::Builder::Module
rather than write it's own import().
Test-Simple 0.76_02 2008-Feb-24 13:12-08:00 PST
Bug fixes
* The default test output filehandles will NOT use utf8.
They will now copy the IO layers from STDOUT and STDERR.
This means if :utf8 is on then it will honor it and not
warn about wide characters.
Test-Simple 0.76_01 2008-Feb-23 20:44-08:00 PST
Bug fixes
* Test::Builder no longer uses a __DIE__ handler. This resolves a number
of problems with exit codes being swallowed or other module's handlers
being interfered with. [rt.cpan.org 25294]
- Allow maybe_regex() to detect blessed regexes. [bleadperl @32880]
- The default test output filehandles will now use utf8.
[rt.cpan.org 21091]
Test fixes
- Remove the signature test. Adds no security and just generates
failures.
Test-Simple 0.75 2008-Feb-23 19:03-08:00 PST
Incompatibilities
* The minimum version is now 5.6.0.
Bug fixes
- Turns out require_ok() had the same bug as use_ok() in a BEGIN block.
- ok() was not honoring exported_to() when looking for $TODO as it
should be.
Test fixes
* is_deeply_with_threads.t will not run unless AUTHOR_TESTING is set.
This is because it tickles intermittent threading bugs in many perls
and causes a lot of bug reports about which I can do nothing.
Misc
- Ran through perlcritic and did some cleaning.
Test-Simple 0.74 2007-Nov-29 15:39-08:00 PST
Misc
- Add abstract and author to the meta information.
Test-Simple 0.73_01 2007-Oct-15 20:35-08:00 EDT
Bug fixes
* Put the use_ok() fix from 0.71 back.
Test-Simple 0.72 2007-Sep-19 20:08-08:00 PDT
Bug unfixes
* The BEGIN { use_ok } fix for [rt.cpan.org 28345] revealed a small pile of
mistakes in CPAN module test suites. Rolling the fix back to give the
authors a bit of time to fix their tests.
Test-Simple 0.71 2007-Sep-13 20:42-08:00 PDT
Bug fixes
- Fixed a problem with BEGIN { use_ok } silently failing when there's no
plan set. [rt.cpan.org 28345] Thanks Adriano Ferreira and Yitzchak.
- Fixed an obscure problem with is_deeply() and overloading ==
[rt.cpan.org 20768]. Thanks Sisyphus.
Test fixes
- Removed dependency on Text::Soundex [rt.cpan.org 25022]
- Fixed a 5.5.x failure in fail-more.t
* Got rid of the annoying sort_bug.t test that revealed problems with some
threaded perls. It was testing the deprecated eq_* functions and not
worth the bother. Now it tests is_deeply(). [rt.cpan.org 17791]
Doc fixes
- Minor POD mistake in Test::Builder [rt.cpan.org 28869]
* Test::FAQ has been updated with some more answers.
Install fixes
- Fixed the "LICENSE is not a known MakeMaker parameter name" warning
on older MakeMakers for real this time.
Test-Simple 0.70 2007-Mar-15 15:53-08:00 PDT
Bug Fixes
* The change to is_fh() in 0.68 broke the case where a reference to
a tied filehandle is used for perl 5.6 and back. This made the tests
puke their guts out.
Test-Simple 0.69 2007-Mar-14 06:43-08:00 PDT
Test fixes
- Minor filename compatibility fix to t/fail-more.t [rt.cpan.org 25428]
Test-Simple 0.68 2007-Mar-13 17:27-08:00 PDT
Bug fixes
* If your code has a $SIG{__DIE__} handler in some cases functions like
use_ok(), require_ok(), can_ok() and isa_ok() could trigger that
handler. [rt.cpan.org 23509]
- Minor improvement to TB's filehandle detection in the case of overridden
isa(). [rt.cpan.org 20890]
- Will now install as a core module in 5.6.2 which ships with Test::More.
[rt.cpan.org 25163]
New Features
- Test::Builder->is_fh() provides a way to determine if a thing
can be used as a filehandle.
Documentation improvements
- Improved the docs for $Test::Builder::Level showing the encouraged
use (increment, don't set)
- Documented the return value of Test::Builder's test methods
- Split out TB's method documentation to differenciate between test
methods (ok, is_eq...), methods useful in testing (skip, BAILOUT...)
and methods useful for building your own tests (maybe_regex...).
Test fixes
- We required too old a version of Test::Pod::Coverage. Need 1.08 and not
1.00. [rt.cpan.org 25351]
Test-Simple 0.67 2007-Jan-22 13:27-08:00 PST
Test fixes
- t/pod_coverage.t would fail if Test::Pod::Coverage between 1.07 and
1.00 were installed as it depended on all_modules being exported.
[rt.cpan.org 24483]
Test-Simple 0.66 2006-Dec-3 15:25-08:00 PST
- Restore 5.4.5 compatibility (unobe@cpan.org) [rt.cpan.org 20513]
Test-Simple 0.65 2006-Nov-10 10:26-08:00 CST
Test-Simple 0.64_03 2006-Nov-5 13:09-08:00 EST
- Tests will no longer warn when run against an alpha version of
Test::Harness [rt.cpan.org #20501]
- Now testing our POD and POD coverage.
- Added a LICENSE field.
- Removed warning from the docs about mixing numbered and unnumbered
tests. There's nothing wrong with that. [rt.cpan.org 21358]
- Change doc examples to talk about $got and $expected rather than
$this and $that to correspond better to the diagnostic output
[rt.cpan.org 2655]
Test-Simple 0.64_02 2006-Sep-9 12:16-08:00 EDT
- Last release broke Perls earlier than 5.8.
Test-Simple 0.64_01 2006-Sep-4 04:40-08:00 EDT
- Small improvement to the docs to avoid user confusion over
"use Test::More tests => $num_tests" (Thanks Eric Wilhelm)
- Minor fix for a test failure in is_deeply_fail for some Windows
users. Not a real bug. [rt.cpan.org 21310]
- _print_diag() accidentally leaked into the public documentation.
It is a private method.
* Added Test::Builder->carp() and croak()
* Made most of the error messages report in the caller's context.
[rt.cpan.org #20639]
* Made the failure diagnostic message file and line reporting portion
match Perl's for easier integration with Perl aware editors.
(so its "at $file line $line_num." now)
[rt.cpan.org #20639]
* 5.8.0 threads are no longer supported. There's too many bugs.
Test-Simple 0.64 2006-Jul-16 02:47-08:00 PDT
* 0.63's change to test_fail() broke backwards compatibility. They
have been removed for the time being. test_pass() went with it.
This is [rt.cpan.org 11317] and [rt.cpan.org 11319].
- skip() will now warn if you get the args backwards.
Test-Simple 0.63 2006-Jul-9 02:36-08:00 PDT
* Fixed can_ok() to gracefully handle no class name.
Submitted by "Pete Krawczyk" <perl@bsod.net>
Implemented by "Richard Foley" <richard.foley@rfi.net>
[rt.cpan.org 15654]
* Added test_pass() to Test::Builder::Tester rather than having to
call test_out("ok 1 - foo"). <chromatic@wgz.org> [rt.cpan.org 11317]
* test_fail() now accepts a test diagnostic rather than having to
call test_out() separately. <chromatic@wgz.org> [rt.cpan.org 11319]
- Changed Test::Builder::Tester docs to show best practice using
test_fail() and test_pass().
- isnt_num() doc example wrongly showed is_num(). <chromatic@wgz.org>
- Fixed a minor typo in the BAIL_OUT() docs. <Jeff Deifik>
- Removed the LICENSE field from the Makefile.PL as the release of
MakeMaker with that feature has been delayed.
Test-Simple 0.62 2005-Oct-8 01:25-08:00 PDT
* Absorbed Test::Builder::Tester. The last release broke it because its
screen scraping Test::More and the failure output changed. By
distributing them together we ensure TBT won't break again.
* Test::Builder->BAILOUT() was missing.
- is_deeply() can now handle function and code refs in a very limited
way. It simply looks to see if they have the same referent.
[rt.cpan.org 14746]
Test-Simple 0.61 2005-Sep-23 23:26-08:00 PDT
- create.t was trying to read from a file before it had been closed
(and thus the changes may not have yet been written).
* is_deeply() would call stringification methods on non-object strings
which happened to be the name of a string overloaded class.
[rt.cpan.org 14675]
Test-Simple 0.60_02 2005-Aug-9 00:27-08:00 PDT
* Added Test::Builder::Module.
- Changed Test::More and Test::Simple to use Test::Builder::Module
- Minor Win32 testing nit in fail-more.t
* Added no_diag() method to Test::Builder and changed Test::More's
no_diag internals to use that. [rt.cpan.org 8655]
* Deprecated no_diag() as an option to "use Test::More". Call the
Test::Builder method instead.
Test-Simple 0.60_01 2005-Jul-3 18:11-08:00 PDT
- Moved the docs around a little to better group all the testing
functions together. [rt.cpan.org 8388]
* Added a BAIL_OUT() function to Test::More [rt.cpan.org 8381]
- Changed Test::Builder->BAILOUT to BAIL_OUT to match other method's
naming conventions. BAILOUT remains but is deprecated.
* Changed the standard failure diagnostics to include the test name.
[rt.cpan.org 12490]
- is_deeply() was broken for overloaded objects in the top level in
0.59_01. [rt.cpan.org 13506]
- String overloaded objects without an 'eq' or '==' method are now
handled in cmp_ok() and is().
- cmp_ok() will now treat overloaded objects as numbers if the comparison
operator is numeric. [rt.cpan.org 13156]
- cmp_ok(), like() and unlike will now throw uninit warnings if their
arguments are undefined. [rt.cpan.org 13155]
- cmp_ok() will now throw warnings as if the comparison were run
normally, for example cmp_ok(2, '==', 'foo') will warn about 'foo'
not being numeric. Previously all warnings in the comparison were
suppressed. [rt.cpan.org 13155]
- Tests will now report *both* the number of tests failed and if the
wrong number of tests were run. Previously if tests failed and the
wrong number were run it would only report the latter.
[rt.cpan.org 13494]
- Missing or extra tests are not considered failures for the purposes
of calculating the exit code. Should there be no failures but the
wrong number of tests the exit code will be 254.
- Avoiding an unbalanced sort in eq_set() [bugs.perl.org 36354]
- Documenting that eq_set() doesn't deal well with refs.
- Clarified how is_deeply() compares a bit.
* Once again working on 5.4.5.
Test-Simple 0.60 2005-May-3 14:20-08:00 PDT
Test-Simple 0.59_01 2005-Apr-26 21:51-08:00 PDT
* Test::Builder now has a create() method which allows you to create
a brand spanking new Test::Builder object.
* require_ok() was not working for single letter module names.
* is_deeply() and eq_* now work with circular scalar references
(Thanks Fergal)
* Use of eq_* now officially discouraged.
- Removed eq_* from the SYNOPSIS.
- is_deeply(undef, $not_undef); now works. [rt.cpan.org 9441]
- is_deeply() was mistakenly interpreting the same reference used twice
in a data structure as being circular causing failures.
[rt.cpan.org 11623]
- Loading Test::Builder but not using it would interfere with the
exit code if the code exited. [rt.cpan.org 12310]
- is_deeply() diagnostics now disambiguate between stringified references
and references. [rt.cpan.org 8865]
- Files opened by the output methods are now autoflushed.
- todo() now honors $Level when looking for $TODO.
Test-Simple 0.54 2004-Dec-15 04:18-08:00 EST
* $how_many is optional for skip() and todo_skip(). Thanks to
Devel::Cover for pointing this out.
- Removed a user defined function called err() in the tests to placate
users of older versions of the dor patch before err() was weakend.
[rt.cpan.org 8734]
Test-Simple 0.53_01 2004-Dec-11 19:02-08:00 EST
- current_test() can now be set backward.
- *output() methods now handle tied handles and *FOO{IO} properly.
- maybe_regex() now handles undef gracefully.
- maybe_regex() now handles 'm,foo,' style regexes.
- sort_bug.t wasn't checking for threads properly. Would fail on
5.6 that had ithreads compiled in. [rt.cpan.org 8765]
Test-Simple 0.53 2004-Nov-29 04:43-08:00 EST
- Apparently its possible to have Module::Signature installed without
it being functional. Fixed the signature test to account for this.
(not a real bug)
Test-Simple 0.52 2004-Nov-28 21:41-08:00 EST
- plan() now better checks that the given plan is valid.
[rt.cpan.org 2597]
Test-Simple 0.51_02 2004-Nov-27 01:25-08:00 EST
* is_deeply() and all the eq_* functions now handle circular data
structures. [rt.cpan.org 7289]
* require_ok() now handles filepaths in addition to modules.
- Clarifying Test::More's position on overloaded objects
- Fixed a bug introduced in 0.51_01 causing is_deeply() to pierce
overloaded objects.
- Mentioning rt.cpan.org for reporting bugs.
Test-Simple 0.51_01 2004-Nov-26 02:59-08:00 EST
- plan() was accidentally exporting functions [rt.cpan.org 8385]
* diag @msgs would insert # between arguments. [rt.cpan.org 8392]
* eq_set() could cause problems under threads due to a weird sort bug
[rt.cpan.org 6782]
* undef no longer equals '' in is_deeply() [rt.cpan.org 6837]
* is_deeply() would sometimes compare references as strings.
[rt.cpan.org 7031]
- eq_array() and eq_hash() could hold onto references if they failed
keeping them in memory and preventing DESTROY. [rt.cpan.org 7032]
* is_deeply() could confuse [] with a non-existing value
[rt.cpan.org 7030]
- is_deeply() diagnostics a little off when scalar refs were inside
an array or hash ref [rt.cpan.org 7033]
- Thanks to Fergal Daly for ferretting out all these long standing
is_deeply and eq_* bugs.
Test-Simple 0.51 2004-Nov-23 04:51-08:00 EST
- Fixed bug in fail_one.t on Windows (not a real bug).
- TODO reasons as overloaded objects now won't blow up under threads.
[Autrijus Tang]
- skip() in 0.50 tickled yet another bug in threads::shared. Hacked
around it.
Test-Simple 0.50 2004-Nov-20 00:28-08:00 EST
- Fixed bug in fail-more test on Windows (not a real bug).
[rt.cpan.org 8022]
- Change from CVS to SVK. Hopefully this is the last time I move
version control systems.
- Again removing File::Spec dependency (came back in 0.48_02)
- Change from Aegis back to CVS
Test-Simple 0.49 2004-Oct-14 21:58-08:00 EDT
- t/harness_active.t would fail for frivolous reasons with older
MakeMakers (test bug) [thanks Bill Moseley for noticing]
Test-Simple 0.48_02 2004-Jul-19 02:07-08:00 EDT
* Overloaded objects as names now won't blow up under threads
[rt.cpan.org 4218 and 4232]
* Overloaded objects which stringify to undef used as test names
now won't cause internal uninit warnings. [rt.cpan.org 4232]
* Failure diagnostics now come out on their own line when run in
Test::Harness.
- eq_set() sometimes wasn't giving the right results if nested refs
were involved [rt.cpan.org 3747]
- isnt() giving wrong diagnostics and warning if given any undefs.
* Give unlike() the right prototype [rt.cpan.org 4944]
- Change from CVS to Aegis
- is_deeply() will now do some basic argument checks to guard against
accidentally passing in a whole array instead of its reference.
- Mentioning Test::Differences, Test::Deep and Bundle::Test.
- Removed dependency on File::Spec.
- Fixing the grammar of diagnostic outputs when only a single test
is run or failed (ie. "Looks like you failed 1 tests").
[Darren Chamberlain]
Test-Simple 0.48_01 2002-Nov-11 02:36-08:00 EST
- Mention Test::Class in Test::More's SEE ALSO
* use_ok() now DWIM for version checks
- More problems with ithreads fixed.
* Test::Harness upgrade no longer optional. It was causing too
many problems when the T::H upgrade didn't work.
* Drew Taylor added a 'no_diag' option to Test::More to switch
off all diag() statements.
* Test::Builder/More no longer automatically loads threads.pm
when threads are enabled. The user must now do this manually.
* Alex Francis added reset() reset the state of Test::Builder in
persistent environments.
- David Hand noted that Test::Builder/More exit code behavior was
not documented. Only Test::Simple.
Test-Simple 0.47 2002-Aug-26 03:54-08:00 PDT
* Tatsuhiko Miyagawa noticed Test::Builder was accidentally storing
objects passed into test functions causing problems with tests
relying on object destruction.
- Added example of calculating the number of tests to Test::Tutorial
- Peter Scott made the ending logic not fire on child processes when
forking.
* Test::Builder is once again ithread safe.
Test-Simple 0.46 2002-Jul-20 19:57-08:00 EDT
- Noted eq_set() isn't really a set comparison.
- Test fix, exit codes are broken on MacPerl (bleadperl@16868)
- Make Test::Simple install itself into the core for >= 5.8
- Small fixes to Test::Tutorial and skip examples
* Added TB->has_plan() from Adrian Howard
- Clarified the meaning of 'actual_ok' from TB->details
* Added TB->details() from chromatic
- Neil Watkiss fixed a pre-5.8 test glitch with threads.t
* If the test died before a plan, it would exit with 0 [ID 20020716.013]
Test-Simple 0.45 2002-Jun-19 18:41-08:00 EDT
- Andy Lester made the SKIP & TODO docs a bit clearer.
- Explicitly disallowing double plans. (RT #553)
- Kicking up the minimum version of Test::Harness to one that's
fairly bug free.
- Made clear a common problem with use_ok and BEGIN blocks.
- Arthur Bergman made Test::Builder thread-safe.
Test-Simple 0.44 2002-Apr-25 00:27-08:00 EDT
- names containing newlines no longer produce confusing output
(from chromatic)
- chromatic provided a fix so can_ok() honors can() overrides.
- Nick Ing-Simmons suggested todo_skip() be a bit clearer about
the skipping part.
- Making plan() vomit if it gets something it doesn't understand.
- Tatsuhiko Miyagawa fixed use_ok() with pragmata on older perls.
- quieting diag(undef)
Test-Simple 0.43 2002-Apr-11 22:55-08:00 EDT
- Adrian Howard added TB->maybe_regex()
- Adding Mark Fowler's suggestion to make diag() return
false.
- TB->current_test() still not working when no tests were run via
TB itself. Fixed by Dave Rolsky.
Test-Simple 0.42 2002-Mar-6 15:00-08:00 EST
- Setting Test::Builder->current_test() now works (see what happens
when you forget to test things?)
- The change in is()'s undef/'' handling in 0.34 was an API change,
but I forgot to declare it as such.
- The apostrophilic jihad attacks! Philip Newtons patch for
grammar mistakes in the doc's.
Test-Simple 0.41 2001-Dec-17 22:45-08:00 EST
* chromatic added diag()
- Internal eval()'s sometimes interfering with $@ and $!. Fixed.
Test-Simple 0.40 2001-Dec-14 15:41-08:00 EST
* isa_ok() now accepts unblessed references gracefully
- Nick Clark found a bug with like() and a regex with % in it.
- exit.t was hanging on 5.005_03 VMS perl. Test now skipped.
- can_ok() would pass if no methods were given. Now fails.
- isnt() diagnostic output format changed
* Added some docs about embedding and extending Test::More
* Added Test::More->builder
* Added cmp_ok()
* Added todo_skip()
* Added unlike()
- Piers pointed out that sometimes people override isa().
isa_ok() now accounts for that.
Test-Simple 0.36 2001-Nov-29 14:07-08:00 EST
- Matthias Urlichs found that intermixed prints to STDOUT and test
output came out in the wrong order when piped.
Test-Simple 0.35 2001-Nov-27 19:57-08:00 EST
- Little glitch in the test suite. No actual bug.
Test-Simple 0.34 2001-Nov-27 15:43-08:00 EST
* **API CHANGE** Empty string no longer matches undef in is()
and isnt().
* Added isnt_eq and isnt_num to Test::Builder.
Test-Simple 0.33 2001-Oct-22 21:05-08:00 EDT
* It's now officially safe to redirect STDOUT and STDERR without
affecting test output.
- License and POD cleanup by Autrijus Tang
- Synched up Test::Tutorial with the wiki version
- Minor VMS test nit.
Test-Simple 0.32 2001-Oct-16 16:52-08:00 EDT
* Finally added a separate plan() function
* Adding a name field to isa_ok()
(Requested by Dave Rolsky)
- Test::More was using Carp.pm, causing the occasional false positive.
(Reported by Tatsuhiko Miyagawa)
Test-Simple 0.31 2001-Oct-8 19:24-08:00 EDT
* Added an import option to Test::More
* Added no_ending and no_header options to Test::Builder
(Thanks to Dave Rolsky for giving this a swift kick in the ass)
* Added is_deeply(). Display of scalar refs not quite 100%
(Thanks to Stas Bekman for Apache::TestUtil idea thievery)
- Fixed a minor warning with skip()
(Thanks to Wolfgang Weisselberg for finding this one)
Test-Simple 0.30 2001-Sep-27 22:10-08:00 EDT
* Added Test::Builder
(Thanks muchly to chromatic for getting this off the ground!)
* Diagnostics are back to using STDERR *unless* it's from a todo
test. Those go to STDOUT.
- Fixed it so nothing is printed if a test is run with a -c flag.
Handy when a test is being deparsed with B::Deparse.
Test-Simple 0.20 *UNRELEASED*
Test-Simple 0.19 2001-Sep-18 17:48-08:00 EDT
* Test::Simple and Test::More no longer print their diagnostics
to STDERR. It instead goes to STDOUT.
* TODO tests which fail now print full failure diagnostics.
- Minor bug in ok()'s test name diagnostics made it think a blank
name was a number.
- ok() less draconian about test names
- Added temporary special case for Parrot::Test
- Now requiring File::Spec for our tests.
Test-Simple 0.18 2001-Sep-5 20:35-08:00 EDT
* ***API CHANGE*** can_ok() only counts as one test
- can_ok() has better diagnostics
- Minor POD fixes from mjd
- adjusting the internal layout to make it easier to put it into
the core
Test-Simple 0.17 2001-Aug-29 20:16-08:00 EDT
* Added can_ok() and isa_ok() to Test::More
Test-Simple 0.16 2001-Aug-28 19:52-08:00 EDT
* vmsperl foiled my sensible exit codes. Reverting to a much more
coarse scheme.
Test-Simple 0.15 2001-Aug-28 06:18-08:00 EDT *UNRELEASED*
* Now using sensible exit codes on VMS.
Test-Simple 0.14 2001-Aug-22 17:26-08:00 EDT
* Added a first cut at Test::Tutorial
Test-Simple 0.13 2001-Aug-14 15:30-08:00 EDT
* Added a reason to the skip_all interface
- Fixed a bug to allow 'use Test::More;' to work.
(Thanks to Tatsuhiko Miyagawa again)
- Now always testing backwards compatibility.
Test-Simple 0.12 2001-Aug-14 11:02-08:00 EDT
* Fixed some compatibility bugs with older Perls
(Thanks to Tatsuhiko Miyagawa)
Test-Simple 0.11 2001-Aug-11 23:05-08:00 EDT
* Will no longer warn about testing undef values
- Escaping # in test names
- Ensuring that ok() returns true or false and not undef
- Minor doc typo in the example
Test-Simple 0.10 2001-Jul-31 15:01-08:00 EDT
* Test::More is now distributed in this tarball.
* skip and todo tests work!
* Extended use_ok() so it can import
- A little internal rejiggering
- Added a TODO file
Test-Simple 0.09 2001-Jun-27 02:55-08:00 EDT
- VMS fixes
Test-Simple 0.08 2001-Jun-15 14:39-08:00 EDT
- Guarding against $/ and -l
- Reformatted the way failed tests are reported to make them stand out
a bit better.
Test-Simple 0.07 2001-Jun-12 15:55-08:00 BST
- 'use Test::Simple' by itself no longer causes death
- Yet more fixes for death in eval
- Limiting max failures reported via exit code to 254.
Test-Simple 0.06 2001-May-9 23:38-08:00 BST
- Whoops, left a private method in the public docs.
Test-Simple 0.05 2001-May-9 20:40-08:00 BST
- Forgot to include the exit tests.
- Trouble with exiting properly under 5.005_03 and 5.6.1 fixed
- Turned off buffering
* 5.004 new minimum version
- Now explicitly tested with 5.6.1, 5.6.0, 5.005_03 and 5.004
Test-Simple 0.04 2001-Apr-2 11:05-08:00 BST
- Fixed "require Test::Simple" so it doesn't bitch and exit 255
- Now installable with the CPAN shell.
Test-Simple 0.03 2001-Mar-30 08:08-08:00 BST
- ok() now prints on what line and file it failed.
- eval 'die' was considered abnormal. Fixed.
Test-Simple 0.02 2001-Mar-30 05:12-08:00 BST *UNRELEASED*
- exit codes tested
* exit code on abnormal exit changed to 255 (thanks to Tim Bunce for
pointing out that Unix can't do negative exit codes)
- abnormal exits now better caught.
- No longer using Test.pm to test this, but still minimum of 5.005
due to needing $^S.
Test-Simple 0.01 2001-Mar-28 06:44-08:00 BST
- First working version released to CPAN
Test2 0.000044 2016-04-30 13:56:25-07:00 America/Los_Angeles
- Remove things that should nto have been backported from Test-Simple merger
Test2 0.000043 2016-04-30 05:21:51-07:00 America/Los_Angeles
- Better error messages when using Carp in Hashbase init()
- Document 2 methods on Events
- Fix #17 (typo fix in docs)
Test2 0.000042 2016-04-15 13:17:21-07:00 America/Los_Angeles
- Let TAP render generic events
- Add the no_display method to the Event API
- Improve T2_FORMATTER parsing
Test2 0.000041 2016-04-13 20:21:38-07:00 America/Los_Angeles
- Do not use custom formatter in sensitive tests
Test2 0.000040 2016-04-05 11:09:52-07:00 America/Los_Angeles
- Track subtest info inside subtest events
Test2 0.000039 2016-04-04 21:32:08-07:00 America/Los_Angeles
- Formatters can pick buffered subtest behavior
- Add sets_plan() method to event base class
- Add diagnostics() method to event base class
Test2 0.000038 2016-04-03 15:41:39-07:00 America/Los_Angeles
- Add summary() method to event base class
Test2 0.000037 2016-04-01 08:41:22-07:00 America/Los_Angeles
- Change Formatter to load Test2::API on demand
- Add test to insure Test2::API is not loaded by some modules
Test2 0.000036 2016-03-28 11:44:53-07:00 America/Los_Angeles
- Do not warn if unimportant INIT block cannot be run
- Change how TAP duplicates IO handles, use 3 arg form of open
Test2 0.000035 2016-03-25 09:41:46-07:00 America/Los_Angeles (TRIAL RELEASE)
- More fixes for #16
- Add some END block manipulation for #16
- Turn off depth checking on older perls (for #16)
Test2 0.000034 2016-03-24 10:32:57-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix depth bug introduced in the last trial
Test2 0.000033 2016-03-24 08:39:51-07:00 America/Los_Angeles (TRIAL RELEASE)
- Better fox for #16 (workaround for caller() in END bug)
- Put test for #16 in regular testing dir as new fix is more stable
Test2 0.000032 2016-03-23 23:54:40-07:00 America/Los_Angeles (TRIAL RELEASE)
- Fix #16 (workaround for caller() in END bug)
Test2 0.000031 2016-03-20 13:45:43-07:00 America/Los_Angeles
- Regenerate README files
- Apply spelling fixes (aquire->acquire) #11
- Improve error message for missing hubs #12
Test2 0.000030 2016-03-15 08:04:21-07:00 America/Los_Angeles
- Re-Add transition document
Test2 0.000029 2016-03-09 10:04:19-08:00 America/Los_Angeles
- Add pid to Files driver temp dir name
Test2 0.000028 2016-03-09 09:03:26-08:00 America/Los_Angeles
- Environment var to control IPC::Driver::Files temp dir templates
Test2 0.000027 2016-03-07 12:16:34-08:00 America/Los_Angeles
- Ability to disable skip_all subtest abort construct
Test2 0.000026 2016-03-06 20:15:19-08:00 America/Los_Angeles
- Version number in all modules (autarch)
- Fix rare/minor Race condition in Files IPC driver
- skip-all plan is not global anymore (never should have been)
- skip-all properly aborts in child proc/thread
- don't override defined but falsy pid/rid in traces
Test2 0.000025 2016-02-02 12:08:32-08:00 America/Los_Angeles
- Fix occasional warning in cleanup
Test2 0.000024 2016-01-29 21:16:56-08:00 America/Los_Angeles
- Add no_context() (needed for external tool)
Test2 0.000023 2016-01-28 20:34:09-08:00 America/Los_Angeles
- Add context_do()
- Add context_aquire hooks
- Documentation updates
- Typo fixes (thanks rjbs)
- Minor enhancement to test tools
Test2 0.000022 2016-01-18 11:58:40-08:00 America/Los_Angeles
- Fix test that broke in the last release (oops)
Test2 0.000021 2016-01-18 10:54:54-08:00 America/Los_Angeles
- Fix bug where default diagnostics were not shown for subtests.
Test2 0.000020 2016-01-14 21:52:43-08:00 America/Los_Angeles
- Change how contexts are stacked
- More/better messages when contexts are abused
- better handling of $@, $!, and $?
- Add pre_filter and pre_unfilter to Hubs
Test2 0.000019 2016-01-12 16:08:11-08:00 America/Los_Angeles
- Make third-party meta-data interface consistent.
Test2 0.000018 2016-01-12 05:53:29-08:00 America/Los_Angeles
- Better solution to the $?, $!, and $@ problem
- error vars are stored/restored by the context
Test2 0.000017 2016-01-11 16:33:55-08:00 America/Los_Angeles
- Fix $! squashing
Test2 0.000016 2016-01-10 11:54:57-08:00 America/Los_Angeles
- Better encapsulation of API::Instance
- API methods to get lists of hooks
- Minor fixes to IPC shm logic
- Preload event types when API is loaded
- Added IPC acceptance tests
Test2 0.000015 2016-01-07 19:26:58-08:00 America/Los_Angeles
- Make it possible to use a custom new() with HashBase
Test2 0.000014 2016-01-07 07:31:23-08:00 America/Los_Angeles
- Silence a warning in older perls (warning breaks Test-Simple tests)
Test2 0.000013 2016-01-06 11:12:21-08:00 America/Los_Angeles
- Remove diag from inside todo (separation of concerns, less TAP influence)
- Remove internal TODO tracking (not needed, less TAP influence)
- Make context less magic (Follwing advice from Graham Knop and RJBS)
- Remove State.pm (part of Hub.pm again, no longer needs to be separate)
- Make it possible to subclass the TAP formatter
- Minor optimization in Event->meta
- Better messaging if subtest plan is wrong
- HashBase in subclass will not override accessors from parent (Graham Knop)
- TAP formatter doc updates
- Optimizations for Hub->process and TAP->Write
- IPC File-Driver Optimizations
- IPC use SHM when possible to notify about pending events
Test2 0.000012 2015-12-29 12:59:26-08:00 America/Los_Angeles
- Restructure file layout
- Document namespaces
- Combine Global and API into a single module
Test2 0.000011 2015-12-28 13:09:38-08:00 America/Los_Angeles
- Fix TAP output to match what Test::More produced
Test2 0.000010 2015-12-21 13:13:33-08:00 America/Los_Angeles
- Rename Test2.pm to Test2/API.pm.
- Turn Global.pm into and exporter.
Test2 0.000009 2015-12-21 10:13:18-08:00 America/Los_Angeles
- Fix typo in Test2::Event
Test2 0.000008 2015-12-21 09:54:58-08:00 America/Los_Angeles
- Bring back 'release' export of Test2.
Test2 0.000007 2015-12-20 12:09:04-08:00 America/Los_Angeles
- Fix version number string
- Fix typo
Test2 0.000006 2015-12-15 20:30:46-08:00 America/Los_Angeles
- Port 00-report.t from old form
- Prevent TAP from killing $!
- Fix Instance.t
- Typo fix
- Comment Contex.pm better, fix minor bug
- Better error in Trace.pm constructor
- Test2.pm, comments, and do not use try
- Improve try, remove protect
- Remove unused imports
- Fix profling scripts
- Improve HashBase
- IPC improvements
- Doc fix
Test2 0.000005 2015-12-14 20:21:34-08:00 America/Los_Angeles
- Pull out guts into Test2 namespace
- Restructure module paths
- Simplify HashBase
- Combine Util and Capabilities
- Update Profiling scripts
- Rename DebugInfo to Trace
- Rename SyncObj to Global/Instance
- Slim down Util.pm
- Stop using Test::Stream::Exporter
- Reduce complexity of Capabilities checker
- Use event todo instead of debuginfo todo
- Add 'todo' fields for Diag and Ok events
- Break out Skip into an event type
- Add event registration to TAP formatter
- Move to_tap logic into formatter
Test-Stream 1.302026 2015-11-09 14:34:30-08:00 America/Los_Angeles
- No functional changes since the last trial
- Doc fix (fixes #52)
- Doc fix (fixes #55)
- Doc fix in Classic bundle
- Doc fixes for FromTestBuilder
Test-Stream 1.302025 2015-11-06 16:33:06-08:00 America/Los_Angeles (TRIAL RELEASE)
- Add back cmp_ok in Core plugin
- Add Classic plugin for legacy is/like/is_deeply/etc
- Make docs recommend people moving from Test::More use -Classic
Test-Stream 1.302024 2015-11-04 11:15:14-08:00 America/Los_Angeles
- Add missing undef compare test
Test-Stream 1.302023 2015-11-04 00:12:49-08:00 America/Los_Angeles (TRIAL RELEASE)
- String and Number comparisons no longer allow undef (backwards-incompatible change, sorry)
- Doc spelling fixes (Evan Zacks)
- Add Undef type in deep check
- Fix docs for buffered subtests (Noticed by Magnolia.K)
Test-Stream 1.302022 2015-11-03 09:43:39-08:00 America/Los_Angeles
- Change Delta.pm to use a grep instead of a map (minor change)
- Fix scalar-ref comparison for overloaded scalar refs (#50)
Test-Stream 1.302021 2015-10-31 08:15:22-07:00 America/Los_Angeles
- Remove all number vs string guessing
- Doc fixes (thanks Magnolia.K)
- Add details to test report
Test-Stream 1.302020 2015-10-29 08:02:25-07:00 America/Los_Angeles
- No changes, just removing trial
Test-Stream 1.302019 2015-10-28 22:32:06-07:00 America/Los_Angeles (TRIAL RELEASE)
- Declare Test::Stream experimental phase complete
- Updated Readme
- Add tooling manual page
- Better Trace::Mask behavior
- Added Components manual page
- Remove or modify experimental notice
- Remove stray debugging statements
- Slight change in module list in t/00-report.t
Test-Stream 1.302018 2015-10-26 16:47:45-07:00 America/Los_Angeles
- Better stack traces in spec
- Remove duplicate module from the report
- Rename subs in try {} and protect {}
- Fix loop in SkipWithout
- Fix Typo in Context pod
Test-Stream 1.302017 2015-10-15 21:32:50-07:00 America/Los_Angeles
- Change minimum module versions (they were wrong)
- Typo fixes in Test::Stream docs
- Remove unused variable
- Fix Compare line number bug
Test-Stream 1.302016 2015-10-12 18:49:35-07:00 America/Los_Angeles
- Workflows/Spec: Argument tolerence, custom line numbers
- Remove Block.pm
- Add sub_info and sub_name to Util.pm
- Workflows: Set sub name if possible (better debugging)
- Add "Test" that prints deps and versions
- Add 'class', 'skip_without', and 'srand' to Test::Stream as options
- Even Core deps now listed in dist.ini
- Add some missing docs and tests to Util.pm
Test-Stream 1.302015 2015-10-04 13:46:56-07:00 America/Los_Angeles
- Remove spec isolation logic, this can be an external plugin
Test-Stream 1.302014 2015-10-03 20:30:14-07:00 America/Los_Angeles
- Another Delta.t fix
Test-Stream 1.302013 2015-10-02 21:51:45-07:00 America/Los_Angeles
- Fix Util.t for some Term::ReadKey versions
Test-Stream 1.302012 2015-10-01 15:42:27-07:00 America/Los_Angeles
- Remove reservations file
- Documentation updates (add missing docs)
- Fix output handle in subtest diagnostics
- Better subtest diagnostics
- Whitespace fixes
- Better error handling in threads in the workflows
- Better support real fork vs pseudo fork
Test-Stream 1.302011 2015-09-30 21:05:57-07:00 America/Los_Angeles
- Documentation updates, typo fixes
- Be safer, and less verbose, when detecting term size
- Fix isolation in the spec plugin in windows
- Skip sync test on windows (temporary measure)
- Skip the hub.t fork check on windows (temporary measure)
- Add some debugging to CanThread
- Fix global event handling on platforms that do not use '/' for path
- Fix Delta.t on systems with large memory addresses
Test-Stream 1.302010 2015-09-29 22:23:28-07:00 America/Los_Angeles
- Add spec plugin (with basic workflows modules)
- Switch to plugin architecture, Test::Stream is just a loader
- Add plugins (many of these were non-plugins before)
AuthorTest BailOnFail Capabilities
Capture Class Compare
Context Core Defer
DieOnFail Exception ExitSummary
Grab IPC Intercept
LoadPlugin Mock SRand
SkipWithout Spec Subtest
TAP UTF8 Warnings
- CanFork is now a plugin
- CanThread is now a plugin
- Subtest stack fallback fix
- Better Compare library
- Documentation is fleshed out and mostly complete
- Unit testing coverage is now satisfactory
- Better detection of broken threads on 5.10.0
- Ability to set/change encoding
- is_deeply() is now combined into is()
- mostly_like() and like() are combined
- DeepCheck library removed in favor of Compare library
- deep checks now render a table
- Test directory restructuring
- Mocking library
- Workflow library
- Fix typos
- Fix a GC destruction issue (b3a96db)
Test-Stream 1.302009 2015-07-03 21:16:08-07:00 America/Los_Angeles
- Fix MANIFEST.SKIP so tests are not skipped
- Change import aliasing syntax to match prior art
- Fix bug in does_ok
- Documentation updates
Test-Stream 1.302008 2015-06-27 15:21:55-07:00 America/Los_Angeles
- Fix 2 bugs with threading on 5.8.x
- Fix a diag rendering bug with subtests
Test-Stream 1.302007 2015-06-24 08:03:38-07:00 America/Los_Angeles
- Add CanThread and CanFork libraries
- Remove prefix when subtests are buffered
- Fix bug where Exporter might remove other tools exports
- Fix bug in unmunge and unlisten
- Add helper for specifying a context in which to run
- Add causes_fail method for events
- Fix rendering bug in subtest diags
- Fix bug where IPC abort would fail to set exit code
- Remove XS support code
- Fix bug when threads are auto-joined
Test-Stream 1.302006 2015-06-18 09:53:04-07:00 America/Los_Angeles
- MANIFEST.SKIP fix
- Remove files accidentally included in the last dist
Test-Stream 1.302005 2015-06-18 09:37:38-07:00 America/Los_Angeles
- Remove broken test script
Test-Stream 1.302004 2015-06-17 08:32:31-07:00 America/Los_Angeles
- Add Support for XS
- Improve release_pp with refcount from internals
Test-Stream 1.302003 2015-06-06 21:44:42-07:00 America/Los_Angeles
- Documentation added
- Make IPC::Files safe in cleanup
Test-Stream 1.302002 2015-06-06 14:06:57-07:00 America/Los_Angeles
- Fix Win32 support
Test-Stream 1.302001 2015-06-05 22:40:57-07:00 America/Los_Angeles
- Initial Version
PK 1��\��d� � READMEnu �[��� NAME
Test2 - Framework for writing test tools that all work together.
DESCRIPTION
Test2 is a new testing framework produced by forking Test::Builder,
completely refactoring it, adding many new features and capabilities.
WHAT IS NEW?
Easier to test new testing tools.
From the beginning Test2 was built with introspection capabilities.
With Test::Builder it was difficult at best to capture test tool
output for verification. Test2 Makes it easy with
Test2::API::intercept().
Better diagnostics capabilities.
Test2 uses an Test2::API::Context object to track filename, line
number, and tool details. This object greatly simplifies tracking for
where errors should be reported.
Event driven.
Test2 based tools produce events which get passed through a
processing system before being output by a formatter. This event
system allows for rich plugin and extension support.
More complete API.
Test::Builder only provided a handful of methods for generating lines
of TAP. Test2 took inventory of everything people were doing with
Test::Builder that required hacking it up. Test2 made public API
functions for nearly all the desired functionality people didn't
previously have.
Support for output other than TAP.
Test::Builder assumed everything would end up as TAP. Test2 makes no
such assumption. Test2 provides ways for you to specify alternative
and custom formatters.
Subtest implementation is more sane.
The Test::Builder implementation of subtests was certifiably insane.
Test2 uses a stacked event hub system that greatly improves how
subtests are implemented.
Support for threading/forking.
Test2 support for forking and threading can be turned on using
Test2::IPC. Once turned on threading and forking operate sanely and
work as one would expect.
GETTING STARTED
If you are interested in writing tests using new tools then you should
look at Test2::Suite. Test2::Suite is a separate cpan distribution that
contains many tools implemented on Test2.
If you are interested in writing new tools you should take a look at
Test2::API first.
NAMESPACE LAYOUT
This describes the namespace layout for the Test2 ecosystem. Not all
the namespaces listed here are part of the Test2 distribution, some are
implemented in Test2::Suite.
Test2::Tools::
This namespace is for sets of tools. Modules in this namespace should
export tools like ok() and is(). Most things written for Test2 should
go here. Modules in this namespace MUST NOT export subs from other
tools. See the "Test2::Bundle::" namespace if you want to do that.
Test2::Plugin::
This namespace is for plugins. Plugins are modules that change or
enhance the behavior of Test2. An example of a plugin is a module that
sets the encoding to utf8 globally. Another example is a module that
causes a bail-out event after the first test failure.
Test2::Bundle::
This namespace is for bundles of tools and plugins. Loading one of
these may load multiple tools and plugins. Modules in this namespace
should not implement tools directly. In general modules in this
namespace should load tools and plugins, then re-export things into the
consumers namespace.
Test2::Require::
This namespace is for modules that cause a test to be skipped when
conditions do not allow it to run. Examples would be modules that skip
the test on older perls, or when non-essential modules have not been
installed.
Test2::Formatter::
Formatters live under this namespace. Test2::Formatter::TAP is the only
formatter currently. It is acceptable for third party distributions to
create new formatters under this namespace.
Test2::Event::
Events live under this namespace. It is considered acceptable for third
party distributions to add new event types in this namespace.
Test2::Hub::
Hub subclasses (and some hub utility objects) live under this
namespace. It is perfectly reasonable for third party distributions to
add new hub subclasses in this namespace.
Test2::IPC::
The IPC subsystem lives in this namespace. There are not many good
reasons to add anything to this namespace, with exception of IPC
drivers.
Test2::IPC::Driver::
IPC drivers live in this namespace. It is fine to create new IPC
drivers and to put them in this namespace.
Test2::Util::
This namespace is for general utilities used by testing tools. Please
be considerate when adding new modules to this namespace.
Test2::API::
This is for Test2 API and related packages.
Test2::
The Test2:: namespace is intended for extensions and frameworks. Tools,
Plugins, etc should not go directly into this namespace. However
extensions that are used to build tools and plugins may go here.
In short: If the module exports anything that should be run directly by
a test script it should probably NOT go directly into Test2::XXX.
SEE ALSO
Test2::API - Primary API functions.
Test2::API::Context - Detailed documentation of the context object.
Test2::IPC - The IPC system used for threading/fork support.
Test2::Formatter - Formatters such as TAP live here.
Test2::Event - Events live in this namespace.
Test2::Hub - All events eventually funnel through a hub. Custom hubs
are how intercept() and run_subtest() are implemented.
CONTACTING US
Many Test2 developers and users lurk on irc://irc.perl.org/#perl-qa and
irc://irc.perl.org/#toolchain. We also have a slack team that can be
joined by anyone with an @cpan.org email address
https://perl-test2.slack.com/ If you do not have an @cpan.org email you
can ask for a slack invite by emailing Chad Granum <exodist@cpan.org>.
SOURCE
The source code repository for Test2 can be found at
http://github.com/Test-More/test-more/.
MAINTAINERS
Chad Granum <exodist@cpan.org>
AUTHORS
Chad Granum <exodist@cpan.org>
COPYRIGHT
Copyright 2018 Chad Granum <exodist@cpan.org>.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
See http://dev.perl.org/licenses/
PK 1��\���4� � examples/indent.plnu �[��� PK 1��\��W \ \ � examples/subtest.tnu �[��� PK 1��\�w�Z� � � examples/tools.plnu �[��� PK 1��\� \: : � examples/tools.tnu �[��� PK 1��\
��nl l A# t/Legacy/Bugs/600.tnu �[��� PK 1��\,�nC� � �$ t/Legacy/Bugs/629.tnu �[��� PK 1��\� �͏ � �( t/Legacy/Builder/Builder.tnu �[��� PK 1��\�
|VK K �+ t/Legacy/Builder/carp.tnu �[��� PK 1��\دL�2 2 a. t/Legacy/Builder/create.tnu �[��� PK 1��\R��F �1 t/Legacy/Builder/current_test.tnu �[��� PK 1��\�p�*� � , .3 t/Legacy/Builder/current_test_without_plan.tnu �[��� PK 1��\ �|� � s4 t/Legacy/Builder/details.tnu �[��� PK 1��\ �I�� � �@ t/Legacy/Builder/done_testing.tnu �[��� PK 1��\+x � � & �A t/Legacy/Builder/done_testing_double.tnu �[��� PK 1��\�,^�z z - 5F t/Legacy/Builder/done_testing_plan_mismatch.tnu �[��� PK 1��\�VN�� � , J t/Legacy/Builder/done_testing_with_no_plan.tnu �[��� PK 1��\���W� � + K t/Legacy/Builder/done_testing_with_number.tnu �[��� PK 1��\1�|#� � ) GL t/Legacy/Builder/done_testing_with_plan.tnu �[��� PK 1��\����< < ' 9M t/Legacy/Builder/fork_with_new_stdout.tnu �[��� PK 1��\x#��n n �P t/Legacy/Builder/has_plan.tnu �[��� PK 1��\3I�c c �R t/Legacy/Builder/has_plan2.tnu �[��� PK 1��\����� � 4T t/Legacy/Builder/is_fh.tnu �[��� PK 1��\��v�� � KX t/Legacy/Builder/is_passing.tnu �[��� PK 1��\ �Hc" " a t/Legacy/Builder/maybe_regex.tnu �[��� PK 1��\�Q 6 6 �f t/Legacy/Builder/no_diag.tnu �[��� PK 1��\ȣ�Lm m oh t/Legacy/Builder/no_ending.tnu �[��� PK 1��\�� �* * (j t/Legacy/Builder/no_header.tnu �[��� PK 1��\���� � ! �k t/Legacy/Builder/no_plan_at_all.tnu �[��� PK 1��\3�ݽ� � �n t/Legacy/Builder/ok_obj.tnu �[��� PK 1��\a�k�� � �p t/Legacy/Builder/output.tnu �[��� PK 1��\��� �x t/Legacy/Builder/reset.tnu �[��� PK 1��\� �z H� t/Legacy/Builder/reset_outputs.tnu �[��� PK 1��\��QX� � �� t/Legacy/Builder/try.tnu �[��� PK 1��\��� � � ه t/Legacy/Regression/637.tnu �[��� PK 1��\4I�b� � % � t/Legacy/Regression/683_thread_todo.tnu �[��� PK 1��\ �^� � t/Legacy/Regression/6_cmp_ok.tnu �[��� PK 1��\n�� f� t/Legacy/Regression/736_use_ok.tnu �[��� PK 1��\�筠 � # ē t/Legacy/Regression/789-read-only.tnu �[��� PK 1��\�S�� � �� t/Legacy/Simple/load.tnu �[��� PK 1��\a+ n� � �� t/Legacy/Test2/Subtest.tnu �[��� PK 1��\53�m� � �� t/Legacy/Tester/tbt_01basic.tnu �[��� PK 1��\�$�R� � ! � t/Legacy/Tester/tbt_02fhrestore.tnu �[��� PK 1��\a��q� � � t/Legacy/Tester/tbt_03die.tnu �[��� PK 1��\I���� � � t/Legacy/Tester/tbt_04line_num.tnu �[��� PK 1��\[Ƥj8 8 )� t/Legacy/Tester/tbt_05faildiag.tnu �[��� PK 1��\j_ ! �� t/Legacy/Tester/tbt_06errormess.tnu �[��� PK 1��\d/�� � � t/Legacy/Tester/tbt_07args.tnu �[��� PK 1��\u�q � t/Legacy/Tester/tbt_08subtest.tnu �[��� PK 1��\e�F F ^� t/Legacy/Tester/tbt_09do.tnu �[��� PK 1��\�T�� � " �� t/Legacy/Tester/tbt_09do_script.plnu �[��� PK 1��\�&$�2 2 � t/Legacy/eq_set.tnu �[��� PK 1��\��(� � �� t/Legacy/exit.tnu �[��� PK 1��\)� �F F s� t/Legacy/explain.tnu �[��� PK 1��\Wr�z z �� t/Legacy/explain_err_vars.tnu �[��� PK 1��\�xL�r r �� t/Legacy/extra.tnu �[��� PK 1��\�
� � r� t/Legacy/extra_one.tnu �[��� PK 1��\7:E; ; D� t/Legacy/fail-like.tnu �[��� PK 1��\�&�4* 4* �� t/Legacy/fail-more.tnu �[��� PK 1��\eO��� � ; t/Legacy/fail.tnu �[��� PK 1��\
VL�i i X" t/Legacy/fail_one.tnu �[��� PK 1��\-e" " & t/Legacy/filehandles.tnu �[��� PK 1��\+�Og� � l' t/Legacy/fork.tnu �[��� PK 1��\{�s� � s) t/Legacy/harness_active.tnu �[��� PK 1��\J��� � q/ t/Legacy/import.tnu �[��� PK 1��\�6��w w �0 t/Legacy/is_deeply_dne_bug.tnu �[��� PK 1��\�5ί. . i4 t/Legacy/is_deeply_fail.tnu �[��� PK 1��\ni+�y y ! �b t/Legacy/is_deeply_with_threads.tnu �[��� PK 1��\f�0M M �h t/Legacy/missing.tnu �[��� PK 1��\���� � m t/Legacy/new_ok.tnu �[��� PK 1��\B��
p t/Legacy/no_log_results.tnu �[��� PK 1��\��=H H jq t/Legacy/no_plan.tnu �[��� PK 1��\�Ԏ%7 7 �t t/Legacy/no_tests.tnu �[��� PK 1��\�z�Y� � nx t/Legacy/note.tnu �[��� PK 1��\��� � � Mz t/Legacy/overload.tnu �[��� PK 1��\\S��� � � t/Legacy/overload_threads.tnu �[��� PK 1��\tk��� � �� t/Legacy/plan.tnu �[��� PK 1��\�� f0 0 � t/Legacy/plan_bad.tnu �[��� PK 1��\�by� � �� t/Legacy/plan_is_noplan.tnu �[��� PK 1��\fq�� c� t/Legacy/plan_no_plan.tnu �[��� PK 1��\< `�& & ē t/Legacy/plan_shouldnt_import.tnu �[��� PK 1��\��5� � 9� t/Legacy/plan_skip_all.tnu �[��� PK 1��\ 㮊 ?� t/Legacy/require_ok.tnu �[��� PK 1��\ 3i� � �� t/Legacy/run_test.tnu �[��� PK 1��\��/�� � `� t/Legacy/simple.tnu �[��� PK 1��\��<o� � i� t/Legacy/skip.tnu �[��� PK 1��\wF��� � U� t/Legacy/skipall.tnu �[��� PK 1��\�� G� � x� t/Legacy/strays.tnu �[��� PK 1��\��4� � % �� t/Legacy/tbm_doesnt_set_exported_to.tnu �[��� PK 1��\�lqz z �� t/Legacy/thread_taint.tnu �[��� PK 1��\oy�
h h x� t/Legacy/threads.tnu �[��� PK 1��\�q6�
"� t/Legacy/todo.tnu �[��� PK 1��\�R��� � �� t/Legacy/undef.tnu �[��� PK 1��\���`) ) �� t/Legacy/use_ok.tnu �[��� PK 1��\�ph,m m �� t/Legacy/useing.tnu �[��� PK 1��\�Tn�� � �� t/Legacy/utf8.tnu �[��� PK 1��\� � �� t/Legacy/versions.tnu �[��� PK 1��\��;�l l � t/Legacy/subtest/args.tnu �[��� PK 1��\~) * �� t/Legacy/subtest/bail_out.tnu �[��� PK 1��\^�=� � � t/Legacy/subtest/basic.tnu �[��� PK 1��\^Dc � � ( t/Legacy/subtest/callback.tnu �[��� PK 1��\!_� k t/Legacy/subtest/die.tnu �[��� PK 1��\�� � � t/Legacy/subtest/do.tnu �[��� PK 1��\I|!x x ( t/Legacy/subtest/events.tnu �[��� PK 1��\sv~$p p �
t/Legacy/subtest/for_do_t.testnu �[��� PK 1��\Y �U� � � t/Legacy/subtest/fork.tnu �[��� PK 1��\\SF�� � � t/Legacy/subtest/implicit_done.tnu �[��� PK 1��\h v� � t/Legacy/subtest/line_numbers.tnu �[��� PK 1��\S�a a J" t/Legacy/subtest/plan.tnu �[��� PK 1��\���� � �' t/Legacy/subtest/predicate.tnu �[��� PK 1��\-��+� � *; t/Legacy/subtest/singleton.tnu �[��� PK 1��\�]� � � >> t/Legacy/subtest/threads.tnu �[��� PK 1��\ �d�V V 6@ t/Legacy/subtest/todo.tnu �[��� PK 1��\�?�q q �U t/Legacy/subtest/wstat.tnu �[��� PK 1��\���G� � �W t/Legacy/00test_harness_check.tnu �[��� PK 1��\�s�Z Z �Z t/Legacy/01-basic.tnu �[��� PK 1��\��TY� � t[ t/Legacy/478-cmp_ok_hash.tnu �[��� PK 1��\���c� � Y_ t/Legacy/BEGIN_require_ok.tnu �[��� PK 1��\�ߍ�� � sa t/Legacy/BEGIN_use_ok.tnu �[��� PK 1��\�omQb b >c t/Legacy/More.tnu �[��� PK 1��\��g�V V �w t/Legacy/auto.tnu �[��� PK 1��\,��� � tz t/Legacy/bad_plan.tnu �[��� PK 1��\L�\DS S �| t/Legacy/bail_out.tnu �[��� PK 1��\X�6~� � <� t/Legacy/buffer.tnu �[��� PK 1��\0O_�� � 9� t/Legacy/c_flag.tnu �[��� PK 1��\���� � D� t/Legacy/capture.tnu �[��� PK 1��\��1� � n� t/Legacy/check_tests.tnu �[��� PK 1��\.F
b� � 9� t/Legacy/circular_data.tnu �[��� PK 1��\9��R 1� t/Legacy/cmp_ok.tnu �[��� PK 1��\"�5� t� t/Legacy/depth.tnu �[��� PK 1��\]Þϐ � 3� t/Legacy/diag.tnu �[��� PK 1��\8���y y � t/Legacy/died.tnu �[��� PK 1��\\�� % �� t/Legacy/dont_overwrite_die_handler.tnu �[��� PK 1��\I}��< < ( � t/Legacy_And_Test2/builder_loaded_late.tnu �[��� PK 1��\.١�� � % �� t/Legacy_And_Test2/diag_event_on_ok.tnu �[��� PK 1��\p�el3 3 $ � t/Legacy_And_Test2/hidden_warnings.tnu �[��� PK 1��\�`S� � & u� t/Legacy_And_Test2/preload_diag_note.tnu �[��� PK 1��\�W�4� � ( g� t/Test2/acceptance/try_it_done_testing.tnu �[��� PK 1��\X
�=" " ?� t/Test2/acceptance/try_it_fork.tnu �[��� PK 1��\�t�5 5 # �� t/Test2/acceptance/try_it_no_plan.tnu �[��� PK 1��\
�f* * 9� t/Test2/acceptance/try_it_plan.tnu �[��� PK 1��\dU6�� � �� t/Test2/acceptance/try_it_skip.tnu �[��� PK 1��\iL�C C # һ t/Test2/acceptance/try_it_threads.tnu �[��� PK 1��\ �&� � h� t/Test2/acceptance/try_it_todo.tnu �[��� PK 1��\߇5O� � [� t/Test2/behavior/Formatter.tnu �[��� PK 1��\K��x
x
+ 4� t/Test2/behavior/Subtest_buffer_formatter.tnu �[��� PK 1��\]3� � # � t/Test2/behavior/Subtest_callback.tnu �[��� PK 1��\�R2�� � ! �� t/Test2/behavior/Subtest_events.tnu �[��� PK 1��\l�39c c �� t/Test2/behavior/Subtest_plan.tnu �[��� PK 1��\��t�� � �� t/Test2/behavior/Subtest_todo.tnu �[��� PK 1��\�$�d d �� t/Test2/behavior/Taint.tnu �[��� PK 1��\��]�� � ?� t/Test2/behavior/disable_ipc_a.tnu �[��� PK 1��\G<��� � Z� t/Test2/behavior/disable_ipc_b.tnu �[��� PK 1��\�Ң� �� t/Test2/behavior/disable_ipc_c.tnu �[��� PK 1��\~��u� � �� t/Test2/behavior/disable_ipc_d.tnu �[��� PK 1��\��� � �� t/Test2/behavior/err_var.tnu �[��� PK 1��\�T�M M �� t/Test2/behavior/init_croak.tnu �[��� PK 1��\�R�] ] �� t/Test2/behavior/intercept.tnu �[��� PK 1��\����/ / # -� t/Test2/behavior/ipc_wait_timeout.tnu �[��� PK 1��\!
[ [ + �� t/Test2/behavior/nested_context_exception.tnu �[��� PK 1��\�y�� e t/Test2/behavior/no_load_api.tnu �[��� PK 1��\bf�� � & � t/Test2/behavior/run_subtest_inherit.tnu �[��� PK 1��\ʡ��" " � t/Test2/behavior/special_names.tnu �[��� PK 1��\cRC�� � " l t/Test2/behavior/subtest_bailout.tnu �[��� PK 1��\�KlV� � " \ t/Test2/behavior/trace_signature.tnu �[��� PK 1��\�;}wV
V
�! t/Test2/behavior/uuid.tnu �[��� PK 1��\ �� � ./ t/Test2/legacy/TAP.tnu �[��� PK 1��\� ���
�
9 t/Test2/modules/API/Breakage.tnu �[��� PK 1��\<��V1 V1 �C t/Test2/modules/API/Context.tnu �[��� PK 1��\3K+�`9 `9 �u t/Test2/modules/API/Instance.tnu �[��� PK 1��\ܻ��A A E� t/Test2/modules/API/Stack.tnu �[��� PK 1��\Y��q q # Ѷ t/Test2/modules/Event/TAP/Version.tnu �[��� PK 1��\�B�� � �� t/Test2/modules/Event/Bail.tnu �[��� PK 1��\��e~3 3 �� t/Test2/modules/Event/Diag.tnu �[��� PK 1��\��t� � � t/Test2/modules/Event/Encoding.tnu �[��� PK 1��\4k��� � ! �� t/Test2/modules/Event/Exception.tnu �[��� PK 1��\k��� � � t/Test2/modules/Event/Fail.tnu �[��� PK 1��\N��U� � � t/Test2/modules/Event/Generic.tnu �[��� PK 1��\�J4�� � ;� t/Test2/modules/Event/Note.tnu �[��� PK 1��\iT��] ] y� t/Test2/modules/Event/Ok.tnu �[��� PK 1��\$�)�� � � t/Test2/modules/Event/Pass.tnu �[��� PK 1��\��
hV V %� t/Test2/modules/Event/Plan.tnu �[��� PK 1��\���;� � � t/Test2/modules/Event/Skip.tnu �[��� PK 1��\��SH� � � t/Test2/modules/Event/Subtest.tnu �[��� PK 1��\Upg+
� t/Test2/modules/Event/V2.tnu �[��� PK 1��\y_�Kv v $ t/Test2/modules/Event/Waiting.tnu �[��� PK 1��\�qM2 " �& t/Test2/modules/EventFacet/About.tnu �[��� PK 1��\�ѷ� $ 6) t/Test2/modules/EventFacet/Amnesty.tnu �[��� PK 1��\���5 # �+ t/Test2/modules/EventFacet/Assert.tnu �[��� PK 1��\Ӫ :� � $ �- t/Test2/modules/EventFacet/Control.tnu �[��� PK 1��\i�y� � " 1 t/Test2/modules/EventFacet/Error.tnu �[��� PK 1��\���� � ! O3 t/Test2/modules/EventFacet/Info.tnu �[��� PK 1��\
q�c� � ! �5 t/Test2/modules/EventFacet/Meta.tnu �[��� PK 1��\X_��N N # p8 t/Test2/modules/EventFacet/Parent.tnu �[��� PK 1��\�A�W) ) ! ; t/Test2/modules/EventFacet/Plan.tnu �[��� PK 1��\��
�� � " �= t/Test2/modules/EventFacet/Trace.tnu �[��� PK 1��\�fX��x �x �B t/Test2/modules/Formatter/TAP.tnu �[��� PK 1��\r�� � , � t/Test2/modules/Hub/Interceptor/Terminator.tnu �[��� PK 1��\/�~ ~ ! � t/Test2/modules/Hub/Interceptor.tnu �[��� PK 1��\Øu�
�� t/Test2/modules/Hub/Subtest.tnu �[��� PK 1��\��m<�B �B " � t/Test2/modules/IPC/Driver/Files.tnu �[��� PK 1��\��� � t/Test2/modules/IPC/Driver.tnu �[��� PK 1��\�h8� � t/Test2/modules/Tools/Tiny.tnu �[��� PK 1��\a < < # �% t/Test2/modules/Util/ExternalMeta.tnu �[��� PK 1��\q-�6r r $ A- t/Test2/modules/Util/Facets2Legacy.tnu �[��� PK 1��\c�&S� � ? t/Test2/modules/Util/Trace.tnu �[��� PK 1��\Ԋ���" �" �C t/Test2/modules/API.tnu �[��� PK 1��\���>T >T �f t/Test2/modules/Event.tnu �[��� PK 1��\���% % P� t/Test2/modules/EventFacet.tnu �[��� PK 1��\<�2��. �. �� t/Test2/modules/Hub.tnu �[��� PK 1��\�- Ѧ � �� t/Test2/modules/IPC.tnu �[��� PK 1��\J��� � �� t/Test2/modules/Util.tnu �[��� PK 1��\�!�.b b % � t/Test2/regression/693_ipc_ordering.tnu �[��� PK 1��\s� ( ( ( 6� t/Test2/regression/746-forking-subtest.tnu �[��� PK 1��\]��� � �� t/Test2/regression/gh_16.tnu �[��� PK 1��\IJ�'� � ) � t/Test2/regression/ipc_files_abort_exit.tnu �[��� PK 1��\���aW W � t/lib/Dev/Null.pmnu �[��� PK 1��\6$��� � ^ t/lib/Test/Builder/NoOutput.pmnu �[��� PK 1��\� 7� � ( { t/lib/Test/Simple/sample_tests/death.plxnu �[��� PK 1��\�yy� 0 � t/lib/Test/Simple/sample_tests/death_in_eval.plxnu �[��� PK 1��\T�;�X X 5 H t/lib/Test/Simple/sample_tests/death_with_handler.plxnu �[��� PK 1��\��K� ' t/lib/Test/Simple/sample_tests/exit.plxnu �[��� PK 1��\��3�� � ) | t/lib/Test/Simple/sample_tests/extras.plxnu �[��� PK 1��\�ǭ�� � , � t/lib/Test/Simple/sample_tests/five_fail.plxnu �[��� PK 1��\�< 4 � t/lib/Test/Simple/sample_tests/last_minute_death.plxnu �[��� PK 1��\+Ρ � � 7 , t/lib/Test/Simple/sample_tests/missing_done_testing.plxnu �[��� PK 1��\GCI� � + + t/lib/Test/Simple/sample_tests/one_fail.plxnu �[��� PK 1��\N� �� � 8 F! t/lib/Test/Simple/sample_tests/one_fail_without_plan.plxnu �[��� PK 1��\�)�! ! 1 F" t/lib/Test/Simple/sample_tests/pre_plan_death.plxnu �[��� PK 1��\Ё� * �# t/lib/Test/Simple/sample_tests/require.plxnu �[��� PK 1��\T��� � * 8$ t/lib/Test/Simple/sample_tests/success.plxnu �[��� PK 1��\�ڼ3� � * q% t/lib/Test/Simple/sample_tests/too_few.plxnu �[��� PK 1��\G�s�� � / v& t/lib/Test/Simple/sample_tests/too_few_fail.plxnu �[��� PK 1��\q6 � � + �' t/lib/Test/Simple/sample_tests/two_fail.plxnu �[��� PK 1��\P��� � �( t/lib/Test/Simple/Catch.pmnu �[��� PK 1��\D&C 7 7 �* t/lib/Dummy.pmnu �[��� PK 1��\�WhC_ _ 1+ t/lib/MyOverload.pmnu �[��� PK 1��\
� l �- t/lib/MyTest.pmnu �[��� PK 1��\{��W� � �. t/lib/NoExporter.pmnu �[��� PK 1��\a�gO O j/ t/lib/SigDie.pmnu �[��� PK 1��\ 8�G G �/ t/lib/SkipAll.pmnu �[��� PK 1��\��rP P 0 t/lib/SmallTest.pmnu �[��� PK 1��\˼]Zt t 2 t/lib/TieOut.pmnu �[��� PK 1��\�J⨽ � ! �3 t/regression/642_persistent_end.tnu �[��� PK 1��\�$S�4 4 �5 t/regression/662-tbt-no-plan.tnu �[��� PK 1��\�� ^ # T8 t/regression/684-nested_todo_diag.tnu �[��� PK 1��\�[Α � * �: t/regression/694_note_diag_return_values.tnu �[��� PK 1��\˰ok� � % �< t/regression/696-intercept_skip_all.tnu �[��� PK 1��\��nό � * �@ t/regression/721-nested-streamed-subtest.tnu �[��� PK 1��\��J�! ! # �L t/regression/757-reset_in_subtest.tnu �[��� PK 1��\�&��p p - 6N t/regression/buffered_subtest_plan_buffered.tnu �[��� PK 1��\���~j j $ Q t/regression/builder_does_not_init.tnu �[��� PK 1��\�z A� � �R t/regression/errors_facet.tnu �[��� PK 1��\���$ $ �V t/regression/inherit_trace.tnu �[��� PK 1��\2�z�� � ! UY t/regression/no_name_in_subtest.tnu �[��� PK 1��\4 ��� � -Z t/regression/todo_and_facets.tnu �[��� PK 1��\τ.�� �
^ t/00-report.tnu �[��� PK 1��\�l^ ^
d t/00compile.tnu �[��� PK 1��\�[K�� � �h t/HashBase.tnu �[��� PK 1��\��L� � �~ t/zzz-check-breaks.tnu �[��� PK 1��\�jc��8 �8 �� Changesnu �[��� PK 1��\��d� � п READMEnu �[��� PK �] ��