From: Vincent Pit <vince@profvince.com>
Date: Fri, 24 Dec 2010 17:33:43 +0000 (+0100)
Subject: Generate binop comparators on the fly
X-Git-Tag: v0.01~23
X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=95d98c140e711be6185a7ff61ac78668ebc91155;p=perl%2Fmodules%2FTest-Leaner.git

Generate binop comparators on the fly

Except for is_like() and is_unlike() which are needed for like() and
unlike().

This should also make cmp_ok() a little faster since we don't have to
resolve the symbolic reference at each run.
---

diff --git a/lib/Test/Leaner.pm b/lib/Test/Leaner.pm
index d88ecf6..4f53275 100644
--- a/lib/Test/Leaner.pm
+++ b/lib/Test/Leaner.pm
@@ -259,51 +259,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 (\$got, \$expected, \$desc) = \@_;
- \@_ = ((\$got $op \$expected), \$desc);
- goto &ok;
-}
-IS_BINOP
-  die $@ if $@;
- }
-}
-
 sub is ($$;$) {
  my ($got, $expected, $desc) = @_;
  no warnings 'uninitialized';
@@ -324,19 +279,73 @@ sub isnt ($$;$) {
  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 ($got, $op, $expected, $desc) = @_;
- my $name = $binops{$op};
- croak("Operator $op not supported") unless defined $name;
+ my $handler = $binop_handlers{$op};
+ unless ($handler) {
+  local $Test::More::Level = ($Test::More::Level || 0) + 1;
+  $handler = _create_binop_handler($op);
+ }
  @_ = ($got, $expected, $desc);
- no strict 'refs';
- goto &{__PACKAGE__."::is_$name"};
+ goto $handler;
 }
 
 sub _diag_fh {
diff --git a/t/80-threads.t b/t/80-threads.t
index 3b0a595..a04d1b9 100644
--- a/t/80-threads.t
+++ b/t/80-threads.t
@@ -39,7 +39,7 @@ sub worker {
  diag "spawned thread $tid";
  tick;
  for (1 .. 10) {
-  pass "test $_ in thread $tid";
+  cmp_ok 1, '==', '1.0', "test $_ in thread $tid";
   tick;
  }
 }