diff options
Diffstat (limited to 'cpan/Test-Simple/lib/Test/Builder/Tester.pm')
| -rw-r--r-- | cpan/Test-Simple/lib/Test/Builder/Tester.pm | 240 |
1 files changed, 66 insertions, 174 deletions
diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester.pm b/cpan/Test-Simple/lib/Test/Builder/Tester.pm index 8762147c70..b0554b89ac 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Tester.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Tester.pm @@ -1,28 +1,17 @@ package Test::Builder::Tester; use strict; -our $VERSION = '1.301001_098'; -$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) +our $VERSION = "1.28"; -use Test::Stream 1.301001 '-internal'; -use Test::Builder 1.301001; +use Test::Builder 0.99; use Symbol; -use Test::Stream::Carp qw/croak/; - -=pod - -=encoding UTF-8 +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; @@ -59,55 +48,37 @@ output. # 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 ### @@ -129,9 +100,6 @@ my $testing = 0; 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; @@ -146,18 +114,15 @@ sub _start_testing { $original_harness_env = $ENV{HARNESS_ACTIVE} || 0; $ENV{HARNESS_ACTIVE} = 0; - $original_stream = builder->{stream} || Test::Stream->shared; - $original_state = [@{$original_stream->state->[-1]}]; - # 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(); @@ -165,13 +130,13 @@ sub _start_testing { # 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 @@ -209,7 +174,6 @@ output filehandles) =cut sub test_out { - my $ctx = context; # do we need to do any setup? _start_testing() unless $testing; @@ -217,7 +181,6 @@ sub test_out { } sub test_err { - my $ctx = context; # do we need to do any setup? _start_testing() unless $testing; @@ -251,7 +214,6 @@ more simply as: =cut sub test_fail { - my $ctx = context; # do we need to do any setup? _start_testing() unless $testing; @@ -294,13 +256,12 @@ without the newlines. =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 @@ -343,7 +304,6 @@ will function normally and cause success/errors for L<Test::Harness>. =cut sub test_test { - my $ctx = context; # decode the arguments as described in the pod my $mess; my %args; @@ -362,23 +322,21 @@ sub test_test { unless $testing; # 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 @@ -386,10 +344,10 @@ sub test_test { 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; } } @@ -460,112 +418,48 @@ sub color { =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 BUGS -=head1 SEE ALSO - -L<Test::Builder>, L<Test::Builder::Tester::Color>, L<Test::More>. +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. -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 the CPAN RT system: +L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Builder-Tester> -=head1 MAINTAINER +=head1 AUTHOR -=over 4 +Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004. -=item Chad Granum E<lt>exodist@cpan.orgE<gt> +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. -=back - -=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 @@ -593,10 +487,8 @@ sub expect { 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; + return ref($check) ? $check : $t->_indent . $check; } sub _translate_Failed_check { |