package Test::Builder::Tester;
use strict;
-our $VERSION = '1.301001_097';
-$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
+our $VERSION = '1.302059';
-use Test::Stream 1.301001 '-internal';
-use Test::Builder 1.301001;
+use Test::Builder;
use Symbol;
-use Test::Stream::Carp qw/croak/;
+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::Stream::Tester> 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::Stream::Toolset;
-use Test::Stream::Exporter;
-default_exports qw/test_out test_err test_fail test_diag test_test line_num/;
-Test::Stream::Exporter->cleanup;
+use Exporter;
+our @ISA = qw(Exporter);
+
+our @EXPORT = qw(test_out test_err test_fail test_diag test_test line_num);
-sub before_import {
+sub import {
my $class = shift;
- my ($importer, $list) = @_;
+ my(@plan) = @_;
- my $meta = init_tester($importer);
- my $context = context(1);
- my $other = [];
- my $idx = 0;
+ my $caller = caller;
- while ($idx <= $#{$list}) {
- my $item = $list->[$idx++];
- next unless $item;
+ $t->exported_to($caller);
+ $t->plan(@plan);
- if (defined $item and $item eq 'no_diag') {
- Test::Stream->shared->set_no_diag(1);
- }
- elsif ($item eq 'tests') {
- $context->plan($list->[$idx++]);
- }
- elsif ($item eq 'skip_all') {
- $context->plan(0, 'SKIP', $list->[$idx++]);
- }
- elsif ($item eq 'no_plan') {
- $context->plan(0, 'NO PLAN');
- }
- elsif ($item eq 'import') {
- push @$other => @{$list->[$idx++]};
+ my @imports = ();
+ foreach my $idx ( 0 .. $#plan ) {
+ if( $plan[$idx] eq 'import' ) {
+ @imports = @{ $plan[ $idx + 1 ] };
+ last;
}
}
- @$list = @$other;
-
- return;
+ __PACKAGE__->export_to_level( 1, __PACKAGE__, @imports );
}
-
-sub builder { Test::Builder->new }
-
###
# set up file handles
###
my $testing_num;
my $original_is_passing;
-my $original_stream;
-my $original_state;
-
# 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;
- $original_stream = builder->{stream} || Test::Stream->shared;
- $original_state = [@{$original_stream->state->[-1]}];
+ 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
=cut
sub test_out {
- my $ctx = context;
# do we need to do any setup?
_start_testing() unless $testing;
}
sub test_err {
- my $ctx = context;
# do we need to do any setup?
_start_testing() unless $testing;
=cut
sub test_fail {
- my $ctx = context;
# do we need to do any setup?
_start_testing() unless $testing;
=cut
sub test_diag {
- my $ctx = context;
# do we need to do any setup?
_start_testing() unless $testing;
# expect the same thing, but prepended with "# "
local $_;
- $err->expect( map { m/\S/ ? "# $_" : "" } @_ );
+ $err->expect( map { "# $_" } @_ );
}
=item test_test
=cut
sub test_test {
- my $ctx = context;
+ # 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;
- @{$original_stream->state->[-1]} = @$original_state;
-
# 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;
}
}
=back
-=head1 NOTES
-
-Thanks to Richard Clamp E<lt>richardc@unixbeard.netE<gt> for letting
-me use his testing system to try this module out on.
-
-=head1 SEE ALSO
+=head1 BUGS
-L<Test::Builder>, L<Test::Builder::Tester::Color>, L<Test::More>.
+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>
-=encoding utf8
+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.
-=head1 SOURCE
+The color function doesn't work unless L<Term::ANSIColor> is
+compatible with your terminal. Additionally, L<Win32::Console::ANSI>
+must be installed on windows platforms for color output.
-The source code repository for Test::More can be found at
-F<http://github.com/Test-More/test-more/>.
+Bugs (and requests for new features) can be reported to the author
+though GitHub:
+L<https://github.com/Test-More/test-more/issues>
-=head1 MAINTAINER
+=head1 AUTHOR
-=over 4
-
-=item Chad Granum E<lt>exodist@cpan.orgE<gt>
+Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
-=back
+Some code taken from L<Test::More> and L<Test::Catch>, written by
+Michael G Schwern E<lt>schwern@pobox.comE<gt>. Hence, those parts
+Copyright Micheal G Schwern 2001. Used and distributed with
+permission.
-=head1 AUTHORS
+This program is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
-The following people have all contributed to the Test-More dist (sorted using
-VIM's sort function).
+=head1 MAINTAINERS
=over 4
=item Chad Granum E<lt>exodist@cpan.orgE<gt>
-=item Fergal Daly E<lt>fergal@esatclear.ie>E<gt>
-
-=item Mark Fowler E<lt>mark@twoshortplanks.comE<gt>
-
-=item Michael G Schwern E<lt>schwern@pobox.comE<gt>
-
-=item 唐鳳
-
=back
-=head1 COPYRIGHT
-
-There has been a lot of code migration between modules,
-here are all the original copyrights together:
-
-=over 4
-
-=item Test::Stream
-
-=item Test::Stream::Tester
-
-Copyright 2014 Chad Granum E<lt>exodist7@gmail.comE<gt>.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
-=item Test::Simple
-
-=item Test::More
-
-=item Test::Builder
-
-Originally authored by Michael G Schwern E<lt>schwern@pobox.comE<gt> with much
-inspiration from Joshua Pritikin's Test module and lots of help from Barrie
-Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa
-gang.
-
-Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
-E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
-
-Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-See F<http://www.perl.com/perl/misc/Artistic.html>
-
-=item Test::use::ok
-
-To the extent possible under law, 唐鳳 has waived all copyright and related
-or neighboring rights to L<Test-use-ok>.
-
-This work is published from Taiwan.
-
-L<http://creativecommons.org/publicdomain/zero/1.0>
-
-=item Test::Tester
-
-This module is copyright 2005 Fergal Daly <fergal@esatclear.ie>, some parts
-are based on other people's work.
-
-Under the same license as Perl itself
-
-See http://www.perl.com/perl/misc/Artistic.html
-
-=item Test::Builder::Tester
+=head1 NOTES
-Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004.
+Thanks to Richard Clamp E<lt>richardc@unixbeard.netE<gt> for letting
+me use his testing system to try this module out on.
-This program is free software; you can redistribute it
-and/or modify it under the same terms as Perl itself.
+=head1 SEE ALSO
-=back
+L<Test::Builder>, L<Test::Builder::Tester::Color>, L<Test::More>.
=cut
sub _account_for_subtest {
my( $self, $check ) = @_;
- my $ctx = Test::Stream::Context::context();
- my $depth = @{$ctx->stream->subtests};
- # Since we ship with Test::Builder, calling a private method is safe...ish.
- return ref($check) ? $check : ($depth ? ' ' x $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