summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Test
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Test')
-rw-r--r--Master/tlpkg/tlperl/lib/Test/Builder.pm130
-rw-r--r--Master/tlpkg/tlperl/lib/Test/Builder/Module.pm6
-rw-r--r--Master/tlpkg/tlperl/lib/Test/Builder/Tester.pm22
-rw-r--r--Master/tlpkg/tlperl/lib/Test/Builder/Tester/Color.pm2
-rw-r--r--Master/tlpkg/tlperl/lib/Test/Harness.pm44
-rw-r--r--Master/tlpkg/tlperl/lib/Test/More.pm61
-rw-r--r--Master/tlpkg/tlperl/lib/Test/Simple.pm4
7 files changed, 197 insertions, 72 deletions
diff --git a/Master/tlpkg/tlperl/lib/Test/Builder.pm b/Master/tlpkg/tlperl/lib/Test/Builder.pm
index 26ffea41ff4..cb4335f5ceb 100644
--- a/Master/tlpkg/tlperl/lib/Test/Builder.pm
+++ b/Master/tlpkg/tlperl/lib/Test/Builder.pm
@@ -4,7 +4,7 @@ use 5.006;
use strict;
use warnings;
-our $VERSION = '0.94';
+our $VERSION = '0.98';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
BEGIN {
@@ -23,7 +23,7 @@ BEGIN {
require threads::shared;
# Hack around YET ANOTHER threads::shared bug. It would
- # occassionally forget the contents of the variable when sharing it.
+ # occasionally forget the contents of the variable when sharing it.
# So we first copy the data, then share, then put our copy back.
*share = sub (\[$@%]) {
my $type = ref $_[0];
@@ -90,7 +90,7 @@ Test::Builder - Backend for building test libraries
=head1 DESCRIPTION
Test::Simple and Test::More have proven to be popular testing modules,
-but they're not always flexible enough. Test::Builder provides the a
+but they're not always flexible enough. Test::Builder provides a
building block upon which to write your own test libraries I<which can
work together>.
@@ -156,7 +156,7 @@ sub create {
$child->finalize;
Returns a new instance of C<Test::Builder>. Any output from this child will
-indented four spaces more than the parent's indentation. When done, the
+be indented four spaces more than the parent's indentation. When done, the
C<finalize> method I<must> be called explicitly.
Trying to create a new child with a previous child still active (i.e.,
@@ -174,18 +174,28 @@ sub child {
$self->croak("You already have a child named ($self->{Child_Name}) running");
}
+ my $parent_in_todo = $self->in_todo;
+
+ # Clear $TODO for the child.
+ my $orig_TODO = $self->find_TODO(undef, 1, undef);
+
my $child = bless {}, ref $self;
$child->reset;
# Add to our indentation
$child->_indent( $self->_indent . ' ' );
+
$child->{$_} = $self->{$_} foreach qw{Out_FH Todo_FH Fail_FH};
+ if ($parent_in_todo) {
+ $child->{Fail_FH} = $self->{Todo_FH};
+ }
# This will be reset in finalize. We do this here lest one child failure
# cause all children to fail.
$child->{Child_Error} = $?;
$? = 0;
$child->{Parent} = $self;
+ $child->{Parent_TODO} = $orig_TODO;
$child->{Name} = $name || "Child of " . $self->name;
$self->{Child_Name} = $child->name;
return $child;
@@ -210,25 +220,71 @@ sub subtest {
# Turn the child into the parent so anyone who has stored a copy of
# the Test::Builder singleton will get the child.
- my $child = $self->child($name);
- my %parent = %$self;
- %$self = %$child;
+ my($error, $child, %parent);
+ {
+ # child() calls reset() which sets $Level to 1, so we localize
+ # $Level first to limit the scope of the reset to the subtest.
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
- my $error;
- if( !eval { $subtests->(); 1 } ) {
- $error = $@;
+ $child = $self->child($name);
+ %parent = %$self;
+ %$self = %$child;
+
+ my $run_the_subtests = sub {
+ $subtests->();
+ $self->done_testing unless $self->_plan_handled;
+ 1;
+ };
+
+ if( !eval { $run_the_subtests->() } ) {
+ $error = $@;
+ }
}
# Restore the parent and the copied child.
%$child = %$self;
%$self = %parent;
+ # Restore the parent's $TODO
+ $self->find_TODO(undef, 1, $child->{Parent_TODO});
+
# Die *after* we restore the parent.
die $error if $error and !eval { $error->isa('Test::Builder::Exception') };
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
return $child->finalize;
}
+=begin _private
+
+=item B<_plan_handled>
+
+ if ( $Test->_plan_handled ) { ... }
+
+Returns true if the developer has explicitly handled the plan via:
+
+=over 4
+
+=item * Explicitly setting the number of tests
+
+=item * Setting 'no_plan'
+
+=item * Set 'skip_all'.
+
+=back
+
+This is currently used in subtests when we implicitly call C<< $Test->done_testing >>
+if the developer has not set a plan.
+
+=end _private
+
+=cut
+
+sub _plan_handled {
+ my $self = shift;
+ return $self->{Have_Plan} || $self->{No_Plan} || $self->{Skip_All};
+}
+
=item B<finalize>
@@ -256,11 +312,14 @@ sub finalize {
if( $self->{Child_Name} ) {
$self->croak("Can't call finalize() with child ($self->{Child_Name}) active");
}
+
+ local $? = 0; # don't fail if $subtests happened to set $? nonzero
$self->_ending;
# XXX This will only be necessary for TAP envelopes (we think)
#$self->_print( $self->is_passing ? "PASS\n" : "FAIL\n" );
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
my $ok = 1;
$self->parent->{Child_Name} = undef;
if ( $self->{Skip_All} ) {
@@ -315,7 +374,7 @@ sub name { shift->{Name} }
sub DESTROY {
my $self = shift;
- if ( $self->parent ) {
+ if ( $self->parent and $$ == $self->{Original_Pid} ) {
my $name = $self->name;
$self->diag(<<"FAIL");
Child ($name) exited without calling finalize()
@@ -350,6 +409,7 @@ sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
$self->{Have_Plan} = 0;
$self->{No_Plan} = 0;
$self->{Have_Output_Plan} = 0;
+ $self->{Done_Testing} = 0;
$self->{Original_Pid} = $$;
$self->{Child_Name} = undef;
@@ -458,7 +518,6 @@ sub _plan_tests {
return;
}
-
=item B<expected_tests>
my $max = $Test->expected_tests;
@@ -504,7 +563,6 @@ sub no_plan {
return 1;
}
-
=begin private
=item B<_output_plan>
@@ -543,6 +601,7 @@ sub _output_plan {
return;
}
+
=item B<done_testing>
$Test->done_testing();
@@ -866,6 +925,8 @@ sub _is_dualvar {
Like Test::More's C<is()>. Checks if C<$got eq $expected>. This is the
string version.
+C<undef> only ever matches another C<undef>.
+
=item B<is_num>
$Test->is_num($got, $expected, $name);
@@ -873,14 +934,14 @@ string version.
Like Test::More's C<is()>. Checks if C<$got == $expected>. This is the
numeric version.
+C<undef> only ever matches another C<undef>.
+
=cut
sub is_eq {
my( $self, $got, $expect, $name ) = @_;
local $Level = $Level + 1;
- $self->_unoverload_str( \$got, \$expect );
-
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
@@ -897,8 +958,6 @@ sub is_num {
my( $self, $got, $expect, $name ) = @_;
local $Level = $Level + 1;
- $self->_unoverload_num( \$got, \$expect );
-
if( !defined $got || !defined $expect ) {
# undef only matches undef and nothing else
my $test = !defined $got && !defined $expect;
@@ -1059,8 +1118,9 @@ sub cmp_ok {
my($pack, $file, $line) = $self->caller();
+ # This is so that warnings come out at the caller's level
$test = eval qq[
-#line 1 "cmp_ok [from $file line $line]"
+#line $line "(eval in cmp_ok) $file"
\$got $type \$expect;
];
$error = $@;
@@ -1685,17 +1745,18 @@ sub _print_to_fh {
return if $^C;
my $msg = join '', @msgs;
+ my $indent = $self->_indent;
local( $\, $", $, ) = ( undef, ' ', '' );
# Escape each line after the first with a # so we don't
# confuse Test::Harness.
- $msg =~ s{\n(?!\z)}{\n# }sg;
+ $msg =~ s{\n(?!\z)}{\n$indent# }sg;
# Stick a newline on the end if it needs it.
$msg .= "\n" unless $msg =~ /\n\z/;
- return print $fh $self->_indent, $msg;
+ return print $fh $indent, $msg;
}
=item B<output>
@@ -1825,8 +1886,8 @@ sub _open_testhandles {
open( $Testout, ">&STDOUT" ) or die "Can't dup STDOUT: $!";
open( $Testerr, ">&STDERR" ) or die "Can't dup STDERR: $!";
- # $self->_copy_io_layers( \*STDOUT, $Testout );
- # $self->_copy_io_layers( \*STDERR, $Testerr );
+ $self->_copy_io_layers( \*STDOUT, $Testout );
+ $self->_copy_io_layers( \*STDERR, $Testerr );
$self->{Opened_Testhandles} = 1;
@@ -1841,13 +1902,21 @@ sub _copy_io_layers {
require PerlIO;
my @src_layers = PerlIO::get_layers($src);
- binmode $dst, join " ", map ":$_", @src_layers if @src_layers;
+ _apply_layers($dst, @src_layers) if @src_layers;
}
);
return;
}
+sub _apply_layers {
+ my ($fh, @layers) = @_;
+ my %seen;
+ my @unique = grep { $_ ne 'unix' and !$seen{$_}++ } @layers;
+ binmode($fh, join(":", "", "raw", @unique));
+}
+
+
=item reset_outputs
$tb->reset_outputs;
@@ -2091,21 +2160,28 @@ sub todo {
=item B<find_TODO>
my $todo_reason = $Test->find_TODO();
- my $todo_reason = $Test->find_TODO($pack):
+ my $todo_reason = $Test->find_TODO($pack);
Like C<todo()> but only returns the value of C<$TODO> ignoring
C<todo_start()>.
+Can also be used to set C<$TODO> to a new value while returning the
+old value:
+
+ my $old_reason = $Test->find_TODO($pack, 1, $new_reason);
+
=cut
sub find_TODO {
- my( $self, $pack ) = @_;
+ my( $self, $pack, $set, $new_value ) = @_;
$pack = $pack || $self->caller(1) || $self->exported_to;
return unless $pack;
no strict 'refs'; ## no critic
- return ${ $pack . '::TODO' };
+ my $old_value = ${ $pack . '::TODO' };
+ $set and ${ $pack . '::TODO' } = $new_value;
+ return $old_value;
}
=item B<in_todo>
@@ -2458,7 +2534,7 @@ Test::Builder.
=head1 MEMORY
-An informative hash, accessable via C<<details()>>, is stored for each
+An informative hash, accessible via C<<details()>>, is stored for each
test you perform. So memory usage will scale linearly with each test
run. Although this is not a problem for most test suites, it can
become an issue if you do large (hundred thousands to million)
diff --git a/Master/tlpkg/tlperl/lib/Test/Builder/Module.pm b/Master/tlpkg/tlperl/lib/Test/Builder/Module.pm
index 4f7d1aa7db7..12a1e61bc2e 100644
--- a/Master/tlpkg/tlperl/lib/Test/Builder/Module.pm
+++ b/Master/tlpkg/tlperl/lib/Test/Builder/Module.pm
@@ -7,7 +7,7 @@ use Test::Builder;
require Exporter;
our @ISA = qw(Exporter);
-our $VERSION = '0.94';
+our $VERSION = '0.98';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
@@ -52,13 +52,13 @@ for you.
=head3 import
Test::Builder::Module provides an import() method which acts in the
-same basic way as Test::More's, setting the plan and controling
+same basic way as Test::More's, setting the plan and controlling
exporting of functions and variables. This allows your module to set
the plan independent of Test::More.
All arguments passed to import() are passed onto
C<< Your::Module->builder->plan() >> with the exception of
-C<import =>[qw(things to import)]>.
+C<< import =>[qw(things to import)] >>.
use Your::Module import => [qw(this that)], tests => 23;
diff --git a/Master/tlpkg/tlperl/lib/Test/Builder/Tester.pm b/Master/tlpkg/tlperl/lib/Test/Builder/Tester.pm
index 7bea6f99da6..793139f795f 100644
--- a/Master/tlpkg/tlperl/lib/Test/Builder/Tester.pm
+++ b/Master/tlpkg/tlperl/lib/Test/Builder/Tester.pm
@@ -1,7 +1,7 @@
package Test::Builder::Tester;
use strict;
-our $VERSION = "1.18";
+our $VERSION = "1.22";
use Test::Builder;
use Symbol;
@@ -124,13 +124,13 @@ sub _start_testing {
# switch out to our own handles
$t->output($output_handle);
$t->failure_output($error_handle);
- $t->todo_output($error_handle);
+ $t->todo_output($output_handle);
# clear the expected list
$out->reset();
$err->reset();
- # remeber that we're testing
+ # remember that we're testing
$testing = 1;
$testing_num = $t->current_test;
$t->current_test(0);
@@ -165,8 +165,8 @@ which is even the same as
test_out("ok 2");
Once C<test_out> or C<test_err> (or C<test_fail> or C<test_diag>) have
-been called once all further output from B<Test::Builder> will be
-captured by B<Test::Builder::Tester>. This means that your will not
+been called, all further output from B<Test::Builder> will be
+captured by B<Test::Builder::Tester>. This means that you will not
be able perform further tests to the normal output in the normal way
until you call C<test_test> (well, unless you manually meddle with the
output filehandles)
@@ -191,7 +191,7 @@ sub test_err {
Because the standard failure message that B<Test::Builder> produces
whenever a test fails will be a common occurrence in your test error
-output, and because has changed between Test::Builder versions, rather
+output, and because it has changed between Test::Builder versions, rather
than forcing you to call C<test_err> with the string all the time like
so
@@ -229,7 +229,7 @@ sub test_fail {
As most of the remaining expected output to the error stream will be
created by Test::Builder's C<diag> function, B<Test::Builder::Tester>
-provides a convience function C<test_diag> that you can use instead of
+provides a convenience function C<test_diag> that you can use instead of
C<test_err>.
The C<test_diag> function prepends comment hashes and spacing to the
@@ -293,7 +293,7 @@ declared with C<test_err>.
=back
-As a convience, if only one argument is passed then this argument
+As a convenience, if only one argument is passed then this argument
is assumed to be the name of the test (as in the above examples.)
Once C<test_test> has been run test output will be redirected back to
@@ -304,7 +304,7 @@ will function normally and cause success/errors for B<Test::Harness>.
=cut
sub test_test {
- # decode the arguements as described in the pod
+ # decode the arguments as described in the pod
my $mess;
my %args;
if( @_ == 1 ) {
@@ -370,7 +370,7 @@ sub line_num {
=back
-In addition to the six exported functions there there exists one
+In addition to the six exported functions there exists one
function that can only be accessed with a fully qualified function
call.
@@ -389,7 +389,7 @@ fail even though the output looks similar.
To assist you C<test_test> can colour the background of the debug
information to disambiguate the different types of output. The debug
-output will have it's background coloured green and red. The green
+output will have its background coloured green and red. The green
part represents the text which is the same between the executed and
actual output, the red shows which part differs.
diff --git a/Master/tlpkg/tlperl/lib/Test/Builder/Tester/Color.pm b/Master/tlpkg/tlperl/lib/Test/Builder/Tester/Color.pm
index 264fddbfd86..9fb6cf15a8d 100644
--- a/Master/tlpkg/tlperl/lib/Test/Builder/Tester/Color.pm
+++ b/Master/tlpkg/tlperl/lib/Test/Builder/Tester/Color.pm
@@ -1,7 +1,7 @@
package Test::Builder::Tester::Color;
use strict;
-our $VERSION = "1.18";
+our $VERSION = "1.22";
require Test::Builder::Tester;
diff --git a/Master/tlpkg/tlperl/lib/Test/Harness.pm b/Master/tlpkg/tlperl/lib/Test/Harness.pm
index eba3c5efc4a..53bc92a741c 100644
--- a/Master/tlpkg/tlperl/lib/Test/Harness.pm
+++ b/Master/tlpkg/tlperl/lib/Test/Harness.pm
@@ -7,9 +7,10 @@ use strict;
use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
use constant IS_VMS => ( $^O eq 'VMS' );
-use TAP::Harness ();
-use TAP::Parser::Aggregator ();
-use TAP::Parser::Source::Perl ();
+use TAP::Harness ();
+use TAP::Parser::Aggregator ();
+use TAP::Parser::Source ();
+use TAP::Parser::SourceHandler::Perl ();
use TAP::Parser::Utils qw( split_shell );
@@ -27,6 +28,7 @@ use vars qw(
$Directives
$Timer
$Strap
+ $HarnessSubclass
$has_time_hires
$IgnoreExit
);
@@ -44,11 +46,11 @@ Test::Harness - Run Perl standard test scripts with statistics
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
# Backwards compatibility for exportable variable names.
*verbose = *Verbose;
@@ -118,8 +120,8 @@ one of the messages in the DIAGNOSTICS section.
sub _has_taint {
my $test = shift;
- return TAP::Parser::Source::Perl->get_taint(
- TAP::Parser::Source::Perl->shebang($test) );
+ return TAP::Parser::SourceHandler::Perl->get_taint(
+ TAP::Parser::Source->shebang($test) );
}
sub _aggregate {
@@ -132,7 +134,7 @@ sub _aggregate {
_aggregate_tests( $harness, $aggregate, @tests );
}
-# Make sure the child seens all the extra junk in @INC
+# Make sure the child sees all the extra junk in @INC
sub _apply_extra_INC {
my $harness = shift;
@@ -250,7 +252,8 @@ sub _new_harness {
}
}
- return TAP::Harness->new($args);
+ my $class = $ENV{HARNESS_SUBCLASS} || 'TAP::Harness';
+ return TAP::Harness->_construct( $class, $args );
}
# Get the parts of @INC which are changed from the stock list AND
@@ -268,7 +271,7 @@ sub _filtered_inc {
elsif (IS_WIN32) {
# Lose any trailing backslashes in the Win32 paths
- s/[\\\/]+$// foreach @inc;
+ s/[\\\/]+$// for @inc;
}
my @default_inc = _default_inc();
@@ -305,7 +308,7 @@ sub _filtered_inc {
my $perl = $ENV{HARNESS_PERL} || $^X;
# Avoid using -l for the benefit of Perl 6
- chomp( @inc = `$perl -e "print join qq[\\n], \@INC, q[]"` );
+ chomp( @inc = `"$perl" -e "print join qq[\\n], \@INC, q[]"` );
return @inc;
}
}
@@ -528,15 +531,19 @@ Provide additional options to the harness. Currently supported options are:
Run <n> (default 9) parallel jobs.
-=item C<< f >>
+=item C<< c >>
-Use forked parallelism.
+Try to color output. See L<TAP::Formatter::Base/"new">.
=back
Multiple options may be separated by colons:
- HARNESS_OPTIONS=j9:f make test
+ HARNESS_OPTIONS=j9:c make test
+
+=item C<HARNESS_SUBCLASS>
+
+Specifies a TAP::Harness subclass to be used in place of TAP::Harness.
=back
@@ -546,10 +553,9 @@ Normally when a Perl program is run in taint mode the contents of the
C<PERL5LIB> environment variable do not appear in C<@INC>.
Because C<PERL5LIB> is often used during testing to add build
-directories to C<@INC> C<Test::Harness> (actually
-L<TAP::Parser::Source::Perl>) passes the names of any directories found
-in C<PERL5LIB> as -I switches. The net effect of this is that
-C<PERL5LIB> is honoured even in taint mode.
+directories to C<@INC> C<Test::Harness> passes the names of any
+directories found in C<PERL5LIB> as -I switches. The net effect of this
+is that C<PERL5LIB> is honoured even in taint mode.
=head1 SEE ALSO
@@ -578,7 +584,7 @@ module is based) has this attribution:
=head1 LICENCE AND COPYRIGHT
-Copyright (c) 2007-2008, Andy Armstrong C<< <andy@hexten.net> >>. All rights reserved.
+Copyright (c) 2007-2011, Andy Armstrong C<< <andy@hexten.net> >>. All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.
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;
diff --git a/Master/tlpkg/tlperl/lib/Test/Simple.pm b/Master/tlpkg/tlperl/lib/Test/Simple.pm
index 9c8716759a4..1a85d36e3e7 100644
--- a/Master/tlpkg/tlperl/lib/Test/Simple.pm
+++ b/Master/tlpkg/tlperl/lib/Test/Simple.pm
@@ -4,7 +4,7 @@ use 5.006;
use strict;
-our $VERSION = '0.94';
+our $VERSION = '0.98';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
use Test::Builder::Module;
@@ -121,7 +121,7 @@ Here's an example of a simple .t file for the fictional Film module.
Rating => 'R',
NumExplodingSheep => 1
});
- ok( defined($btaste) && ref $btaste eq 'Film, 'new() works' );
+ ok( defined($btaste) && ref $btaste eq 'Film', 'new() works' );
ok( $btaste->Title eq 'Bad Taste', 'Title() get' );
ok( $btaste->Director eq 'Peter Jackson', 'Director() get' );