X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FTest%2FLeaner.pm;h=1efe7a295183bf1f285b059b82cc57fe635c9b24;hb=e3217cb5d83d1ae15f1795bef7c885740607689b;hp=a022c92bedc56565fc3b671e60705b995b3878ab;hpb=1f18a8970afb90a780a29c9839e3ffee0bc2d5ba;p=perl%2Fmodules%2FTest-Leaner.git

diff --git a/lib/Test/Leaner.pm b/lib/Test/Leaner.pm
index a022c92..1efe7a2 100644
--- a/lib/Test/Leaner.pm
+++ b/lib/Test/Leaner.pm
@@ -28,6 +28,12 @@ BEGIN {
 my $TAP_STREAM  = *STDOUT;
 my $DIAG_STREAM = *STDERR;
 
+for ($TAP_STREAM, $DIAG_STREAM) {
+ my $fh = select $_;
+ $|++;
+ select $fh;
+}
+
 my ($plan, $test, $failed, $no_diag, $done_testing);
 
 sub NO_PLAN  () { -1 }
@@ -35,7 +41,7 @@ sub SKIP_ALL () { -2 }
 
 BEGIN {
  if (THREADSAFE) {
-  threads::shared::share($_) for $plan, $test, $failed, $no_diag;
+  threads::shared::share($_) for $plan, $test, $failed, $no_diag, $done_testing;
  }
 
  lock $plan if THREADSAFE;
@@ -96,12 +102,6 @@ sub plan {
   croak("plan() doesn't understand @args");
  }
 
- {
-  my $fh = select $TAP_STREAM;
-  $|++;
-  select $fh;
- }
-
  if (defined $plan_str) {
   local $\;
   print $TAP_STREAM "$plan_str\n";
@@ -143,6 +143,7 @@ sub import {
     push @imports, @{ $_[$i+1] };
     $splice  = 2;
    } elsif ($item eq 'no_diag') {
+    lock $plan if THREADSAFE;
     $no_diag = 1;
     $splice  = 1;
    }
@@ -183,6 +184,8 @@ sub skip {
  }
 
  for (1 .. $count) {
+  ++$test;
+
   my $skip_str = "ok $test # skip";
   if (defined $reason) {
    sanitize_comment($reason);
@@ -191,8 +194,6 @@ sub skip {
 
   local $\;
   print $TAP_STREAM "$skip_str\n";
-
-  $test++;
  }
 
  no warnings 'exiting';
@@ -259,51 +260,6 @@ sub fail (;$) {
  goto &ok;
 }
 
-my %binops;
-BEGIN {
- %binops = (
-  'or'  => 'or',
-  'and' => 'and',
-  'xor' => 'xor',
-
-  '||'  => 'hor',
-  '&&'  => 'hand',
-
-  'lt'  => 'lt',
-  'le'  => 'le',
-  'gt'  => 'gt',
-  'ge'  => 'ge',
-  'eq'  => 'eq',
-  'ne'  => 'ne',
-  'cmp' => 'cmp',
-
-  '<'   => 'nlt',
-  '<='  => 'nle',
-  '>'   => 'ngt',
-  '>='  => 'nge',
-  '=='  => 'neq',
-  '!='  => 'nne',
-  '<=>' => 'ncmp',
-
-  '=~'  => 'like',
-  '!~'  => 'unlike',
-  '~~'  => 'smartmatch',
- );
-
- for my $op (sort keys %binops) {
-  my $name = $binops{$op};
-  local $@;
-  eval <<"IS_BINOP";
-sub is_$name (\$\$;\$) {
- my (\$x, \$y, \$desc) = \@_;
- \@_ = ((\$x $op \$y), \$desc);
- goto &ok;
-}
-IS_BINOP
-  die $@ if $@;
- }
-}
-
 sub is ($$;$) {
  my ($got, $expected, $desc) = @_;
  no warnings 'uninitialized';
@@ -315,28 +271,82 @@ sub is ($$;$) {
 }
 
 sub isnt ($$;$) {
- my ($x, $y, $desc) = @_;
+ my ($got, $expected, $desc) = @_;
  no warnings 'uninitialized';
  @_ = (
-  ((defined $x xor defined $y) or $x ne $y),
+  ((defined $got xor defined $expected) or $got ne $expected),
   $desc,
  );
  goto &ok;
 }
 
+my %binops = (
+ 'or'  => 'or',
+ 'and' => 'and',
+ 'xor' => 'xor',
+
+ '||'  => 'hor',
+ '&&'  => 'hand',
+
+ 'lt'  => 'lt',
+ 'le'  => 'le',
+ 'gt'  => 'gt',
+ 'ge'  => 'ge',
+ 'eq'  => 'eq',
+ 'ne'  => 'ne',
+ 'cmp' => 'cmp',
+
+ '<'   => 'nlt',
+ '<='  => 'nle',
+ '>'   => 'ngt',
+ '>='  => 'nge',
+ '=='  => 'neq',
+ '!='  => 'nne',
+ '<=>' => 'ncmp',
+
+ '=~'  => 'like',
+ '!~'  => 'unlike',
+ '~~'  => 'smartmatch',
+);
+
+my %binop_handlers;
+
+sub _create_binop_handler {
+ my ($op) = @_;
+ my $name = $binops{$op};
+ croak("Operator $op not supported") unless defined $name;
+ {
+  local $@;
+  eval <<"IS_BINOP";
+sub is_$name (\$\$;\$) {
+ my (\$got, \$expected, \$desc) = \@_;
+ \@_ = ((\$got $op \$expected), \$desc);
+ goto &ok;
+}
+IS_BINOP
+  die $@ if $@;
+ }
+ $binop_handlers{$op} = do {
+  no strict 'refs';
+  \&{__PACKAGE__."::is_$name"};
+ }
+}
+
 {
  no warnings 'once';
- *like   = \&is_like;
- *unlike = \&is_unlike;
+ *like   = _create_binop_handler('=~');
+ *unlike = _create_binop_handler('!~');
 }
 
 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"};
+ my ($got, $op, $expected, $desc) = @_;
+ my $handler = $binop_handlers{$op};
+ unless ($handler) {
+  local $Test::More::Level = ($Test::More::Level || 0) + 1;
+  $handler = _create_binop_handler($op);
+ }
+ @_ = ($got, $expected, $desc);
+ goto $handler;
 }
 
 sub _diag_fh {