ok
is
isnt
+ cmp_ok
like
unlike
diag
}
for (1 .. $count) {
+ ++$test;
+
my $skip_str = "ok $test # skip";
if (defined $reason) {
sanitize_comment($reason);
local $\;
print $TAP_STREAM "$skip_str\n";
-
- $test++;
}
no warnings 'exiting';
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',
+sub is ($$;$) {
+ my ($got, $expected, $desc) = @_;
+ no warnings 'uninitialized';
+ @_ = (
+ (not(defined $got xor defined $expected) and $got eq $expected),
+ $desc,
);
+ goto &ok;
+}
- for my $op (sort keys %binops) {
- my $name = $binops{$op};
+sub isnt ($$;$) {
+ my ($got, $expected, $desc) = @_;
+ no warnings 'uninitialized';
+ @_ = (
+ ((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 (\$x, \$y, \$desc) = \@_;
- no warnings 'uninitialized';
- \@_ = (
- (not(defined \$x xor defined \$y) and \$x $op \$y),
- \$desc,
- );
+ 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';
- *is = \&is_eq;
- *like = \&is_like;
- *unlike = \&is_unlike;
-}
-
-sub isnt ($$;$) {
- my ($x, $y, $desc) = @_;
- no warnings 'uninitialized';
- @_ = (
- ((defined $x xor defined $y) or $x ne $y),
- $desc,
- );
- goto &ok;
+ *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 {