diff options
Diffstat (limited to 'cpan/Test-Simple/t')
19 files changed, 191 insertions, 8 deletions
diff --git a/cpan/Test-Simple/t/HashBase.t b/cpan/Test-Simple/t/HashBase.t index aa4d4358a8..397c69759f 100644 --- a/cpan/Test-Simple/t/HashBase.t +++ b/cpan/Test-Simple/t/HashBase.t @@ -83,7 +83,10 @@ is($pkg->do_it, 'const', "worked as expected"); *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__; diff --git a/cpan/Test-Simple/t/Legacy/Regression/736_use_ok.t b/cpan/Test-Simple/t/Legacy/Regression/736_use_ok.t index f9a64ee256..c94f7d4fcb 100644 --- a/cpan/Test-Simple/t/Legacy/Regression/736_use_ok.t +++ b/cpan/Test-Simple/t/Legacy/Regression/736_use_ok.t @@ -18,13 +18,19 @@ sub capture(&) { return $warn || ""; } +{ +local $TODO = "known to fail on $]" if $] le "5.006002"; my $file = __FILE__; -my $line = __LINE__ + 2; +my $line = __LINE__ + 4; like( - capture { use_ok 'MyWarner' }, + 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"); diff --git a/cpan/Test-Simple/t/Legacy/Regression/789-read-only.t b/cpan/Test-Simple/t/Legacy/Regression/789-read-only.t new file mode 100644 index 0000000000..120e3f9cf3 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Regression/789-read-only.t @@ -0,0 +1,37 @@ +use Test::More; +use strict; +use warnings; + +# 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; diff --git a/cpan/Test-Simple/t/Legacy/harness_active.t b/cpan/Test-Simple/t/Legacy/harness_active.t index 7b027a7b40..4e0c558710 100644 --- a/cpan/Test-Simple/t/Legacy/harness_active.t +++ b/cpan/Test-Simple/t/Legacy/harness_active.t @@ -47,6 +47,7 @@ Test::More->builder->no_ending(1); { local $ENV{HARNESS_ACTIVE} = 0; + local $ENV{HARNESS_IS_VERBOSE} = 0; #line 62 fail( "this fails" ); @@ -66,6 +67,7 @@ ERR { local $ENV{HARNESS_ACTIVE} = 1; + local $ENV{HARNESS_IS_VERBOSE} = 0; #line 71 fail( "this fails" ); diff --git a/cpan/Test-Simple/t/Legacy/overload_threads.t b/cpan/Test-Simple/t/Legacy/overload_threads.t index 56bdaec5bc..fbc067aea1 100644 --- a/cpan/Test-Simple/t/Legacy/overload_threads.t +++ b/cpan/Test-Simple/t/Legacy/overload_threads.t @@ -18,7 +18,11 @@ BEGIN { eval { require threads; 'threads'->import; 1; } if CAN_THREAD; } -use Test::More tests => 5; +use Test::More; + +plan skip_all => "known to crash on $]" if $] le "5.006002"; + +plan tests => 5; package Overloaded; diff --git a/cpan/Test-Simple/t/Legacy/utf8.t b/cpan/Test-Simple/t/Legacy/utf8.t index 97e4cf4c4a..6e629d4335 100644 --- a/cpan/Test-Simple/t/Legacy/utf8.t +++ b/cpan/Test-Simple/t/Legacy/utf8.t @@ -17,6 +17,7 @@ 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; @@ -30,7 +31,7 @@ unless (Test::Builder->new->{Stack}->top->format->isa('Test::Builder::Formatter' } if( !$have_perlio ) { - plan skip_all => "Don't have PerlIO"; + plan skip_all => "Don't have PerlIO 1.02"; } else { plan tests => 5; diff --git a/cpan/Test-Simple/t/Legacy_And_Test2/preload_diag_note.t b/cpan/Test-Simple/t/Legacy_And_Test2/preload_diag_note.t index b557230fdb..b5cf68be71 100644 --- a/cpan/Test-Simple/t/Legacy_And_Test2/preload_diag_note.t +++ b/cpan/Test-Simple/t/Legacy_And_Test2/preload_diag_note.t @@ -1,6 +1,11 @@ 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(); diff --git a/cpan/Test-Simple/t/Test2/behavior/init_croak.t b/cpan/Test-Simple/t/Test2/behavior/init_croak.t index dc49283193..bebf410b82 100644 --- a/cpan/Test-Simple/t/Test2/behavior/init_croak.t +++ b/cpan/Test-Simple/t/Test2/behavior/init_croak.t @@ -14,6 +14,8 @@ BEGIN { } } +skip_all("known to fail on $]") if $] le "5.006002"; + $@ = ""; my ($file, $line) = (__FILE__, __LINE__ + 1); eval { my $one = Foo::Bar->new }; diff --git a/cpan/Test-Simple/t/Test2/behavior/nested_context_exception.t b/cpan/Test-Simple/t/Test2/behavior/nested_context_exception.t index 55db247f4a..0c79c8a854 100644 --- a/cpan/Test-Simple/t/Test2/behavior/nested_context_exception.t +++ b/cpan/Test-Simple/t/Test2/behavior/nested_context_exception.t @@ -5,6 +5,8 @@ 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(); diff --git a/cpan/Test-Simple/t/Test2/modules/API.t b/cpan/Test-Simple/t/Test2/modules/API.t index 27790aa0ba..b709909720 100644 --- a/cpan/Test-Simple/t/Test2/modules/API.t +++ b/cpan/Test-Simple/t/Test2/modules/API.t @@ -102,11 +102,18 @@ is_deeply([$CLASS->can('test2_ipc_drivers')->()], [qw/Test2::IPC::Driver::Files/ 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"); diff --git a/cpan/Test-Simple/t/Test2/modules/API/Instance.t b/cpan/Test-Simple/t/Test2/modules/API/Instance.t index 124ae6e3a4..18b78e7af6 100644 --- a/cpan/Test-Simple/t/Test2/modules/API/Instance.t +++ b/cpan/Test-Simple/t/Test2/modules/API/Instance.t @@ -258,7 +258,8 @@ if (CAN_THREAD && $] ge '5.010') { 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 = ""; { @@ -286,7 +287,8 @@ 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; diff --git a/cpan/Test-Simple/t/Test2/modules/Event/Exception.t b/cpan/Test-Simple/t/Test2/modules/Event/Exception.t index 78c175878a..4d58aad7d7 100644 --- a/cpan/Test-Simple/t/Test2/modules/Event/Exception.t +++ b/cpan/Test-Simple/t/Test2/modules/Event/Exception.t @@ -27,4 +27,29 @@ is_deeply( "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; diff --git a/cpan/Test-Simple/t/Test2/modules/Formatter/TAP.t b/cpan/Test-Simple/t/Test2/modules/Formatter/TAP.t index 69641520fe..6f31c888ae 100644 --- a/cpan/Test-Simple/t/Test2/modules/Formatter/TAP.t +++ b/cpan/Test-Simple/t/Test2/modules/Formatter/TAP.t @@ -20,7 +20,16 @@ BEGIN { use Test2::Tools::Tiny; use Test2::API qw/context/; -use PerlIO; + +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); diff --git a/cpan/Test-Simple/t/Test2/modules/IPC/Driver.t b/cpan/Test-Simple/t/Test2/modules/IPC/Driver.t index cbdca09b77..0f013286bc 100644 --- a/cpan/Test-Simple/t/Test2/modules/IPC/Driver.t +++ b/cpan/Test-Simple/t/Test2/modules/IPC/Driver.t @@ -25,6 +25,8 @@ for my $meth (qw/send cull add_hub drop_hub waiting is_viable/) { ); } +SKIP: { + last SKIP if $] lt "5.008"; tests abort => sub { my $one = Test2::IPC::Driver->new(no_fatal => 1); my ($err, $out) = ("", ""); @@ -53,5 +55,6 @@ tests abort => sub { is($out, "not ok - IPC Fatal Error\n", "got 'not ok' on stdout"); like($err, qr/IPC Fatal Error: foo/, "Got error"); }; +} done_testing; diff --git a/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t b/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t index a29023aa78..9ca1f5c84e 100644 --- a/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t +++ b/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t @@ -6,6 +6,11 @@ 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; diff --git a/cpan/Test-Simple/t/Test2/modules/Util.t b/cpan/Test-Simple/t/Test2/modules/Util.t index f47f3f30e4..4299b7e6b3 100644 --- a/cpan/Test-Simple/t/Test2/modules/Util.t +++ b/cpan/Test-Simple/t/Test2/modules/Util.t @@ -18,6 +18,8 @@ use Test2::Util qw/ CAN_SIGSYS IS_WIN32 + + clone_io /; { @@ -58,4 +60,18 @@ 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 $out = ''; +open(my $fh, '>', \$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"); + + done_testing; diff --git a/cpan/Test-Simple/t/Test2/regression/gh_16.t b/cpan/Test-Simple/t/Test2/regression/gh_16.t index 45e4cd7b76..a2d46f2d04 100644 --- a/cpan/Test-Simple/t/Test2/regression/gh_16.t +++ b/cpan/Test-Simple/t/Test2/regression/gh_16.t @@ -10,7 +10,7 @@ END { $? = 0 } BEGIN { print "\n1..1\n"; close(STDERR); - open(STDERR, '>&', STDOUT); + open(STDERR, '>&STDOUT'); } use Test2::API; diff --git a/cpan/Test-Simple/t/Test2/regression/ipc_files_abort_exit.t b/cpan/Test-Simple/t/Test2/regression/ipc_files_abort_exit.t index a2964fd402..772d12acbc 100644 --- a/cpan/Test-Simple/t/Test2/regression/ipc_files_abort_exit.t +++ b/cpan/Test-Simple/t/Test2/regression/ipc_files_abort_exit.t @@ -7,6 +7,7 @@ use Test2::Util qw/CAN_FORK/; BEGIN { skip_all "System cannot fork" unless CAN_FORK; + skip_all "known to fail on $]" if $] le "5.006002"; } plan(3); diff --git a/cpan/Test-Simple/t/regression/errors_facet.t b/cpan/Test-Simple/t/regression/errors_facet.t new file mode 100644 index 0000000000..c4e30f995c --- /dev/null +++ b/cpan/Test-Simple/t/regression/errors_facet.t @@ -0,0 +1,53 @@ +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; |