sub cmp_ok {
my($self, $got, $type, $expect, $name) = @_;
# Treat overloaded objects as numbers if we're asked to do a
# numeric comparison.
my $unoverload = $numeric_cmps{$type} ? '_unoverload_num'
: '_unoverload_str';
$self->$unoverload(\$got, \$expect);
my $test;
{
local($@,$!,$SIG{__DIE__}); # isolate eval
my $code = $self->_caller_context;
# Yes, it has to look like this or 5.4.5 won't see the #line
# directive.
# Don't ask me, man, I just work here.
######################################################################
+##########
$test = eval "
$code" . "\$got $type \$expect;";
######################################################################
+##########
}
local $Level = $Level + 1;
my $ok = $self->ok($test, $name);
unless( $ok ) {
if( $type =~ /^(eq|==)$/ ) {
$self->_is_diag($got, $type, $expect);
}
else {
$self->_cmp_diag($got, $type, $expect);
}
}
return $ok;
}
And cmp_ok() is used as the final step of
- is_eq
- is_num()
- _is_diag()
- isnt_eq()
- isnt_num()
Same file as above. String eval between the thick marks:
sub _regex_ok {
my($self, $this, $regex, $cmp, $name) = @_;
my $ok = 0;
my $usable_regex = $self->maybe_regex($regex);
unless (defined $usable_regex) {
$ok = $self->ok( 0, $name );
$self->diag(" '$regex' doesn't look much like a regex to me
+.");
return $ok;
}
{
my $test;
my $code = $self->_caller_context;
local($@, $!, $SIG{__DIE__}); # isolate eval
# Yes, it has to look like this or 5.4.5 won't see the #line
# directive.
# Don't ask me, man, I just work here.
######################################################################
+######
$test = eval "
$code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
######################################################################
+######
$test = !$test if $cmp eq '!~';
local $Level = $Level + 1;
$ok = $self->ok( $test, $name );
}
unless( $ok ) {
$this = defined $this ? "'$this'" : 'undef';
my $match = $cmp eq '=~' ? "doesn't match" : "matches";
local $Level = $Level + 1;
$self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
%s
%13s '%s'
DIAGNOSTIC
}
return $ok;
}
And that function underlies the following api's:
- like()
- unlike()
Proof enough?
You want rude. This is what I really think of Test::*
Reimplementing a small subset of perl's native functionality--string/numeric comparisons and regex--, using a large, slow, verbose and complex hierarchy of OO code modules, in order to compare scalar variables against constants, when at the final step you are just going to use string eval and let Perl do those comparisons anyway, just so that you can convert the boolean results into a stream of 'ok's and 'not ok's.
And that, just so that you can tie up stdin & stderr in order to produce a set of useless statistic is, in a word, fascile(*).
(*)facile: arrived at without due care or effort; lacking depth;
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
|