From: Chad Granum Date: Mon, 30 May 2016 12:56:31 +0000 (-0700) Subject: Update Test-Simple in blead X-Git-Tag: v5.25.2~112 X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/58818a660dce0bbd7c77e5be9d0b7c86d30979af Update Test-Simple in blead This updates to the latest Test-Simple. This fixes several small bugs including noisy STDERR in the test suite, and leaking TEMP files. --- diff --git a/MANIFEST b/MANIFEST index aa157f8..c3e902a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2656,6 +2656,7 @@ cpan/Test-Simple/t/lib/Test/Simple/sample_tests/too_few.plx cpan/Test-Simple/t/lib/Test/Simple/sample_tests/two_fail.plx cpan/Test-Simple/t/lib/TieOut.pm cpan/Test-Simple/t/regression/642_persistent_end.t +cpan/Test-Simple/t/regression/662-tbt-no-plan.t cpan/Test-Simple/t/regression/no_name_in_subtest.t cpan/Test-Simple/t/Test2/acceptance/try_it_done_testing.t cpan/Test-Simple/t/Test2/acceptance/try_it_fork.t diff --git a/cpan/Test-Simple/lib/Test/Builder.pm b/cpan/Test-Simple/lib/Test/Builder.pm index 892d609..7d51754 100644 --- a/cpan/Test-Simple/lib/Test/Builder.pm +++ b/cpan/Test-Simple/lib/Test/Builder.pm @@ -4,7 +4,7 @@ use 5.006; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; BEGIN { if( $] < 5.008 ) { @@ -12,8 +12,6 @@ BEGIN { } } -use overload(); - use Scalar::Util qw/blessed reftype weaken/; use Test2::Util qw/USE_THREADS try get_tid/; @@ -40,16 +38,7 @@ use Test::Builder::Formatter; use Test::Builder::TodoDiag; our $Level = 1; -our $Test = Test::Builder->new; - -# Non-TB tools normally expect 0 added to the level. $Level is normally 1. So -# we only want the level to change if $Level != 1. -# TB->ctx compensates for this later. -Test2::API::test2_add_callback_context_aquire(sub {$_[0]->{level} += $Level - 1}); - -Test2::API::test2_add_callback_exit(sub { $Test->_ending(@_) }); - -Test2::API::test2_ipc()->set_no_fatal(1) if USE_THREADS; +our $Test = $ENV{TB_NO_EARLY_INIT} ? undef : Test::Builder->new; sub _add_ts_hooks { my $self = shift; @@ -102,6 +91,15 @@ sub new { my $ctx = context(); $Test = $class->create(singleton => 1); $ctx->release; + + # Non-TB tools normally expect 0 added to the level. $Level is normally 1. So + # we only want the level to change if $Level != 1. + # TB->ctx compensates for this later. + Test2::API::test2_add_callback_context_aquire(sub { $_[0]->{level} += $Level - 1 }); + + Test2::API::test2_add_callback_exit(sub { $Test->_ending(@_) }); + + Test2::API::test2_ipc()->set_no_fatal(1) if USE_THREADS; } return $Test; } @@ -304,7 +302,7 @@ sub subtest { ($err, $child_error) = ($@, $?); # They might have done 'BEGIN { skip_all => "whatever" }' - if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/) { + if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && blessed($err) eq 'Test::Builder::Exception')) { $ok = undef; $err = undef; } @@ -486,6 +484,12 @@ sub no_plan { my $ctx = $self->ctx; + if (defined $ctx->hub->plan) { + warn "Plan already set, no_plan() is a no-op, this will change to a hard failure in the future."; + $ctx->release; + return; + } + $ctx->alert("no_plan takes no arguments") if $arg; $ctx->hub->plan('NO PLAN'); @@ -685,6 +689,10 @@ sub _unoverload { return unless ref $$thing; return unless blessed($$thing) || scalar $self->_try(sub{ $$thing->isa('UNIVERSAL') }); + { + local ($!, $@); + require overload; + } my $string_meth = overload::Method( $$thing, $type ) || return; $$thing = $$thing->$string_meth(); } @@ -1731,9 +1739,9 @@ Ok, so there can be more than one Test::Builder object and this is how you get it. You might use this instead of C if you're testing a Test::Builder based module, but otherwise you probably want C. -B: the implementation is not complete. C, for example, is -still shared amongst B Test::Builder objects, even ones created using -this method. Also, the method name may change in the future. +B: the implementation is not complete. C, for example, is still +shared by B Test::Builder objects, even ones created using this method. +Also, the method name may change in the future. =item B @@ -1780,19 +1788,6 @@ will print the appropriate headers and take the appropriate actions. If you call C, don't call any of the other methods below. -If a child calls "skip_all" in the plan, a C is -thrown. Trap this error, call C and don't run any more tests on -the child. - - my $child = $Test->child('some child'); - eval { $child->plan( $condition ? ( skip_all => $reason ) : ( tests => 3 ) ) }; - if ( eval { $@->isa('Test::Builder::Exception') } ) { - $child->finalize; - return; - } - # run your tests - - =item B my $max = $Test->expected_tests; @@ -2020,7 +2015,7 @@ Takes a quoted regular expression produced by C, or a string representing a regular expression. Returns a Perl value which may be used instead of the corresponding -regular expression, or C if its argument is not recognised. +regular expression, or C if its argument is not recognized. For example, a version of C, sans the useful diagnostic messages, could be written as: @@ -2440,9 +2435,9 @@ If you fail more than 254 tests, it will be reported as 254. =head1 THREADS -In perl 5.8.1 and later, Test::Builder is thread-safe. The test -number is shared amongst all threads. This means if one thread sets -the test number using C they will all be effected. +In perl 5.8.1 and later, Test::Builder is thread-safe. The test number is +shared by all threads. This means if one thread sets the test number using +C they will all be effected. While versions earlier than 5.8.1 had threads they contain too many bugs to support. diff --git a/cpan/Test-Simple/lib/Test/Builder/Formatter.pm b/cpan/Test-Simple/lib/Test/Builder/Formatter.pm index f458f13..3994ac5 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Formatter.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Formatter.pm @@ -2,9 +2,9 @@ package Test::Builder::Formatter; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use base 'Test2::Formatter::TAP'; +BEGIN { require Test2::Formatter::TAP; our @ISA = qw(Test2::Formatter::TAP) } use Test2::Util::HashBase qw/no_header no_diag/; diff --git a/cpan/Test-Simple/lib/Test/Builder/Module.pm b/cpan/Test-Simple/lib/Test/Builder/Module.pm index 8f30974..12cac88 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Module.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Module.pm @@ -2,12 +2,12 @@ package Test::Builder::Module; use strict; -use Test::Builder 1.00; +use Test::Builder; require Exporter; our @ISA = qw(Exporter); -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; =head1 NAME @@ -89,7 +89,8 @@ sub import { $test->plan(@_); - $class->export_to_level( 1, $class, @imports ); + local $Exporter::ExportLevel = $Exporter::ExportLevel + 1; + $class->Exporter::import(@imports); } sub _strip_imports { diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester.pm b/cpan/Test-Simple/lib/Test/Builder/Tester.pm index 3b1f53e..d30acda 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Tester.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Tester.pm @@ -1,9 +1,9 @@ package Test::Builder::Tester; use strict; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use Test::Builder 0.99; +use Test::Builder; use Symbol; use Carp; diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm b/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm index 8913412..9819920 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm @@ -1,7 +1,7 @@ package Test::Builder::Tester::Color; use strict; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; require Test::Builder::Tester; diff --git a/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm b/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm index d22fb33..5a915bb 100644 --- a/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm +++ b/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm @@ -2,9 +2,9 @@ package Test::Builder::TodoDiag; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use base 'Test2::Event::Diag'; +BEGIN { require Test2::Event::Diag; our @ISA = qw(Test2::Event::Diag) } sub diagnostics { 0 } diff --git a/cpan/Test-Simple/lib/Test/More.pm b/cpan/Test-Simple/lib/Test/More.pm index 89814bb..46c00da 100644 --- a/cpan/Test-Simple/lib/Test/More.pm +++ b/cpan/Test-Simple/lib/Test/More.pm @@ -17,9 +17,9 @@ sub _carp { return warn @_, " at $file line $line\n"; } -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use Test::Builder::Module 0.99; +use Test::Builder::Module; our @ISA = qw(Test::Builder::Module); our @EXPORT = qw(ok use_ok require_ok is isnt like unlike is_deeply @@ -175,12 +175,22 @@ sub import_extra { my @other = (); my $idx = 0; + my $import; while( $idx <= $#{$list} ) { my $item = $list->[$idx]; if( defined $item and $item eq 'no_diag' ) { $class->builder->no_diag(1); } + elsif( defined $item and $item eq 'import' ) { + if ($import) { + push @$import, @{$list->[ ++$idx ]}; + } + else { + $import = $list->[ ++$idx ]; + push @other, $item, $import; + } + } else { push @other, $item; } @@ -190,6 +200,18 @@ sub import_extra { @$list = @other; + if ($class eq __PACKAGE__ && (!$import || grep $_ eq '$TODO', @$import)) { + my $to = $class->builder->exported_to; + no strict 'refs'; + *{"$to\::TODO"} = \our $TODO; + if ($import) { + @$import = grep $_ ne '$TODO', @$import; + } + else { + push @$list, import => [grep $_ ne '$TODO', @EXPORT]; + } + } + return; } diff --git a/cpan/Test-Simple/lib/Test/Simple.pm b/cpan/Test-Simple/lib/Test/Simple.pm index f0a685f..f89656b 100644 --- a/cpan/Test-Simple/lib/Test/Simple.pm +++ b/cpan/Test-Simple/lib/Test/Simple.pm @@ -4,9 +4,9 @@ use 5.006; use strict; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use Test::Builder::Module 0.99; +use Test::Builder::Module; our @ISA = qw(Test::Builder::Module); our @EXPORT = qw(ok); diff --git a/cpan/Test-Simple/lib/Test/Tester.pm b/cpan/Test-Simple/lib/Test/Tester.pm index e8785b0..42ff268 100644 --- a/cpan/Test-Simple/lib/Test/Tester.pm +++ b/cpan/Test-Simple/lib/Test/Tester.pm @@ -18,7 +18,7 @@ require Exporter; use vars qw( @ISA @EXPORT ); -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; @EXPORT = qw( run_tests check_tests check_test cmp_results show_space ); @ISA = qw( Exporter ); @@ -40,7 +40,7 @@ sub show_space my $colour = ''; my $reset = ''; -if (my $want_colour = $ENV{TESTTESTERCOLOUR} || $ENV{TESTTESTERCOLOUR}) +if (my $want_colour = $ENV{TESTTESTERCOLOUR} || $ENV{TESTTESTERCOLOR}) { if (eval "require Term::ANSIColor") { @@ -447,7 +447,7 @@ diagnostics output B the test result is declared. Note that Test::Builder ensures that any diagnostics end in a \n and it in earlier versions of Test::Tester it was essential that you have -the final \n in your expected diagnostics. From version 0.10 onwards, +the final \n in your expected diagnostics. From version 0.10 onward, Test::Tester will add the \n if you forgot it. It will not add a \n if you are expecting no diagnostics. See below for help tracking down hard to find space and tab related problems. @@ -496,7 +496,7 @@ are scratching your head trying to work out why Test::Tester is saying that your diagnostics are wrong when they look perfectly right then the answer is probably whitespace. From version 0.10 on, Test::Tester surrounds the expected and got diag values with single quotes to make it easier to spot -trailing whitesapce. So in this example +trailing whitespace. So in this example # Got diag (5 bytes): # 'abcd ' @@ -514,7 +514,7 @@ switch Test::Tester into a mode whereby all "tricky" characters are shown as \{xx}. Tricky characters are those with ASCII code less than 33 or higher than 126. This makes the output more difficult to read but much easier to find subtle differences between strings. To turn on this mode either call -show_space() in your test script or set the TESTTESTERSPACE environment +C in your test script or set the C environment variable to be a true value. The example above would then look like # Got diag (5 bytes): @@ -525,13 +525,13 @@ variable to be a true value. The example above would then look like =head1 COLOUR If you prefer to use colour as a means of finding tricky whitespace -characters then you can set the TESTTESTCOLOUR environment variable to a +characters then you can set the C environment variable to a comma separated pair of colours, the first for the foreground, the second for the background. For example "white,red" will print white text on a red background. This requires the Term::ANSIColor module. You can specify any colour that would be acceptable to the Term::ANSIColor::color function. -If you spell colour differently, that's no problem. The TESTTESTERCOLOR +If you spell colour differently, that's no problem. The C variable also works (if both are set then the British spelling wins out). =head1 EXPORTED FUNCTIONS diff --git a/cpan/Test-Simple/lib/Test/Tester/Capture.pm b/cpan/Test-Simple/lib/Test/Tester/Capture.pm index 0217e98..1cda453 100644 --- a/cpan/Test-Simple/lib/Test/Tester/Capture.pm +++ b/cpan/Test-Simple/lib/Test/Tester/Capture.pm @@ -2,7 +2,7 @@ use strict; package Test::Tester::Capture; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; use Test::Builder; diff --git a/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm b/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm index defd2f1..c6ab9f6 100644 --- a/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm +++ b/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm @@ -3,7 +3,7 @@ use strict; package Test::Tester::CaptureRunner; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; use Test::Tester::Capture; diff --git a/cpan/Test-Simple/lib/Test/Tester/Delegate.pm b/cpan/Test-Simple/lib/Test/Tester/Delegate.pm index 6bcfc54..c5e197f 100644 --- a/cpan/Test-Simple/lib/Test/Tester/Delegate.pm +++ b/cpan/Test-Simple/lib/Test/Tester/Delegate.pm @@ -3,7 +3,7 @@ use warnings; package Test::Tester::Delegate; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; use vars '$AUTOLOAD'; diff --git a/cpan/Test-Simple/lib/Test/use/ok.pm b/cpan/Test-Simple/lib/Test/use/ok.pm index 40b6690..dc7a140 100644 --- a/cpan/Test-Simple/lib/Test/use/ok.pm +++ b/cpan/Test-Simple/lib/Test/use/ok.pm @@ -1,7 +1,7 @@ package Test::use::ok; use 5.005; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; __END__ diff --git a/cpan/Test-Simple/lib/Test2.pm b/cpan/Test-Simple/lib/Test2.pm index ac12b0e..b10886c 100644 --- a/cpan/Test-Simple/lib/Test2.pm +++ b/cpan/Test-Simple/lib/Test2.pm @@ -2,7 +2,7 @@ package Test2; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; 1; @@ -25,7 +25,7 @@ completely refactoring it, adding many new features and capabilities. =head1 GETTING STARTED If you are interested in writing tests using new tools then you should look at -L. L is a seperate cpan distribution that contains +L. L 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 @@ -67,12 +67,12 @@ perls, or when non-essential modules have not been installed. =head2 Test2::Formatter:: Formatters live under this namespace. L is the only -formatter currently. It is acceptible for third party distributions to create +formatter currently. It is acceptable for third party distributions to create new formatters under this namespace. =head2 Test2::Event:: -Events live under this namespace. It is considered acceptible for third party +Events live under this namespace. It is considered acceptable for third party distributions to add new event types in this namespace. =head2 Test2::Hub:: @@ -102,8 +102,8 @@ This is for Test2 API and related packages. =head2 Test2:: -The Test2:: namespace is intended for extentions and frameworks. Tools, -Plugins, etc should not go directly into this namespace. However extentions +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 diff --git a/cpan/Test-Simple/lib/Test2/API.pm b/cpan/Test-Simple/lib/Test2/API.pm index 32cd49a..551c673 100644 --- a/cpan/Test-Simple/lib/Test2/API.pm +++ b/cpan/Test-Simple/lib/Test2/API.pm @@ -2,7 +2,7 @@ package Test2::API; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; my $INST; @@ -99,26 +99,7 @@ our @EXPORT_OK = qw{ test2_formatter_add test2_formatter_set }; -use base 'Exporter'; - -# There is a use-cycle between API and API/Context. Context needs to use some -# API functions as the package is compiling. Test2::API::context() needs -# Test2::API::Context to be loaded, but we cannot 'require' the module there as -# it causes a very noticable performance impact with how often context() is -# called. -# -# This will make sure that Context.pm is loaded the first time this module is -# imported, then the regular import method is swapped into place. -sub import { - require Test2::API::Context unless $INC{'Test2/API/Context.pm'}; - - { - no warnings 'redefine'; - *import = \&Exporter::import; - } - - goto &import; -} +BEGIN { require Exporter; our @ISA = qw(Exporter) } my $STACK = $INST->stack; my $CONTEXTS = $INST->contexts; @@ -293,7 +274,7 @@ sub context { delete $CONTEXTS->{$hid}; } - # Directly bless the object here, calling new is a noticable performance + # Directly bless the object here, calling new is a noticeable performance # hit with how often this needs to be called. my $trace = bless( { @@ -304,7 +285,7 @@ sub context { 'Test2::Util::Trace' ); - # Directly bless the object here, calling new is a noticable performance + # Directly bless the object here, calling new is a noticeable performance # hit with how often this needs to be called. my $aborted = 0; $current = bless( @@ -468,7 +449,7 @@ sub run_subtest { $err = $@; # They might have done 'BEGIN { skip_all => "whatever" }' - if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/) { + if (!$ok && $err =~ m/Label not found for "last T2_SUBTEST_WRAPPER"/ || (blessed($err) && blessed($err) eq 'Test::Builder::Exception')) { $ok = undef; $err = undef; } @@ -519,6 +500,13 @@ sub run_subtest { return $pass; } +# There is a use-cycle between API and API/Context. Context needs to use some +# API functions as the package is compiling. Test2::API::context() needs +# Test2::API::Context to be loaded, but we cannot 'require' the module there as +# it causes a very noticeable performance impact with how often context() is +# called. +require Test2::API::Context; + 1; __END__ @@ -534,7 +522,7 @@ Test2::API - Primary interface for writing Test2 based testing tools. =head1 ***INTERNALS NOTE*** B The public -methods provided will not change in backwords incompatible ways (once there is +methods provided will not change in backwards-incompatible ways (once there is a stable release), but the underlying implementation details might. B @@ -558,7 +546,7 @@ tools. Using these building blocks you can begin writing test tools very quickly. You are also provided with tools that help you to test the tools you write. -=head1 SYNOPSYS +=head1 SYNOPSIS =head2 WRITING A TOOL @@ -579,7 +567,7 @@ The C method is your primary interface into the Test2 framework. return $bool; } -See L for a list of methods avabilable on the context object. +See L for a list of methods available on the context object. =head2 TESTING YOUR TOOLS @@ -673,7 +661,7 @@ All parameters to C are optional. =item level => $int -If you must obtain a context in a sub deper than your entry point you can use +If you must obtain a context in a sub deeper than your entry point you can use this to tell it how many EXTRA stack frames to look back. If this option is not provided the default of C<0> is used. @@ -919,7 +907,7 @@ The code to run inside the subtest. =item $BUFFERED or \%PARAMS If this is a simple scalar then it will be treated as a boolean for the -'buffered' setting. If this is a hash reference then it wil be used as a +'buffered' setting. If this is a hash reference then it will be used as a parameters hash. The param hash will be used for hub construction (with the 'buffered' key removed). @@ -935,7 +923,7 @@ Any extra arguments you want passed into the subtest code. =head3 BUFFERED VS UNBUFFERED (OR STREAMED) Normally all events inside and outside a subtest are sent to the formatter -immedietly by the hub. Sometimes it is desirable to hold off sending events +immediately by the hub. Sometimes it is desirable to hold off sending events within a subtest until the subtest is complete. This usually depends on the formatter being used. @@ -966,7 +954,7 @@ C attribute. A formatter can specify by implementing the C method. If this method returns true then events generated inside a buffered subtest will not be -sent independantly of the final subtest event. +sent independently of the final subtest event. =back @@ -983,7 +971,7 @@ parallel, without it the subtests would be garbled. Exports in this section are not commonly needed. These all have the 'test2_' prefix to help ensure they stand out. You should look at the L section before looking here. This section is one where "Great power -comes with great responsiblity". It is possible to break things badly if you +comes with great responsibility". It is possible to break things badly if you are not careful with these. All exports are optional, you need to list which ones you want at import time: @@ -998,9 +986,9 @@ These provide access to internal state and object instances. =item $bool = test2_init_done() -This will return true if the stack and ipc instances have already been +This will return true if the stack and IPC instances have already been initialized. It will return false if they have not. Init happens as late as -possible, it happens as soon as a tool requests the ipc instance, the +possible, it happens as soon as a tool requests the IPC instance, the formatter, or the stack. =item $bool = test2_load_done() @@ -1071,7 +1059,7 @@ from C<$exit> Add a callback that will be called when Test2 is finished loading. This means the callback will be run once, the first time a context is obtained. -If Test2 has already finished loading then the callback will be run immedietly. +If Test2 has already finished loading then the callback will be run immediately. =item test2_add_callback_context_acquire(sub { ... }) @@ -1158,7 +1146,7 @@ Turn off IPC polling. =item test2_ipc_enable_shm() -Turn on IPC shm. Only some IPC drivers use this, and most will turn it on +Turn on IPC SHM. Only some IPC drivers use this, and most will turn it on themselves. =item test2_ipc_set_pending($uniq_val) diff --git a/cpan/Test-Simple/lib/Test2/API/Breakage.pm b/cpan/Test-Simple/lib/Test2/API/Breakage.pm index c0cbc24..88499dc 100644 --- a/cpan/Test-Simple/lib/Test2/API/Breakage.pm +++ b/cpan/Test-Simple/lib/Test2/API/Breakage.pm @@ -2,7 +2,7 @@ package Test2::API::Breakage; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; use Test2::Util qw/pkg_to_file/; @@ -12,7 +12,7 @@ our @EXPORT_OK = qw{ upgrade_required known_broken }; -use base 'Exporter'; +BEGIN { require Exporter; our @ISA = qw(Exporter) } sub upgrade_suggested { return ( @@ -139,6 +139,8 @@ version number. If the installed version of the module is at or below the specified one then the module will not work. A newer version may work, but is not tested or verified. +=back + =head1 SOURCE The source code repository for Test2 can be found at diff --git a/cpan/Test-Simple/lib/Test2/API/Context.pm b/cpan/Test-Simple/lib/Test2/API/Context.pm index 80f57b6..0724ce2 100644 --- a/cpan/Test-Simple/lib/Test2/API/Context.pm +++ b/cpan/Test-Simple/lib/Test2/API/Context.pm @@ -2,7 +2,7 @@ package Test2::API::Context; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; use Carp qw/confess croak longmess/; @@ -484,8 +484,8 @@ the current hub. =item $hub = $ctx->hub() -This will return the L instance the context recognises as -the current one to which all events should be sent. +This will return the L instance the context recognizes as the +current one to which all events should be sent. =item $dbg = $ctx->trace() @@ -508,7 +508,7 @@ will be affected. }); B The context will actually be cloned, the clone will be used instead of -the original. This allows the TID, PID, and error vars to be correct without +the original. This allows the thread id, process id, and error variables to be correct without modifying the original context. =item $ctx->restore_error_vars() @@ -676,7 +676,7 @@ new one is generated, or if an existing one is returned. This object consumes L which provides a consistent way for you to attach meta-data to instances of this class. This is useful for -tools, plugins, and other extentions. +tools, plugins, and other extensions. =head1 SOURCE diff --git a/cpan/Test-Simple/lib/Test2/API/Instance.pm b/cpan/Test-Simple/lib/Test2/API/Instance.pm index f73e399..e97e4a2 100644 --- a/cpan/Test-Simple/lib/Test2/API/Instance.pm +++ b/cpan/Test-Simple/lib/Test2/API/Instance.pm @@ -2,7 +2,7 @@ package Test2::API::Instance; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; our @CARP_NOT = qw/Test2::API Test2::API::Instance Test2::IPC::Driver Test2::Formatter/; @@ -15,7 +15,7 @@ use Test2::Util::Trace(); use Test2::API::Stack(); use Test2::Util::HashBase qw{ - pid tid + _pid _tid no_wait finalized loaded ipc stack formatter @@ -35,6 +35,9 @@ use Test2::Util::HashBase qw{ context_release_callbacks }; +sub pid { $_[0]->{+_PID} ||= $$ } +sub tid { $_[0]->{+_TID} ||= get_tid() } + # Wrap around the getters that should call _finalize. BEGIN { for my $finalizer (IPC, FORMATTER) { @@ -63,8 +66,9 @@ sub init { $_[0]->reset } sub reset { my $self = shift; - $self->{+PID} = $$; - $self->{+TID} = get_tid(); + delete $self->{+_PID}; + delete $self->{+_TID}; + $self->{+CONTEXTS} = {}; $self->{+IPC_DRIVERS} = []; @@ -95,6 +99,9 @@ sub _finalize { $self->{+FINALIZED} = $caller; + $self->{+_PID} = $$ unless defined $self->{+_PID}; + $self->{+_TID} = get_tid() unless defined $self->{+_TID}; + unless ($self->{+FORMATTER}) { my ($formatter, $source); if ($ENV{T2_FORMATTER}) { @@ -129,7 +136,7 @@ sub _finalize { $self->{+FORMATTER} = $formatter; } - # Turn on IPC if threads are on, drivers are reigstered, or the Test2::IPC + # Turn on IPC if threads are on, drivers are registered, or the Test2::IPC # module is loaded. return unless USE_THREADS || $INC{'Test2/IPC.pm'} || @{$self->{+IPC_DRIVERS}}; @@ -220,6 +227,9 @@ sub add_post_load_callback { sub load { my $self = shift; unless ($self->{+LOADED}) { + $self->{+_PID} = $$ unless defined $self->{+_PID}; + $self->{+_TID} = get_tid() unless defined $self->{+_TID}; + # This is for https://github.com/Test-More/test-more/issues/16 # and https://rt.perl.org/Public/Bug/Display.html?id=127774 # END blocks run in reverse order. This insures the END block is loaded @@ -346,14 +356,16 @@ sub disable_ipc_polling { sub _ipc_wait { my $fail = 0; - while (CAN_FORK) { - my $pid = CORE::wait(); - my $err = $?; - last if $pid == -1; - next unless $err; - $fail++; - $err = $err >> 8; - warn "Process $pid did not exit cleanly (status: $err)\n"; + if (CAN_FORK) { + while (1) { + my $pid = CORE::wait(); + my $err = $?; + last if $pid == -1; + next unless $err; + $fail++; + $err = $err >> 8; + warn "Process $pid did not exit cleanly (status: $err)\n"; + } } if (USE_THREADS) { @@ -377,8 +389,8 @@ sub _ipc_wait { sub DESTROY { my $self = shift; - return unless $self->{+PID} == $$; - return unless $self->{+TID} == get_tid(); + return unless defined($self->{+_PID}) && $self->{+_PID} == $$; + return unless defined($self->{+_TID}) && $self->{+_TID} == get_tid(); shmctl($self->{+IPC_SHM_ID}, IPC::SysV::IPC_RMID(), 0) if defined $self->{+IPC_SHM_ID}; @@ -413,7 +425,7 @@ This is not a supported configuration, you will have problems. # Only worry about contexts in this PID my $trace = $ctx->trace || next; - next unless $trace->pid == $$; + next unless $trace->pid && $trace->pid == $$; # Do not worry about contexts that have no hub my $hub = $ctx->hub || next; @@ -429,7 +441,7 @@ This is not a supported configuration, you will have problems. $new_exit = 255; } - if ($self->{+PID} != $$ or $self->{+TID} != get_tid()) { + if (!defined($self->{+_PID}) or !defined($self->{+_TID}) or $self->{+_PID} != $$ or $self->{+_TID} != get_tid()) { $? = $exit; return; } @@ -547,7 +559,7 @@ Get the post-load callbacks. =item $obj->add_post_load_callback(sub { ... }) Add a post-load callback. If C has already been called then the callback will -be immedietly executed. If C has not been called then the callback will be +be immediately executed. If C has not been called then the callback will be stored and executed later when C is called. =item $hashref = $obj->contexts() diff --git a/cpan/Test-Simple/lib/Test2/API/Stack.pm b/cpan/Test-Simple/lib/Test2/API/Stack.pm index 0bc25ec..d0f1b34 100644 --- a/cpan/Test-Simple/lib/Test2/API/Stack.pm +++ b/cpan/Test-Simple/lib/Test2/API/Stack.pm @@ -2,7 +2,7 @@ package Test2::API::Stack; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; use Test2::Hub(); @@ -110,7 +110,7 @@ instances. =head1 ***INTERNALS NOTE*** B The public -methods provided will not change in backwords incompatible ways, but the +methods provided will not change in backwards incompatible ways, but the underlying implementation details might. B =head1 DESCRIPTION @@ -146,10 +146,10 @@ If you specify the C<< 'class' => $class >> argument, the new hub will be an instance of the specified class. Unless your parameters specify C<'formatter'> or C<'ipc'> arguments, the -formatter and ipc instance will be inherited from the current top hub. You can -set the parameters to C to avoid having a formatter or ipc instance. +formatter and IPC instance will be inherited from the current top hub. You can +set the parameters to C to avoid having a formatter or IPC instance. -If there is no top hub, and you do not ask to leave ipc and formatter undef, +If there is no top hub, and you do not ask to leave IPC and formatter undef, then a new formatter will be created, and the IPC instance from L will be used. diff --git a/cpan/Test-Simple/lib/Test2/Event.pm b/cpan/Test-Simple/lib/Test2/Event.pm index 67e6f77..3d8b2f8 100644 --- a/cpan/Test-Simple/lib/Test2/Event.pm +++ b/cpan/Test-Simple/lib/Test2/Event.pm @@ -2,7 +2,7 @@ package Test2::Event; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; use Test2::Util::HashBase qw/trace nested in_subtest subtest_id/; @@ -109,7 +109,7 @@ thing to want, it is used by bail-out and skip_all to end testing. This is called B your event has been passed to the formatter. This should normally return undef, only change this if your event should cause the -test to exit immedietly. +test to exit immediately. If you want this event to cause the test to exit you should return the exit code here. Exit code of 0 means exit success, any other integer means exit with @@ -172,7 +172,7 @@ If the event is inside a subtest this should have the subtest ID. =item $id = $e->subtest_id -If the event is a final subtes event, this should contain the subtest ID. +If the event is a final subtest event, this should contain the subtest ID. =back @@ -180,7 +180,7 @@ If the event is a final subtes event, this should contain the subtest ID. This object consumes L which provides a consistent way for you to attach meta-data to instances of this class. This is useful for -tools, plugins, and other extentions. +tools, plugins, and other extensions. =head1 SOURCE diff --git a/cpan/Test-Simple/lib/Test2/Event/Bail.pm b/cpan/Test-Simple/lib/Test2/Event/Bail.pm index 875ba0a..6ddba2a 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Bail.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Bail.pm @@ -2,10 +2,10 @@ package Test2::Event::Bail; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use base 'Test2::Event'; +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } use Test2::Util::HashBase qw{reason}; sub callback { diff --git a/cpan/Test-Simple/lib/Test2/Event/Diag.pm b/cpan/Test-Simple/lib/Test2/Event/Diag.pm index af5790c..bdb68c3 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Diag.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Diag.pm @@ -2,10 +2,10 @@ package Test2::Event::Diag; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use base 'Test2::Event'; +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } use Test2::Util::HashBase qw/message/; sub init { diff --git a/cpan/Test-Simple/lib/Test2/Event/Exception.pm b/cpan/Test-Simple/lib/Test2/Event/Exception.pm index 3504a24..43acd25 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Exception.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Exception.pm @@ -2,10 +2,10 @@ package Test2::Event::Exception; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use base 'Test2::Event'; +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } use Test2::Util::HashBase qw{error}; sub causes_fail { 1 } diff --git a/cpan/Test-Simple/lib/Test2/Event/Note.pm b/cpan/Test-Simple/lib/Test2/Event/Note.pm index aea9951..9038a3d 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Note.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Note.pm @@ -2,10 +2,10 @@ package Test2::Event::Note; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use base 'Test2::Event'; +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } use Test2::Util::HashBase qw/message/; sub init { diff --git a/cpan/Test-Simple/lib/Test2/Event/Ok.pm b/cpan/Test-Simple/lib/Test2/Event/Ok.pm index b467f70..edf6d22 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Ok.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Ok.pm @@ -2,10 +2,10 @@ package Test2::Event::Ok; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use base 'Test2::Event'; +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } use Test2::Util::HashBase qw{ pass effective_pass name todo }; diff --git a/cpan/Test-Simple/lib/Test2/Event/Plan.pm b/cpan/Test-Simple/lib/Test2/Event/Plan.pm index 12f5d6b..f3f4398 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Plan.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Plan.pm @@ -2,10 +2,10 @@ package Test2::Event::Plan; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use base 'Test2::Event'; +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } use Test2::Util::HashBase qw{max directive reason}; use Carp qw/confess/; diff --git a/cpan/Test-Simple/lib/Test2/Event/Skip.pm b/cpan/Test-Simple/lib/Test2/Event/Skip.pm index 9f9ae92..1facd66 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Skip.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Skip.pm @@ -2,10 +2,10 @@ package Test2::Event::Skip; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use base 'Test2::Event::Ok'; +BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) } use Test2::Util::HashBase qw{reason}; sub init { diff --git a/cpan/Test-Simple/lib/Test2/Event/Subtest.pm b/cpan/Test-Simple/lib/Test2/Event/Subtest.pm index 1784f05..1497be6 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Subtest.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Subtest.pm @@ -2,10 +2,10 @@ package Test2::Event::Subtest; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use base 'Test2::Event::Ok'; +BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) } use Test2::Util::HashBase qw{subevents buffered subtest_id}; sub init { diff --git a/cpan/Test-Simple/lib/Test2/Event/Waiting.pm b/cpan/Test-Simple/lib/Test2/Event/Waiting.pm index c77891d..bceadc0 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Waiting.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Waiting.pm @@ -2,10 +2,10 @@ package Test2::Event::Waiting; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use base 'Test2::Event'; +BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } sub global { 1 }; diff --git a/cpan/Test-Simple/lib/Test2/Formatter.pm b/cpan/Test-Simple/lib/Test2/Formatter.pm index 0c8a09f..84fd97e 100644 --- a/cpan/Test-Simple/lib/Test2/Formatter.pm +++ b/cpan/Test-Simple/lib/Test2/Formatter.pm @@ -2,7 +2,7 @@ package Test2::Formatter; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; my %ADDED; @@ -53,8 +53,8 @@ A formatter is any package or object with a C method. The C method is a method, so it either gets a class or instance. The 2 arguments are the C<$event> object it should record, and the C<$assert_num> which is the number of the current assertion (ok), or the last assertion if -this even is not itself an assertion. The assertion number may be any inyeger 0 -or greator, and may be undefined in some cases. +this even is not itself an assertion. The assertion number may be any integer 0 +or greater, and may be undefined in some cases. The C method must return a boolean. This is used to tell buffered subtests whether or not to send it events as they are being buffered. diff --git a/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm b/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm index 3020b8c..a17a6d9 100644 --- a/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm +++ b/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm @@ -2,7 +2,7 @@ package Test2::Formatter::TAP; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; use Test2::Util::HashBase qw{ @@ -14,7 +14,7 @@ sub OUT_ERR() { 1 } use Carp qw/croak/; -use base 'Test2::Formatter'; +BEGIN { require Test2::Formatter; our @ISA = qw(Test2::Formatter) } my %CONVERTERS = ( 'Test2::Event::Ok' => 'event_ok', @@ -234,7 +234,7 @@ sub event_subtest { # In a verbose harness we indent the diagnostics from the 'Ok' event since # they will appear inside the subtest braces. This helps readability. In a - # non-verbose harness we do nto do this because it is less readable. + # non-verbose harness we do not do this because it is less readable. if ($ENV{HARNESS_IS_VERBOSE}) { # index 0 is the filehandle, index 1 is the message we want to indent. $_->[1] =~ s/^(.*\S.*)$/ $1/mg for @diag; @@ -461,7 +461,7 @@ Process an L event. =item @out = $TAP->event_other($e, $num) -Fallback for unregistered event types. It uses the L api to +Fallback for unregistered event types. It uses the L API to convert the event to TAP. =back diff --git a/cpan/Test-Simple/lib/Test2/Hub.pm b/cpan/Test-Simple/lib/Test2/Hub.pm index 1d49977..2a7dcc6 100644 --- a/cpan/Test-Simple/lib/Test2/Hub.pm +++ b/cpan/Test-Simple/lib/Test2/Hub.pm @@ -2,7 +2,7 @@ package Test2::Hub; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; use Carp qw/carp croak confess/; @@ -458,7 +458,7 @@ Test2::Hub - The conduit through which all events flow. =head1 DESCRIPTION The hub is the place where all events get processed and handed off to the -formatter. The hub also tracks test state, and provides everal hooks into the +formatter. The hub also tracks test state, and provides several hooks into the event pipeline. =head1 COMMON TASKS @@ -636,7 +636,7 @@ an END block. =item $sub = $hub->add_context_acquire(sub { ... }); Add a callback that will be called every time someone tries to acquire a -context. It gets a single argument, a reference the the hash of parameters +context. It gets a single argument, a reference of the hash of parameters being used the construct the context. This is your chance to change the parameters by directly altering the hash. @@ -757,7 +757,7 @@ Get or set the plan. The plan must be an integer larger than 0, the string =item $bool = $hub->check_plan Check if the plan and counts match, but only if the tests have ended. If tests -have not unded this will return undef, otherwise it will be a true/false. +have not ended this will return undef, otherwise it will be a true/false. =back @@ -765,7 +765,7 @@ have not unded this will return undef, otherwise it will be a true/false. This object consumes L which provides a consistent way for you to attach meta-data to instances of this class. This is useful for -tools, plugins, and other extentions. +tools, plugins, and other extensions. =head1 SOURCE diff --git a/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm b/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm index df6df86..57e2bfa 100644 --- a/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm +++ b/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm @@ -2,12 +2,12 @@ package Test2::Hub::Interceptor; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; use Test2::Hub::Interceptor::Terminator(); -use base 'Test2::Hub'; +BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) } use Test2::Util::HashBase; sub inherit { diff --git a/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm b/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm index c79f19c..d76891a 100644 --- a/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm +++ b/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm @@ -2,7 +2,7 @@ package Test2::Hub::Interceptor::Terminator; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; 1; diff --git a/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm b/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm index 071916a..f779c80 100644 --- a/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm +++ b/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm @@ -2,10 +2,10 @@ package Test2::Hub::Subtest; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use base 'Test2::Hub'; +BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) } use Test2::Util::HashBase qw/nested bailed_out exit_code manual_skip_all id/; use Test2::Util qw/get_tid/; diff --git a/cpan/Test-Simple/lib/Test2/IPC.pm b/cpan/Test-Simple/lib/Test2/IPC.pm index ff8a6da..76e83f6 100644 --- a/cpan/Test-Simple/lib/Test2/IPC.pm +++ b/cpan/Test-Simple/lib/Test2/IPC.pm @@ -2,7 +2,7 @@ package Test2::IPC; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; use Test2::API::Instance; @@ -19,13 +19,13 @@ use Test2::API qw{ use Carp qw/confess/; our @EXPORT_OK = qw/cull/; -use base 'Exporter'; +BEGIN { require Exporter; our @ISA = qw(Exporter) } sub import { goto &Exporter::import unless test2_init_done(); - confess "Cannot add IPC in a child process" if test2_pid() != $$; - confess "Cannot add IPC in a child thread" if test2_tid() != get_tid(); + confess "Cannot add IPC in a child process (" . test2_pid() . " vs $$)" if test2_pid() != $$; + confess "Cannot add IPC in a child thread (" . test2_tid() . " vs " . get_tid() . ")" if test2_tid() != get_tid(); Test2::API::_set_ipc(_make_ipc()); apply_ipc(test2_stack()); diff --git a/cpan/Test-Simple/lib/Test2/IPC/Driver.pm b/cpan/Test-Simple/lib/Test2/IPC/Driver.pm index d00fcea..e9df53b 100644 --- a/cpan/Test-Simple/lib/Test2/IPC/Driver.pm +++ b/cpan/Test-Simple/lib/Test2/IPC/Driver.pm @@ -2,7 +2,7 @@ package Test2::IPC::Driver; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; use Carp qw/confess longmess/; @@ -29,7 +29,7 @@ for my $meth (qw/send cull add_hub drop_hub waiting is_viable/) { } # Print the error and call exit. We are not using 'die' cause this is a -# catastophic error that should never be caught. If we get here it +# catastrophic error that should never be caught. If we get here it # means some serious shit has happened in a child process, the only way # to inform the parent may be to exit false. @@ -254,7 +254,7 @@ True if you want to make use of the L/L SHM. =item $bites = $ipc->shm_size() -Use this to customize the size of the shm space. There are no guarantees about +Use this to customize the size of the SHM space. There are no guarantees about what the size will be if you do not implement this. =back diff --git a/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm b/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm index a449a7d..e857e46 100644 --- a/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm +++ b/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm @@ -2,10 +2,10 @@ package Test2::IPC::Driver::Files; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; -use base 'Test2::IPC::Driver'; +BEGIN { require Test2::IPC::Driver; our @ISA = qw(Test2::IPC::Driver) } use Test2::Util::HashBase qw{tempdir event_id tid pid globals}; @@ -13,8 +13,9 @@ use Scalar::Util qw/blessed/; use File::Temp(); use Storable(); use File::Spec(); +use POSIX(); -use Test2::Util qw/try get_tid pkg_to_file/; +use Test2::Util qw/try get_tid pkg_to_file IS_WIN32/; use Test2::API qw/test2_ipc_set_pending/; sub use_shm { 1 } @@ -52,7 +53,7 @@ sub hub_file { my $self = shift; my ($hid) = @_; my $tdir = $self->{+TEMPDIR}; - return File::Spec->canonpath("$tdir/HUB-$hid"); + return File::Spec->catfile($tdir, "HUB-$hid"); } sub event_file { @@ -68,7 +69,7 @@ sub event_file { my @type = split '::', $type; my $name = join('-', $hid, $$, get_tid(), $self->{+EVENT_ID}++, @type); - return File::Spec->canonpath("$tempdir/$name"); + return File::Spec->catfile($tempdir, $name); } sub add_hub { @@ -151,11 +152,31 @@ do so if Test::Builder is loaded for legacy reasons. $self->{+GLOBALS}->{$hid}->{$name}++; } + my ($old, $blocked); + unless(IS_WIN32) { + my $to_block = POSIX::SigSet->new( + POSIX::SIGINT(), + POSIX::SIGALRM(), + POSIX::SIGHUP(), + POSIX::SIGTERM(), + POSIX::SIGUSR1(), + POSIX::SIGUSR2(), + ); + $old = POSIX::SigSet->new; + $blocked = POSIX::sigprocmask(POSIX::SIG_BLOCK(), $to_block, $old); + # Silently go on if we failed to log signals, not much we can do. + } + + # Write and rename the file. my ($ok, $err) = try { Storable::store($e, $file); rename($file, $ready) or $self->abort("Could not rename file '$file' -> '$ready'"); test2_ipc_set_pending(substr($file, -(shm_size))); }; + + # If our block was successful we want to restore the old mask. + POSIX::sigprocmask(POSIX::SIG_SETMASK(), $old, POSIX::SigSet->new()) if defined $blocked; + if (!$ok) { my $src_file = __FILE__; $err =~ s{ at \Q$src_file\E.*$}{}; @@ -207,7 +228,7 @@ sub cull { next if $global && $self->{+GLOBALS}->{$hid}->{$file}++; # Untaint the path. - my $full = File::Spec->canonpath("$tempdir/$file"); + my $full = File::Spec->catfile($tempdir, $file); ($full) = ($full =~ m/^(.*)$/gs); my $obj = $self->read_event_file($full); @@ -279,7 +300,7 @@ sub DESTROY { while(my $file = readdir($dh)) { next if $file =~ m/^\.+$/; next if $file =~ m/\.complete$/; - my $full = File::Spec->canonpath("$tempdir/$file"); + my $full = File::Spec->catfile($tempdir, $file); if ($file =~ m/^(GLOBAL|HUB-)/) { $full =~ m/^(.*)$/; diff --git a/cpan/Test-Simple/lib/Test2/Transition.pod b/cpan/Test-Simple/lib/Test2/Transition.pod index aceb381..a14f22e 100644 --- a/cpan/Test-Simple/lib/Test2/Transition.pod +++ b/cpan/Test-Simple/lib/Test2/Transition.pod @@ -7,7 +7,7 @@ Test2::Transition - Transition notes when upgrading to Test2 =head1 DESCRIPTION This is where gotchas and breakages related to the Test2 upgrade are -documented. The upgrade causes Test::Builder to defer to Test2 uner the hood. +documented. The upgrade causes Test::Builder to defer to Test2 under the hood. This transition is mostly transparent, but there are a few cases that can trip you up. @@ -24,14 +24,14 @@ Confusingly these were called Test::Builder2 and Test::Builder1.5, in that order. Many people put conditionals in their code to check the Test::Builder version number and adapt their code accordingly. -The Test::Builder2/1.5 projects both died out. Now the conditional code poeple +The Test::Builder2/1.5 projects both died out. Now the conditional code people added has become a mine field. A vast majority of modules broken by Test2 fall into this category. =head3 The Fix The fix is to remove all Test::Builder1.5/2 related code. Either use the -lagacy Test::Builder API, or use Test2 directly. +legacy Test::Builder API, or use Test2 directly. =head2 Replacing the Test::Builder singleton @@ -77,7 +77,7 @@ as needed. An early change, in fact the change that made Test2 an idea, was a change to the indentation of the subtest note. IT was decided it would be more readable -to outdent the subtest note instead of having it inline withthe subtest: +to outdent the subtest note instead of having it inline with the subtest: # subtest foo ok 1 - blah @@ -132,7 +132,7 @@ Known broken in versions: 1.0.9 and older =item Test::Kit This actually works fine, but will not install because L is in -the dep chain. +the dependency chain. See the L info below for additional information. diff --git a/cpan/Test-Simple/lib/Test2/Util.pm b/cpan/Test-Simple/lib/Test2/Util.pm index ed6382d..b31ceb5 100644 --- a/cpan/Test-Simple/lib/Test2/Util.pm +++ b/cpan/Test-Simple/lib/Test2/Util.pm @@ -2,7 +2,7 @@ package Test2::Util; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; use Config qw/%Config/; @@ -16,8 +16,14 @@ our @EXPORT_OK = qw{ CAN_THREAD CAN_REALLY_FORK CAN_FORK + + IS_WIN32 }; -use base 'Exporter'; +BEGIN { require Exporter; our @ISA = qw(Exporter) } + +BEGIN { + *IS_WIN32 = ($^O eq 'MSWin32') ? sub() { 1 } : sub() { 0 }; +} sub _can_thread { return 0 unless $] >= 5.008001; @@ -26,7 +32,7 @@ sub _can_thread { # Threads are broken on perl 5.10.0 built with gcc 4.8+ if ($] == 5.010000 && $Config{'ccname'} eq 'gcc' && $Config{'gccversion'}) { my @parts = split /\./, $Config{'gccversion'}; - return 0 if $parts[0] >= 4 && $parts[1] >= 8; + return 0 if $parts[0] > 4 || ($parts[0] == 4 && $parts[1] >= 8); } # Change to a version check if this ever changes @@ -36,7 +42,7 @@ sub _can_thread { sub _can_fork { return 1 if $Config{d_fork}; - return 0 unless $^O eq 'MSWin32' || $^O eq 'NetWare'; + return 0 unless IS_WIN32 || $^O eq 'NetWare'; return 0 unless $Config{useithreads}; return 0 unless $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/; @@ -45,9 +51,25 @@ sub _can_fork { BEGIN { no warnings 'once'; - *CAN_REALLY_FORK = $Config{d_fork} ? sub() { 1 } : sub() { 0 }; *CAN_THREAD = _can_thread() ? sub() { 1 } : sub() { 0 }; - *CAN_FORK = _can_fork() ? sub() { 1 } : sub() { 0 }; +} +my $can_fork; +sub CAN_FORK () { + return $can_fork + if defined $can_fork; + $can_fork = !!_can_fork(); + no warnings 'redefine'; + *CAN_FORK = $can_fork ? sub() { 1 } : sub() { 0 }; + $can_fork; +} +my $can_really_fork; +sub CAN_REALLY_FORK () { + return $can_really_fork + if defined $can_really_fork; + $can_really_fork = !!$Config{d_fork}; + no warnings 'redefine'; + *CAN_REALLY_FORK = $can_really_fork ? sub() { 1 } : sub() { 0 }; + $can_really_fork; } sub _manual_try(&;@) { @@ -80,7 +102,7 @@ sub _local_try(&;@) { # before forking or starting a new thread. So for those systems we use the # non-local form. When possible though we use the faster 'local' form. BEGIN { - if ($^O eq 'MSWin32' && $] < 5.020002) { + if (IS_WIN32 && $] < 5.020002) { *try = \&_manual_try; } else { @@ -89,17 +111,17 @@ BEGIN { } BEGIN { - if(CAN_THREAD) { + if (CAN_THREAD) { if ($INC{'threads.pm'}) { # Threads are already loaded, so we do not need to check if they # are loaded each time *USE_THREADS = sub() { 1 }; - *get_tid = sub { threads->tid() }; + *get_tid = sub() { threads->tid() }; } else { # :-( Need to check each time to see if they have been loaded. - *USE_THREADS = sub { $INC{'threads.pm'} ? 1 : 0 }; - *get_tid = sub { $INC{'threads.pm'} ? threads->tid() : 0 }; + *USE_THREADS = sub() { $INC{'threads.pm'} ? 1 : 0 }; + *get_tid = sub() { $INC{'threads.pm'} ? threads->tid() : 0 }; } } else { @@ -154,7 +176,7 @@ be restored, but $@ will contain the exception being thrown. =item CAN_FORK -True if this system is capable of true or psuedo-fork. +True if this system is capable of true or pseudo-fork. =item CAN_REALLY_FORK diff --git a/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm b/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm index 51c1253..c7e6ea2 100644 --- a/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm +++ b/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm @@ -2,7 +2,7 @@ package Test2::Util::ExternalMeta; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; use Carp qw/croak/; @@ -10,7 +10,7 @@ use Carp qw/croak/; sub META_KEY() { '_meta' } our @EXPORT = qw/meta set_meta get_meta delete_meta/; -use base 'Exporter'; +BEGIN { require Exporter; our @ISA = qw(Exporter) } sub set_meta { my $self = shift; @@ -91,7 +91,7 @@ tools to attach meta-data to your instances. If your object consumes this package, and imports its methods, then third party meta-data has a safe place to live. -=head1 SYNOPSYS +=head1 SYNOPSIS package My::Object; use strict; @@ -124,7 +124,7 @@ hash, then there is a conflict and you cannot use this package. =item $val = $obj->meta($key, $default) This will get the value for a specified meta C<$key>. Normally this will return -C when there is no value for the C<$key>, however you can specfi a +C when there is no value for the C<$key>, however you can specify a C<$default> value to set when no value is already set. =item $val = $obj->get_meta($key) @@ -143,7 +143,7 @@ Set the value of a specified meta C<$key>. =back -=head1 META-KEY RESTICTIONS +=head1 META-KEY RESTRICTIONS Meta keys must be defined, and must be true when used as a boolean. Keys may not be references. You are free to stringify a reference C<"$ref"> for use as a diff --git a/cpan/Test-Simple/lib/Test2/Util/HashBase.pm b/cpan/Test-Simple/lib/Test2/Util/HashBase.pm index 42f04d9..0f20433 100644 --- a/cpan/Test-Simple/lib/Test2/Util/HashBase.pm +++ b/cpan/Test-Simple/lib/Test2/Util/HashBase.pm @@ -2,54 +2,43 @@ package Test2::Util::HashBase; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; require Carp; $Carp::Internal{+__PACKAGE__} = 1; -my %ATTRS; -my %META; - -sub _get_inherited_attrs { - no strict 'refs'; - my @todo = map @{"$_\::ISA"}, @_; - my %seen; - my @all; - while (my $pkg = shift @todo) { - next if $seen{$pkg}++; - my $found = $META{$pkg}; - push @all => %$found if $found; - - my $isa = \@{"$pkg\::ISA"}; - push @todo => @$isa if @$isa; +my %ATTR_SUBS; + +BEGIN { + # these are not strictly equivalent, but for out use we don't care + # about order + *_isa = ($] >= 5.010 && require mro) ? \&mro::get_linear_isa : sub { + no strict 'refs'; + my @packages = ($_[0]); + my %seen; + for my $package (@packages) { + push @packages, grep !$seen{$_}++, @{"$package\::ISA"}; + } + return \@packages; } - - return \@all; -} - -sub _make_subs { - my ($str) = @_; - return $ATTRS{$str} ||= { - uc($str) => sub() { $str }, - $str => sub { $_[0]->{$str} }, - "set_$str" => sub { $_[0]->{$str} = $_[1] }, - }; } sub import { my $class = shift; my $into = caller; - my %attrs = map %{_make_subs($_)}, @_; - - my @meta = map uc, @_; - @{$META{$into}}{@meta} = map $attrs{$_}, @meta; - + my $isa = _isa($into); + my $attr_subs = $ATTR_SUBS{$into} ||= {}; my %subs = ( - %attrs, - @{_get_inherited_attrs($into)}, - $into->can('new') ? () : (new => \&_new) + ($into->can('new') ? () : (new => \&_new)), + (map %{ $ATTR_SUBS{$_}||{} }, @{$isa}[1 .. $#$isa]), + (map { + my ($sub, $attr) = (uc $_, $_); + $sub => ($attr_subs->{$sub} = sub() { $attr }), + $attr => sub { $_[0]->{$attr} }, + "set_$attr" => sub { $_[0]->{$attr} = $_[1] }, + } @_), ); no strict 'refs'; @@ -146,7 +135,7 @@ This package is used to generate classes based on hashrefs. Using this class will give you a C method, as well as generating accessors you request. Generated accessors will be getters, C setters will also be generated for you. You also get constants for each accessor (all caps) which -return the key into the hash for that accessor. Single inheritence is also +return the key into the hash for that accessor. Single inheritance is also supported. =head1 METHODS @@ -160,7 +149,7 @@ supported. Create a new instance using key/value pairs. HashBase will not export C if there is already a C method in your -packages inheritence chain. +packages inheritance chain. B you just have to declare it before loading L. diff --git a/cpan/Test-Simple/lib/Test2/Util/Trace.pm b/cpan/Test-Simple/lib/Test2/Util/Trace.pm index 7fcfcef..43e7bab 100644 --- a/cpan/Test-Simple/lib/Test2/Util/Trace.pm +++ b/cpan/Test-Simple/lib/Test2/Util/Trace.pm @@ -2,7 +2,7 @@ package Test2::Util::Trace; use strict; use warnings; -our $VERSION = '1.302015'; +our $VERSION = '1.302022'; use Test2::Util qw/get_tid/; @@ -87,7 +87,7 @@ C<< at line >> when calling C<< $trace->debug >>. =item $str = $trace->debug Typically returns the string C<< at line >>. If C is set -then its value wil be returned instead. +then its value will be returned instead. =item $trace->alert($MESSAGE) diff --git a/cpan/Test-Simple/lib/ok.pm b/cpan/Test-Simple/lib/ok.pm index b632a49..d6ca797 100644 --- a/cpan/Test-Simple/lib/ok.pm +++ b/cpan/Test-Simple/lib/ok.pm @@ -1,5 +1,5 @@ package ok; -$ok::VERSION = '1.302015'; +$ok::VERSION = '1.302022'; use strict; use Test::More (); diff --git a/cpan/Test-Simple/t/00compile.t b/cpan/Test-Simple/t/00compile.t index 281021b..049f989 100644 --- a/cpan/Test-Simple/t/00compile.t +++ b/cpan/Test-Simple/t/00compile.t @@ -34,7 +34,12 @@ foreach my $file (@modules) { # they're already loaded. This avoids recompilation warnings. local @INC = @INC; unshift @INC, "."; - ok eval { require($file); 1 } or diag "require $file failed.\n$@"; + 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; diff --git a/cpan/Test-Simple/t/Legacy/Regression/637.t b/cpan/Test-Simple/t/Legacy/Regression/637.t index 149b64d..fcf0f10 100644 --- a/cpan/Test-Simple/t/Legacy/Regression/637.t +++ b/cpan/Test-Simple/t/Legacy/Regression/637.t @@ -1,14 +1,13 @@ use strict; use warnings; +use Test2::Util qw/CAN_THREAD/; BEGIN { - my $skip = !eval { require threads; 1 }; - if ($skip) { + unless(CAN_THREAD) { require Test::More; - Test::More::plan(skip_all => 'no threads'); + Test::More->import(skip_all => "threads are not supported"); } } - use threads; use Test::More; diff --git a/cpan/Test-Simple/t/Legacy/Tester/tbt_06errormess.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_06errormess.t index b02b617..ec3abc6 100644 --- a/cpan/Test-Simple/t/Legacy/Tester/tbt_06errormess.t +++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_06errormess.t @@ -9,7 +9,7 @@ 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 onwards with the cut and paste +# annoying but can't be avoided. And onward with the cut and paste # My brain is melting. My brain is melting. ETOOMANYLAYERSOFTESTING diff --git a/cpan/Test-Simple/t/Legacy/Tester/tbt_07args.t b/cpan/Test-Simple/t/Legacy/Tester/tbt_07args.t index 9542d75..9b631ab 100644 --- a/cpan/Test-Simple/t/Legacy/Tester/tbt_07args.t +++ b/cpan/Test-Simple/t/Legacy/Tester/tbt_07args.t @@ -9,7 +9,7 @@ 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 onwards with the cut and paste +# annoying but can't be avoided. And onward with the cut and paste # My brain is melting. My brain is melting. ETOOMANYLAYERSOFTESTING diff --git a/cpan/Test-Simple/t/Test2/acceptance/try_it_todo.t b/cpan/Test-Simple/t/Test2/acceptance/try_it_todo.t index 5c5f694..7a7d7a1 100644 --- a/cpan/Test-Simple/t/Test2/acceptance/try_it_todo.t +++ b/cpan/Test-Simple/t/Test2/acceptance/try_it_todo.t @@ -47,6 +47,5 @@ diag "should be a note"; test2_stack->top->unfilter($filter); ok(1, "Third"); -diag "should be a diag"; done_testing; diff --git a/cpan/Test-Simple/t/Test2/modules/API/Instance.t b/cpan/Test-Simple/t/Test2/modules/API/Instance.t index 45e739f..b26b53c 100644 --- a/cpan/Test-Simple/t/Test2/modules/API/Instance.t +++ b/cpan/Test-Simple/t/Test2/modules/API/Instance.t @@ -11,8 +11,6 @@ my $one = $CLASS->new; is_deeply( $one, { - pid => $$, - tid => get_tid(), contexts => {}, finalized => undef, @@ -45,8 +43,6 @@ $one->reset; is_deeply( $one, { - pid => $$, - tid => get_tid(), contexts => {}, ipc_polling => undef, @@ -201,7 +197,7 @@ if (CAN_THREAD && $] ge '5.010') { { $one->reset(); - $one->set_tid(1); + $one->set__tid(1); local $? = 0; $one->set_exit; is($?, 0, "no errors on exit"); @@ -226,6 +222,7 @@ if (CAN_THREAD && $] ge '5.010') { { $one->reset(); + $one->load(); $one->stack->top->set_failed(2); local $? = 0; $one->set_exit; @@ -234,6 +231,7 @@ if (CAN_THREAD && $] ge '5.010') { { $one->reset(); + $one->load(); local $? = 500; $one->set_exit; is($?, 255, "set exit code to a sane number"); @@ -243,6 +241,7 @@ if (CAN_THREAD && $] ge '5.010') { 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; @@ -287,6 +286,7 @@ This is not a supported configuration, you will have problems. local *Test2::API::Breakage::report = sub { $ran++; return "foo" }; use warnings qw/redefine once/; $one->reset(); + $one->load(); my $stderr = ""; { @@ -308,6 +308,7 @@ foo { $one->reset(); + $one->load(); my @events; $one->stack->top->filter(sub { push @events => $_[1]; undef}); $one->stack->new_hub; 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 368bbf2..5cda691 100644 --- a/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t +++ b/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t @@ -1,6 +1,7 @@ BEGIN { require "t/tools.pl" }; use Test2::Util qw/get_tid USE_THREADS try/; use File::Temp qw/tempfile/; +use File::Spec qw/catfile/; use strict; use warnings; @@ -42,8 +43,9 @@ is($ipc->tid, get_tid(), "stored the tid"); my $hid = '12345'; $ipc->add_hub($hid); -ok(-f $ipc->tempdir . '/HUB-' . $hid, "wrote hub file"); -if(ok(open(my $fh, '<', $ipc->tempdir . '/HUB-' . $hid), "opened hub file")) { +my $hubfile = File::Spec->catfile($ipc->tempdir, "HUB-$hid"); +ok(-f $hubfile, "wrote hub file"); +if(ok(open(my $fh, '<', $hubfile), "opened hub file")) { my @lines = <$fh>; close($fh); is_deeply( @@ -62,7 +64,7 @@ $ipc->send($hid, bless({ foo => 1 }, 'Foo')); $ipc->send($hid, bless({ bar => 1 }, 'Foo')); opendir(my $dh, $ipc->tempdir) || die "Could not open tempdir: !?"; -my @files = grep { $_ !~ m/^\.+$/ && $_ ne "HUB-$hid" } readdir($dh); +my @files = grep { $_ !~ m/^\.+$/ && $_ !~ m/^HUB-$hid/ } readdir($dh); closedir($dh); is(@files, 2, "2 files added to the IPC directory"); @@ -74,7 +76,7 @@ is_deeply( ); opendir($dh, $ipc->tempdir) || die "Could not open tempdir: !?"; -@files = grep { $_ !~ m/^\.+$/ && $_ ne "HUB-$hid" } readdir($dh); +@files = grep { $_ !~ m/^\.+$/ && $_ !~ m/^HUB-$hid/ } readdir($dh); closedir($dh); is(@files, 0, "All files collected"); @@ -152,6 +154,18 @@ ok(!-d $tmpdir, "cleaned up temp dir"); 1; }; + my $cleanup = sub { + if (opendir(my $d, $tmpdir)) { + for my $f (readdir($d)) { + next if $f =~ m/^\.+$/; + next unless -f "$tmpdir/$f"; + unlink("$tmpdir/$f"); + } + } + rmdir($tmpdir) or warn "Could not remove temp dir '$tmpdir': $!"; + }; + $cleanup->(); + is($out->{STDOUT}, "not ok - IPC Fatal Error\nnot ok - IPC Fatal Error\n", "printed "); like($out->{STDERR}, qr/IPC Temp Dir: \Q$tmpdir\E/m, "Got temp dir path"); @@ -186,12 +200,14 @@ ok(!-d $tmpdir, "cleaned up temp dir"); $out = 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 '12345' have been collected/, "Leftover files"); like($out->{STDERR}, qr/IPC Fatal Error: Leftover files in the directory \(.*\.ready\)/, "What file"); diff --git a/cpan/Test-Simple/t/Test2/modules/Util.t b/cpan/Test-Simple/t/Test2/modules/Util.t index 1632a95..da44ba1 100644 --- a/cpan/Test-Simple/t/Test2/modules/Util.t +++ b/cpan/Test-Simple/t/Test2/modules/Util.t @@ -12,6 +12,8 @@ use Test2::Util qw/ CAN_FORK CAN_THREAD CAN_REALLY_FORK + + IS_WIN32 /; { @@ -33,5 +35,8 @@ is(pkg_to_file('A::Package::Name'), 'A/Package/Name.pm', "Converted package to f CAN_THREAD(); CAN_FORK(); CAN_REALLY_FORK(); +IS_WIN32(); + +is(IS_WIN32(), ($^O eq 'MSWin32') ? 1 : 0, "IS_WIN32 is correct ($^O)"); done_testing; diff --git a/cpan/Test-Simple/t/regression/662-tbt-no-plan.t b/cpan/Test-Simple/t/regression/662-tbt-no-plan.t new file mode 100644 index 0000000..acc9c9f --- /dev/null +++ b/cpan/Test-Simple/t/regression/662-tbt-no-plan.t @@ -0,0 +1,25 @@ +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;"); diff --git a/cpan/Test-Simple/t/tools.t b/cpan/Test-Simple/t/tools.t index 3a87a00..a71aff1 100644 --- a/cpan/Test-Simple/t/tools.t +++ b/cpan/Test-Simple/t/tools.t @@ -30,7 +30,7 @@ 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";