summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Test/More.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Test/More.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Test/More.pm61
1 files changed, 52 insertions, 9 deletions
diff --git a/Master/tlpkg/tlperl/lib/Test/More.pm b/Master/tlpkg/tlperl/lib/Test/More.pm
index 67284874698..c1f5bf1d151 100644
--- a/Master/tlpkg/tlperl/lib/Test/More.pm
+++ b/Master/tlpkg/tlperl/lib/Test/More.pm
@@ -17,7 +17,7 @@ sub _carp {
return warn @_, " at $file line $line\n";
}
-our $VERSION = '0.94';
+our $VERSION = '0.98';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
use Test::Builder::Module;
@@ -317,6 +317,11 @@ are similar to these:
ok( ultimate_answer() eq 42, "Meaning of Life" );
ok( $foo ne '', "Got some foo" );
+C<undef> will only ever match C<undef>. So you can test a value
+agains C<undef> like this:
+
+ is($not_defined, undef, "undefined as expected");
+
(Mnemonic: "This is that." "This isn't that.")
So why use these? They produce better diagnostics on failure. ok()
@@ -716,9 +721,26 @@ considered a skip.
Returns true if the subtest passed, false otherwise.
+Due to how subtests work, you may omit a plan if you desire. This adds an
+implicit C<done_testing()> to the end of your subtest. The following two
+subtests are equivalent:
+
+ subtest 'subtest with implicit done_testing()', sub {
+ ok 1, 'subtests with an implicit done testing should work';
+ ok 1, '... and support more than one test';
+ ok 1, '... no matter how many tests are run';
+ };
+
+ subtest 'subtest with explicit done_testing()', sub {
+ ok 1, 'subtests with an explicit done testing should work';
+ ok 1, '... and support more than one test';
+ ok 1, '... no matter how many tests are run';
+ done_testing();
+ };
+
=cut
-sub subtest($&) {
+sub subtest {
my ($name, $subtests) = @_;
my $tb = Test::More->builder;
@@ -802,6 +824,11 @@ because the notion of "compile-time" is relative. Instead, you want:
BEGIN { use_ok('Some::Module') }
BEGIN { ...some code that depends on the use... }
+If you want the equivalent of C<use Foo ()>, use a module but not
+import anything, use C<require_ok>.
+
+ BEGIN { require_ok "Foo" }
+
=cut
@@ -880,7 +907,7 @@ sub require_ok ($) {
my $pack = caller;
- # Try to deterine if we've been given a module name or file.
+ # Try to determine if we've been given a module name or file.
# Module names must be barewords, files not.
$module = qq['$module'] unless _is_module_name($module);
@@ -1049,7 +1076,7 @@ sub _type {
return '' if !ref $thing;
- for my $type (qw(ARRAY HASH REF SCALAR GLOB CODE Regexp)) {
+ for my $type (qw(Regexp ARRAY HASH REF SCALAR GLOB CODE)) {
return $type if UNIVERSAL::isa( $thing, $type );
}
@@ -1330,7 +1357,7 @@ but want to put tests in your testing script (always a good idea).
BAIL_OUT($reason);
Indicates to the harness that things are going so badly all testing
-should terminate. This includes the running any additional test scripts.
+should terminate. This includes the running of any additional test scripts.
This is typically used when testing cannot continue such as a critical
module failing to compile or a necessary external utility not being
@@ -1403,6 +1430,8 @@ sub _eq_array {
my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
+ next if _equal_nonrefs($e1, $e2);
+
push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [ $e1, $e2 ] };
$ok = _deep_check( $e1, $e2 );
pop @Data_Stack if $ok;
@@ -1413,6 +1442,21 @@ sub _eq_array {
return $ok;
}
+sub _equal_nonrefs {
+ my( $e1, $e2 ) = @_;
+
+ return if ref $e1 or ref $e2;
+
+ if ( defined $e1 ) {
+ return 1 if defined $e2 and $e1 eq $e2;
+ }
+ else {
+ return 1 if !defined $e2;
+ }
+
+ return;
+}
+
sub _deep_check {
my( $e1, $e2 ) = @_;
my $tb = Test::More->builder;
@@ -1425,9 +1469,6 @@ sub _deep_check {
local %Refs_Seen = %Refs_Seen;
{
- # Quiet uninitialized value warnings when comparing undefs.
- no warnings 'uninitialized';
-
$tb->_unoverload_str( \$e1, \$e2 );
# Either they're both references or both not.
@@ -1438,7 +1479,7 @@ sub _deep_check {
$ok = 0;
}
elsif( !defined $e1 and !defined $e2 ) {
- # Shortcut if they're both defined.
+ # Shortcut if they're both undefined.
$ok = 1;
}
elsif( _dne($e1) xor _dne($e2) ) {
@@ -1535,6 +1576,8 @@ sub _eq_hash {
my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
+ next if _equal_nonrefs($e1, $e2);
+
push @Data_Stack, { type => 'HASH', idx => $k, vals => [ $e1, $e2 ] };
$ok = _deep_check( $e1, $e2 );
pop @Data_Stack if $ok;