require Exporter;
use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.53';
+$VERSION = '0.60';
$VERSION = eval $VERSION; # make the alpha version come out as a number
@ISA = qw(Exporter);
pass($test_name);
fail($test_name);
- # Utility comparison functions.
- eq_array(\@this, \@that);
- eq_hash(\%this, \%that);
- eq_set(\@this, \@that);
-
# UNIMPLEMENTED!!!
my @status = Test::More::status;
diag(@diagnostic_message);
Prints a diagnostic message which is guaranteed not to interfere with
-test output. Like C<print> @diagnostic_message is simply concatinated
+test output. Like C<print> @diagnostic_message is simply concatenated
together.
Handy for this sort of thing:
# End with an alphanumeric.
# The rest is an alphanumeric or ::
$module =~ s/\b::\b//g;
- $module =~ /^[a-zA-Z]\w+$/;
+ $module =~ /^[a-zA-Z]\w*$/;
}
=back
If the user does not have HTML::Lint installed, the whole block of
code I<won't be run at all>. Test::More will output special ok's
which Test::Harness interprets as skipped, but passing, tests.
+
It's important that $how_many accurately reflects the number of tests
in the SKIP block so the # of tests run will match up with your plan.
+If your plan is C<no_plan> $how_many is optional and will default to 1.
It's perfectly safe to nest SKIP blocks. Each SKIP block must have
the label C<SKIP>, or Test::More can't work its magic.
unless( defined $how_many ) {
# $how_many can only be avoided when no_plan is in use.
_carp "skip() needs to know \$how_many tests are in the block"
- unless $Test::Builder::No_Plan;
+ unless $Test->has_plan eq 'no_plan';
$how_many = 1;
}
unless( defined $how_many ) {
# $how_many can only be avoided when no_plan is in use.
_carp "todo_skip() needs to know \$how_many tests are in the block"
- unless $Test::Builder::No_Plan;
+ unless $Test->has_plan eq 'no_plan';
$how_many = 1;
}
=back
-=head2 Comparison functions
+=head2 Complex data structures
Not everything is a simple eq check or regex. There are times you
-need to see if two arrays are equivalent, for instance. For these
-instances, Test::More provides a handful of useful functions.
+need to see if two data structures are equivalent. For these
+instances Test::More provides a handful of useful functions.
B<NOTE> I'm not quite sure what will happen with filehandles.
chop $msg; # clip off newline so carp() will put in line/file
_carp sprintf $msg, scalar @_;
+
+ return $Test->ok(0);
}
my($this, $that, $name) = @_;
my $ok;
- if( !ref $this xor !ref $that ) { # one's a reference, one isn't
- $ok = 0;
- }
- if( !ref $this and !ref $that ) {
+ if( !ref $this and !ref $that ) { # neither is a reference
$ok = $Test->is_eq($this, $that, $name);
}
- else {
+ elsif( !ref $this xor !ref $that ) { # one's a reference, one isn't
+ $ok = $Test->ok(0, $name);
+ $Test->diag( _format_stack({ vals => [ $this, $that ] }) );
+ }
+ else { # both references
local @Data_Stack = ();
- local %Refs_Seen = ();
if( _deep_check($this, $that) ) {
$ok = $Test->ok(1, $name);
}
else {
$ok = $Test->ok(0, $name);
- $ok = $Test->diag(_format_stack(@Data_Stack));
+ $Test->diag(_format_stack(@Data_Stack));
}
}
my $out = "Structures begin differing at:\n";
foreach my $idx (0..$#vals) {
my $val = $vals[$idx];
- $vals[$idx] = !defined $val ? 'undef' :
- $val eq $DNE ? "Does not exist"
- : "'$val'";
+ $vals[$idx] = !defined $val ? 'undef' :
+ $val eq $DNE ? "Does not exist" :
+ ref $val ? "$val" :
+ "'$val'";
}
$out .= "$vars[0] = $vals[0]\n";
}
+sub _type {
+ my $thing = shift;
+
+ return '' if !ref $thing;
+
+ for my $type (qw(ARRAY HASH REF SCALAR GLOB Regexp)) {
+ return $type if UNIVERSAL::isa($thing, $type);
+ }
+
+ return '';
+}
+
+
+=head2 Discouraged comparison functions
+
+The use of the following functions is discouraged as they are not
+actually testing functions and produce no diagnostics to help figure
+out what went wrong. They were written before is_deeply() existed
+because I couldn't figure out how to display a useful diff of two
+arbitrary data structures.
+
+These functions are usually used inside an ok().
+
+ ok( eq_array(\@this, \@that) );
+
+C<is_deeply()> can do that better and with diagnostics.
+
+ is_deeply( \@this, \@that );
+
+They may be deprecated in future versions.
+
+
=item B<eq_array>
- eq_array(\@this, \@that);
+ my $is_eq = eq_array(\@this, \@that);
Checks if two arrays are equivalent. This is a deep check, so
multi-level structures are handled correctly.
#'#
sub eq_array {
local @Data_Stack;
- local %Refs_Seen;
- _eq_array(@_);
+ _deep_check(@_);
}
sub _eq_array {
my($a1, $a2) = @_;
- if( grep !UNIVERSAL::isa($_, 'ARRAY'), $a1, $a2 ) {
+ if( grep !_type($_) eq 'ARRAY', $a1, $a2 ) {
warn "eq_array passed a non-array ref";
return 0;
}
return 1 if $a1 eq $a2;
- if($Refs_Seen{$a1}) {
- return $Refs_Seen{$a1} eq $a2;
- }
- else {
- $Refs_Seen{$a1} = "$a2";
- }
-
my $ok = 1;
my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
for (0..$max) {
my($e1, $e2) = @_;
my $ok = 0;
+ # Effectively turn %Refs_Seen into a stack. This avoids picking up
+ # the same referenced used twice (such as [\$a, \$a]) to be considered
+ # circular.
+ local %Refs_Seen = %Refs_Seen;
+
{
# Quiet uninitialized value warnings when comparing undefs.
local $^W = 0;
# Either they're both references or both not.
my $same_ref = !(!ref $e1 xor !ref $e2);
+ my $not_ref = (!ref $e1 and !ref $e2);
if( defined $e1 xor defined $e2 ) {
$ok = 0;
elsif ( $same_ref and ($e1 eq $e2) ) {
$ok = 1;
}
+ elsif ( $not_ref ) {
+ push @Data_Stack, { type => '', vals => [$e1, $e2] };
+ $ok = 0;
+ }
else {
- if( UNIVERSAL::isa($e1, 'ARRAY') and
- UNIVERSAL::isa($e2, 'ARRAY') )
- {
+ if( $Refs_Seen{$e1} ) {
+ return $Refs_Seen{$e1} eq $e2;
+ }
+ else {
+ $Refs_Seen{$e1} = "$e2";
+ }
+
+ my $type = _type($e1);
+ $type = 'DIFFERENT' unless _type($e2) eq $type;
+
+ if( $type eq 'DIFFERENT' ) {
+ push @Data_Stack, { type => $type, vals => [$e1, $e2] };
+ $ok = 0;
+ }
+ elsif( $type eq 'ARRAY' ) {
$ok = _eq_array($e1, $e2);
}
- elsif( UNIVERSAL::isa($e1, 'HASH') and
- UNIVERSAL::isa($e2, 'HASH') )
- {
+ elsif( $type eq 'HASH' ) {
$ok = _eq_hash($e1, $e2);
}
- elsif( UNIVERSAL::isa($e1, 'REF') and
- UNIVERSAL::isa($e2, 'REF') )
- {
- push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
+ elsif( $type eq 'REF' ) {
+ push @Data_Stack, { type => $type, vals => [$e1, $e2] };
$ok = _deep_check($$e1, $$e2);
pop @Data_Stack if $ok;
}
- elsif( UNIVERSAL::isa($e1, 'SCALAR') and
- UNIVERSAL::isa($e2, 'SCALAR') )
- {
+ elsif( $type eq 'SCALAR' ) {
push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
$ok = _deep_check($$e1, $$e2);
pop @Data_Stack if $ok;
}
- else {
- push @Data_Stack, { vals => [$e1, $e2] };
- $ok = 0;
- }
+ else {
+ _whoa(1, "No type in _deep_check");
+ }
}
}
}
+sub _whoa {
+ my($check, $desc) = @_;
+ if( $check ) {
+ die <<WHOA;
+WHOA! $desc
+This should never happen! Please contact the author immediately!
+WHOA
+ }
+}
+
+
=item B<eq_hash>
- eq_hash(\%this, \%that);
+ my $is_eq = eq_hash(\%this, \%that);
Determines if the two hashes contain the same keys and values. This
is a deep check.
sub eq_hash {
local @Data_Stack;
- local %Refs_Seen;
- return _eq_hash(@_);
+ return _deep_check(@_);
}
sub _eq_hash {
my($a1, $a2) = @_;
- if( grep !UNIVERSAL::isa($_, 'HASH'), $a1, $a2 ) {
+ if( grep !_type($_) eq 'HASH', $a1, $a2 ) {
warn "eq_hash passed a non-hash ref";
return 0;
}
return 1 if $a1 eq $a2;
- if( $Refs_Seen{$a1} ) {
- return $Refs_Seen{$a1} eq $a2;
- }
- else {
- $Refs_Seen{$a1} = "$a2";
- }
-
my $ok = 1;
my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
foreach my $k (keys %$bigger) {
=item B<eq_set>
- eq_set(\@this, \@that);
+ my $is_eq = eq_set(\@this, \@that);
Similar to eq_array(), except the order of the elements is B<not>
important. This is a deep check, but the irrelevancy of order only
applies to the top level.
-B<NOTE> By historical accident, this is not a true set comparision.
+ ok( eq_set(\@this, \@that) );
+
+Is better written:
+
+ is_deeply( [sort @this], [sort @that] );
+
+B<NOTE> By historical accident, this is not a true set comparison.
While the order of elements does not matter, duplicate elements do.
+Test::Deep contains much better set comparison functions.
+
=cut
sub eq_set {
If you fail more than 254 tests, it will be reported as 254.
+B<NOTE> This behavior may go away in future versions.
+
=head1 CAVEATS and NOTES
projects / p5sagit/p5-mst-13.2.git / blobdiff