X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FTest%2FLeaner.pm;h=a022c92bedc56565fc3b671e60705b995b3878ab;hb=1f18a8970afb90a780a29c9839e3ffee0bc2d5ba;hp=f0f490eba2ed5f9930d44a8d7de7c5f10c5b15dd;hpb=41367a04c268486fb815420a103f80e28ffefd63;p=perl%2Fmodules%2FTest-Leaner.git diff --git a/lib/Test/Leaner.pm b/lib/Test/Leaner.pm index f0f490e..a022c92 100644 --- a/lib/Test/Leaner.pm +++ b/lib/Test/Leaner.pm @@ -25,22 +25,26 @@ BEGIN { } } -my ($plan, $test, $failed, $no_diag); +my $TAP_STREAM = *STDOUT; +my $DIAG_STREAM = *STDERR; + +my ($plan, $test, $failed, $no_diag, $done_testing); sub NO_PLAN () { -1 } sub SKIP_ALL () { -2 } BEGIN { - threads::shared::share($plan), lock $plan if THREADSAFE; + if (THREADSAFE) { + threads::shared::share($_) for $plan, $test, $failed, $no_diag; + } + + lock $plan if THREADSAFE; $plan = undef; $test = 0; $failed = 0; } -my $TAP_STREAM = *STDOUT; -my $DIAG_STREAM = *STDERR; - sub carp { my $level = 1 + ($Test::Builder::Level || 0); my ($file, $line) = (caller $level)[1, 2]; @@ -118,6 +122,7 @@ our @EXPORT = qw< ok is isnt + cmp_ok like unlike diag @@ -194,8 +199,6 @@ sub skip { last SKIP; } -my $done_testing; - sub done_testing { my ($count) = @_; @@ -293,11 +296,7 @@ BEGIN { eval <<"IS_BINOP"; sub is_$name (\$\$;\$) { my (\$x, \$y, \$desc) = \@_; - no warnings 'uninitialized'; - \@_ = ( - (not(defined \$x xor defined \$y) and \$x $op \$y), - \$desc, - ); + \@_ = ((\$x $op \$y), \$desc); goto &ok; } IS_BINOP @@ -305,11 +304,14 @@ IS_BINOP } } -{ - no warnings 'once'; - *is = \&is_eq; - *like = \&is_like; - *unlike = \&is_unlike; +sub is ($$;$) { + my ($got, $expected, $desc) = @_; + no warnings 'uninitialized'; + @_ = ( + (not(defined $got xor defined $expected) and $got eq $expected), + $desc, + ); + goto &ok; } sub isnt ($$;$) { @@ -322,13 +324,19 @@ sub isnt ($$;$) { goto &ok; } +{ + no warnings 'once'; + *like = \&is_like; + *unlike = \&is_unlike; +} + sub cmp_ok ($$$;$) { my ($x, $op, $y, $desc) = @_; my $name = $binops{$op}; croak("Operator $op not supported") unless defined $name; @_ = ($x, $y, $desc); no strict 'refs'; - goto &{__PACKAGE__."is_$name"}; + goto &{__PACKAGE__."::is_$name"}; } sub _diag_fh {