summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Test/Builder/Tester.pm
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2018-03-08 00:16:42 +0000
committerKarl Berry <karl@freefriends.org>2018-03-08 00:16:42 +0000
commit34a8597760ab5740abd49b6d8be10e1876f5ce98 (patch)
tree099a794912a28b3ebbc857961643ba29b28e674a /Master/tlpkg/tlperl/lib/Test/Builder/Tester.pm
parent2ca3610031316a7312d046d3ae4c783452831216 (diff)
(tl)perl 5.26.1 from siep
git-svn-id: svn://tug.org/texlive/trunk@46882 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Test/Builder/Tester.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Test/Builder/Tester.pm69
1 files changed, 62 insertions, 7 deletions
diff --git a/Master/tlpkg/tlperl/lib/Test/Builder/Tester.pm b/Master/tlpkg/tlperl/lib/Test/Builder/Tester.pm
index b0554b89aca..647ea2d3710 100644
--- a/Master/tlpkg/tlperl/lib/Test/Builder/Tester.pm
+++ b/Master/tlpkg/tlperl/lib/Test/Builder/Tester.pm
@@ -1,9 +1,9 @@
package Test::Builder::Tester;
use strict;
-our $VERSION = "1.28";
+our $VERSION = '1.302073';
-use Test::Builder 0.99;
+use Test::Builder;
use Symbol;
use Carp;
@@ -104,16 +104,26 @@ my $original_is_passing;
my $original_output_handle;
my $original_failure_handle;
my $original_todo_handle;
+my $original_formatter;
my $original_harness_env;
# function that starts testing and redirects the filehandles for now
sub _start_testing {
+ # Hack for things that conditioned on Test-Stream being loaded
+ $INC{'Test/Stream.pm'} ||= 'fake' if $INC{'Test/Moose/More.pm'};
# even if we're running under Test::Harness pretend we're not
# for now. This needed so Test::Builder doesn't add extra spaces
$original_harness_env = $ENV{HARNESS_ACTIVE} || 0;
$ENV{HARNESS_ACTIVE} = 0;
+ my $hub = $t->{Hub} || Test2::API::test2_stack->top;
+ $original_formatter = $hub->format;
+ unless ($original_formatter && $original_formatter->isa('Test::Builder::Formatter')) {
+ my $fmt = Test::Builder::Formatter->new;
+ $hub->format($fmt);
+ }
+
# remember what the handles were set to
$original_output_handle = $t->output();
$original_failure_handle = $t->failure_output();
@@ -304,6 +314,8 @@ will function normally and cause success/errors for L<Test::Harness>.
=cut
sub test_test {
+ # END the hack
+ delete $INC{'Test/Stream.pm'} if $INC{'Test/Stream.pm'} && $INC{'Test/Stream.pm'} eq 'fake';
# decode the arguments as described in the pod
my $mess;
my %args;
@@ -321,6 +333,10 @@ sub test_test {
croak "Not testing. You must declare output with a test function first."
unless $testing;
+
+ my $hub = $t->{Hub} || Test2::API::test2_stack->top;
+ $hub->format($original_formatter);
+
# okay, reconnect the test suite back to the saved handles
$t->output($original_output_handle);
$t->failure_output($original_failure_handle);
@@ -420,17 +436,26 @@ sub color {
=head1 BUGS
+Test::Builder::Tester does not handle plans well. It has never done anything
+special with plans. This means that plans from outside Test::Builder::Tester
+will effect Test::Builder::Tester, worse plans when using Test::Builder::Tester
+will effect overall testing. At this point there are no plans to fix this bug
+as people have come to depend on it, and Test::Builder::Tester is now
+discouraged in favor of C<Test2::API::intercept()>. See
+L<https://github.com/Test-More/test-more/issues/667>
+
Calls C<< Test::Builder->no_ending >> turning off the ending tests.
This is needed as otherwise it will trip out because we've run more
tests than we strictly should have and it'll register any failures we
had that we were testing for as real failures.
The color function doesn't work unless L<Term::ANSIColor> is
-compatible with your terminal.
+compatible with your terminal. Additionally, L<Win32::Console::ANSI>
+must be installed on windows platforms for color output.
Bugs (and requests for new features) can be reported to the author
-though the CPAN RT system:
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Builder-Tester>
+though GitHub:
+L<https://github.com/Test-More/test-more/issues>
=head1 AUTHOR
@@ -487,8 +512,9 @@ sub expect {
sub _account_for_subtest {
my( $self, $check ) = @_;
- # Since we ship with Test::Builder, calling a private method is safe...ish.
- return ref($check) ? $check : $t->_indent . $check;
+ my $hub = $t->{Stack}->top;
+ my $nesting = $hub->isa('Test2::Hub::Subtest') ? $hub->nested : 0;
+ return ref($check) ? $check : (' ' x $nesting) . $check;
}
sub _translate_Failed_check {
@@ -535,6 +561,8 @@ sub complaint {
# get color
eval { require Term::ANSIColor };
unless($@) {
+ eval { require Win32::Console::ANSI } if 'MSWin32' eq $^O; # support color on windows platforms
+
# colours
my $green = Term::ANSIColor::color("black") . Term::ANSIColor::color("on_green");
@@ -563,6 +591,33 @@ sub complaint {
}
}
+ my @got = split "\n", $got;
+ my @wanted = split "\n", $wanted;
+
+ $got = "";
+ $wanted = "";
+
+ while (@got || @wanted) {
+ my $g = shift @got || "";
+ my $w = shift @wanted || "";
+ if ($g ne $w) {
+ if($g =~ s/(\s+)$/ |> /g) {
+ $g .= ($_ eq ' ' ? '_' : '\t') for split '', $1;
+ }
+ if($w =~ s/(\s+)$/ |> /g) {
+ $w .= ($_ eq ' ' ? '_' : '\t') for split '', $1;
+ }
+ $g = "> $g";
+ $w = "> $w";
+ }
+ else {
+ $g = " $g";
+ $w = " $w";
+ }
+ $got = $got ? "$got\n$g" : $g;
+ $wanted = $wanted ? "$wanted\n$w" : $w;
+ }
+
return "$type is:\n" . "$got\nnot:\n$wanted\nas expected";
}