From: Vincent Pit Date: Sat, 24 Aug 2013 19:26:40 +0000 (-0300) Subject: Update bundled Test::Leaner to 0.05 X-Git-Tag: v0.08~2 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=671ed470650e4afb947dd536f7b89d1d9503719b;p=perl%2Fmodules%2FScalar-Vec-Util.git Update bundled Test::Leaner to 0.05 --- diff --git a/t/lib/Test/Leaner.pm b/t/lib/Test/Leaner.pm index 3365006..9944e25 100644 --- a/t/lib/Test/Leaner.pm +++ b/t/lib/Test/Leaner.pm @@ -10,11 +10,11 @@ Test::Leaner - A slimmer Test::More for when you favor performance over complete =head1 VERSION -Version 0.02 +Version 0.05 =cut -our $VERSION = '0.02'; +our $VERSION = '0.05'; =head1 SYNOPSIS @@ -37,16 +37,20 @@ Its functions behave the same as their L counterparts, except for th =item * Stringification isn't forced on the test operands. -However, L honors C<'bool'> overloading, L and L honor C<'eq'> overloading (and just that one) and L honors whichever overloading category corresponds to the specified operator. +However, L honors C<'bool'> overloading, L and L honor C<'eq'> overloading (and just that one), L honors C<'ne'> overloading, and L honors whichever overloading category corresponds to the specified operator. =item * -L, L, L, L, L, L, L and L are all guaranteed to return the truth value of the test. +L, L, L, L, L, L, L, L and L are all guaranteed to return the truth value of the test. + +=item * + +C (the sub C in package C) is not aliased to L. =item * L and L don't special case regular expressions that are passed as C<'/.../'> strings. -A string regexp argument is always treated as a the source of the regexp, making C and C equivalent to each other and to C (and likewise for C). +A string regexp argument is always treated as the source of the regexp, making C and C equivalent to each other and to C (and likewise for C). =item * @@ -61,6 +65,7 @@ If the two first arguments present parallel memory cycles, the test may result i =item * The tests don't output any kind of default diagnostic in case of failure ; the rationale being that if you have a large number of tests and a lot of them are failing, then you don't want to be flooded by diagnostics. +Moreover, this allows a much faster variant of L. =item * @@ -77,7 +82,7 @@ my $main_process; BEGIN { $main_process = $$; - if ($] >= 5.008 and $INC{'threads.pm'}) { + if ("$]" >= 5.008 and $INC{'threads.pm'}) { my $use_ithreads = do { require Config; no warnings 'once'; @@ -120,7 +125,7 @@ our @EXPORT = qw< =head2 C If this environment variable is set, L will replace its functions by those from L. -Moreover, the symbols that are imported you C will be those from L, but you can still only import the symbols originally defined in L (hence the functions from L that are not implemented in L will not be imported). +Moreover, the symbols that are imported when you C will be those from L, but you can still only import the symbols originally defined in L (hence the functions from L that are not implemented in L will not be imported). If your version of L is too old and doesn't have some symbols (like L or L), they will be replaced in L by croaking stubs. This may be useful if your L-based test script fails and you want extra diagnostics. @@ -160,14 +165,13 @@ if ($ENV{PERL_TEST_LEANER_USES_TEST_MORE}) { my $leaner_stash = \%Test::Leaner::; my $more_stash = \%Test::More::; - my %valid_imports; + my %stubbed; for (@EXPORT) { my $replacement = exists $more_stash->{$_} ? *{$more_stash->{$_}}{CODE} : undef; - if (defined $replacement) { - $valid_imports{$_} = 1; - } else { + unless (defined $replacement) { + $stubbed{$_}++; $replacement = sub { @_ = ("$_ is not implemented in this version of Test::More"); goto &croak; @@ -178,20 +182,33 @@ if ($ENV{PERL_TEST_LEANER_USES_TEST_MORE}) { } my $import = sub { - shift; + my $class = shift; + my @imports = &_handle_import_args; - @imports = @EXPORT unless @imports; + if (@imports == grep /^!/, @imports) { + # All imports are negated, or @imports is empty + my %negated; + /^!(.*)/ and ++$negated{$1} for @imports; + push @imports, grep !$negated{$_}, @EXPORT; + } + my @test_more_imports; for (@imports) { - if ($valid_imports{$_}) { - push @test_more_imports, $_; - } else { + if ($stubbed{$_}) { my $pkg = caller; no strict 'refs'; *{$pkg."::$_"} = $leaner_stash->{$_}; + } elsif (/^!/ or !exists $more_stash->{$_} or exists $leaner_stash->{$_}) { + push @test_more_imports, $_; + } else { + # Croak for symbols in Test::More but not in Test::Leaner + Exporter::import($class, $_); } } + my $test_more_import = 'Test::More'->can('import'); + return unless $test_more_import; + @_ = ( 'Test::More', @_, @@ -201,6 +218,7 @@ if ($ENV{PERL_TEST_LEANER_USES_TEST_MORE}) { lock $plan if THREADSAFE; push @_, 'no_diag' if $no_diag; } + goto $test_more_import; }; @@ -255,7 +273,11 @@ sub _sanitize_comment { The following functions from L are implemented and exported by default. -=head2 C<< plan [ tests => $count | 'no_plan' | skip_all => $reason ] >> +=head2 C + + plan tests => $count; + plan 'no_plan'; + plan skip_all => $reason; See L. @@ -318,7 +340,9 @@ sub import { goto &Exporter::import; } -=head2 C<< skip $reason => $count >> +=head2 C + + skip $reason => $count; See L. @@ -355,7 +379,10 @@ sub skip { last SKIP; } -=head2 C +=head2 C + + done_testing; + done_testing $count; See L. @@ -388,7 +415,10 @@ sub done_testing { return 1; } -=head2 C +=head2 C + + ok $ok; + ok $ok, $desc; See L. @@ -402,10 +432,10 @@ sub ok ($;$) { ++$test; my $test_str = "ok $test"; - unless ($ok) { + $ok or do { $test_str = "not $test_str"; ++$failed; - } + }; if (defined $desc) { _sanitize_comment($desc); $test_str .= " - $desc" if length $desc; @@ -417,7 +447,10 @@ sub ok ($;$) { return $ok; } -=head2 C +=head2 C + + pass; + pass $desc; See L. @@ -428,7 +461,10 @@ sub pass (;$) { goto &ok; } -=head2 C +=head2 C + + fail; + fail $desc; See L. @@ -439,7 +475,10 @@ sub fail (;$) { goto &ok; } -=head2 C +=head2 C + + is $got, $expected; + is $got, $expected, $desc; See L. @@ -455,7 +494,10 @@ sub is ($$;$) { goto &ok; } -=head2 C +=head2 C + + isnt $got, $expected; + isnt $got, $expected, $desc; See L. @@ -477,7 +519,7 @@ my %binops = ( 'and' => 'and', '||' => 'hor', - ('//' => 'dor') x ($] >= 5.010), + ('//' => 'dor') x ("$]" >= 5.010), '&&' => 'hand', '|' => 'bor', @@ -502,7 +544,7 @@ my %binops = ( '=~' => 'like', '!~' => 'unlike', - ('~~' => 'smartmatch') x ($] >= 5.010), + ('~~' => 'smartmatch') x ("$]" >= 5.010), '+' => 'add', '-' => 'substract', @@ -542,11 +584,17 @@ IS_BINOP } } -=head2 C +=head2 C + + like $got, $regexp_expected; + like $got, $regexp_expected, $desc; See L. -=head2 C +=head2 C + + unlike $got, $regexp_expected; + unlike $got, $regexp_expected, $desc; See L. @@ -558,7 +606,10 @@ See L. *unlike = _create_binop_handler('!~'); } -=head2 C +=head2 C + + cmp_ok $got, $op, $expected; + cmp_ok $got, $op, $expected, $desc; See L. @@ -575,7 +626,10 @@ sub cmp_ok ($$$;$) { goto $handler; } -=head2 C +=head2 C + + is_deeply $got, $expected; + is_deeply $got, $expected, $desc; See L. @@ -717,7 +771,9 @@ sub _diag_fh { return 0; }; -=head2 C +=head2 C + + diag @lines; See L. @@ -728,7 +784,9 @@ sub diag { goto &_diag_fh; } -=head2 C +=head2 C + + note @lines; See L. @@ -739,7 +797,10 @@ sub note { goto &_diag_fh; } -=head2 C +=head2 C + + BAIL_OUT; + BAIL_OUT $desc; See L. @@ -784,7 +845,10 @@ END { L also provides some functions of its own, which are never exported. -=head2 C +=head2 C + + my $tap_fh = tap_stream; + tap_stream $fh; Read/write accessor for the filehandle to which the tests are outputted. On write, it also turns autoflush on onto C<$fh>. @@ -809,7 +873,10 @@ sub tap_stream (;*) { tap_stream *STDOUT; -=head2 C +=head2 C + + my $diag_fh = diag_stream; + diag_stream $fh; Read/write accessor for the filehandle to which the diagnostics are printed. On write, it also turns autoflush on onto C<$fh>. @@ -864,7 +931,13 @@ You can find documentation for this module with the perldoc command. =head1 COPYRIGHT & LICENSE -Copyright 2010 Vincent Pit, all rights reserved. +Copyright 2010,2011,2013 Vincent Pit, all rights reserved. + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +Except for the fallback implementation of the internal C<_reftype> function, which has been taken from L and is + +Copyright 1997-2007 Graham Barr, all rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.