package Test::Builder::Tester;
use strict;
-our $VERSION = '1.301001_040';
-$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
+our $VERSION = '1.302059';
-use Test::Builder 1.301001;
+use Test::Builder;
use Symbol;
use Carp;
=head1 NAME
-Test::Builder::Tester - *DEPRECATED* test testsuites that have been built with
+Test::Builder::Tester - test testsuites that have been built with
Test::Builder
-=head1 DEPRECATED
-
-B<This module is deprecated.> Please see L<Test::Tester2> for a
-better alternative that does not involve dealing with TAP/string output.
-
=head1 SYNOPSIS
use Test::Builder::Tester tests => 1;
# set up testing
####
-#my $t = Test::Builder->new;
+my $t = Test::Builder->new;
###
# make us an exporter
###
-use Test::Builder::Provider;
+use Exporter;
+our @ISA = qw(Exporter);
-provides qw(test_out test_err test_fail test_diag test_test line_num);
+our @EXPORT = qw(test_out test_err test_fail test_diag test_test line_num);
-sub before_import {
+sub import {
my $class = shift;
- my ($args) = @_;
+ my(@plan) = @_;
my $caller = caller;
- warn __PACKAGE__ . " is deprecated!\n" if builder()->modern;
-
- builder()->exported_to($caller);
- builder()->plan(@$args);
+ $t->exported_to($caller);
+ $t->plan(@plan);
my @imports = ();
- foreach my $idx ( 0 .. @$args ) {
- if( $args->[$idx] && $args->[$idx] eq 'import' ) {
- @imports = @{ $args->[ $idx + 1 ] };
+ foreach my $idx ( 0 .. $#plan ) {
+ if( $plan[$idx] eq 'import' ) {
+ @imports = @{ $plan[ $idx + 1 ] };
last;
}
}
- @$args = @imports;
+ __PACKAGE__->export_to_level( 1, __PACKAGE__, @imports );
}
###
my $testing_num;
my $original_is_passing;
-my $original_stream;
-
# remembering where the file handles were originally connected
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 = builder()->output();
- $original_failure_handle = builder()->failure_output();
- $original_todo_handle = builder()->todo_output();
+ $original_output_handle = $t->output();
+ $original_failure_handle = $t->failure_output();
+ $original_todo_handle = $t->todo_output();
# switch out to our own handles
- builder()->output($output_handle);
- builder()->failure_output($error_handle);
- builder()->todo_output($output_handle);
+ $t->output($output_handle);
+ $t->failure_output($error_handle);
+ $t->todo_output($output_handle);
# clear the expected list
$out->reset();
# remember that we're testing
$testing = 1;
- $testing_num = builder()->current_test;
- builder()->current_test(0);
- $original_is_passing = builder()->is_passing;
- builder()->is_passing(1);
+ $testing_num = $t->current_test;
+ $t->current_test(0);
+ $original_is_passing = $t->is_passing;
+ $t->is_passing(1);
# look, we shouldn't do the ending stuff
- builder()->no_ending(1);
+ $t->no_ending(1);
}
=head2 Functions
# expect the same thing, but prepended with "# "
local $_;
- $err->expect( map { m/\S/ ? "# $_" : "" } @_ );
+ $err->expect( map { "# $_" } @_ );
}
=item test_test
=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;
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
- builder()->output($original_output_handle);
- builder()->failure_output($original_failure_handle);
- builder()->todo_output($original_todo_handle);
+ $t->output($original_output_handle);
+ $t->failure_output($original_failure_handle);
+ $t->todo_output($original_todo_handle);
# restore the test no, etc, back to the original point
- builder()->current_test($testing_num);
+ $t->current_test($testing_num);
$testing = 0;
- builder()->is_passing($original_is_passing);
+ $t->is_passing($original_is_passing);
# re-enable the original setting of the harness
$ENV{HARNESS_ACTIVE} = $original_harness_env;
# check the output we've stashed
- unless( builder()->ok( ( $args{skip_out} || $out->check ) &&
- ( $args{skip_err} || $err->check ), $mess )
+ unless( $t->ok( ( $args{skip_out} || $out->check ) &&
+ ( $args{skip_err} || $err->check ), $mess )
)
{
# print out the diagnostic information about why this
local $_;
- builder()->diag( map { "$_\n" } $out->complaint )
+ $t->diag( map { "$_\n" } $out->complaint )
unless $args{skip_out} || $out->check;
- builder()->diag( map { "$_\n" } $err->complaint )
+ $t->diag( map { "$_\n" } $err->complaint )
unless $args{skip_err} || $err->check;
}
}
=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
sub _account_for_subtest {
my( $self, $check ) = @_;
- my $builder = Test::Builder::Tester->builder();
- # Since we ship with Test::Builder, calling a private method is safe...ish.
- return ref($check) ? $check : ($builder->depth ? ' ' x $builder->depth : '') . $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 {
# 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");
}
}
+ 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";
}
https://perl5.git.perl.org / perl5.git / blobdiff