Only is() should treat undef specially

[perl/modules/Test-Leaner.git] / lib / Test / Leaner.pm

diff --git a/lib/Test/Leaner.pm b/lib/Test/Leaner.pm
index f0f490eba2ed5f9930d44a8d7de7c5f10c5b15dd..a022c92bedc56565fc3b671e60705b995b3878ab 100644 (file)
--- 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 {