diff options
| author | Nicholas Clark <nick@ccl4.org> | 2009-09-13 21:13:03 +0100 |
|---|---|---|
| committer | Nicholas Clark <nick@ccl4.org> | 2009-09-13 21:14:44 +0100 |
| commit | d619eca62d5f721577dabcf8c79ff37674df46db (patch) | |
| tree | 21f75443f3e1abf8a7d9961699503c395da2ac33 /lib | |
| parent | 0d130a44d95f5adbf4d6e41e4f2f28b54f37e733 (diff) | |
| download | perl-d619eca62d5f721577dabcf8c79ff37674df46db.tar.gz | |
Move Test::Simple from lib to ext.
Diffstat (limited to 'lib')
102 files changed, 5 insertions, 11352 deletions
diff --git a/lib/.gitignore b/lib/.gitignore index 3a6e3b4ff5..cc418857d6 100644 --- a/lib/.gitignore +++ b/lib/.gitignore @@ -331,6 +331,11 @@ /Term/UI.pm /Term/UI/History.pm /Test.pm +/Test/Builder +/Test/Builder.pm +/Test/More.pm +/Test/Simple.pm +/Test/Tutorial.pod /Text/Balanced.pm /Text/ParseWords.pm /Text/Soundex.pm diff --git a/lib/Test/Builder.pm b/lib/Test/Builder.pm deleted file mode 100644 index cd5779f75b..0000000000 --- a/lib/Test/Builder.pm +++ /dev/null @@ -1,2239 +0,0 @@ -package Test::Builder; - -use 5.006; -use strict; -use warnings; - -our $VERSION = '0.92'; -$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) - -BEGIN { - if( $] < 5.008 ) { - require Test::Builder::IO::Scalar; - } -} - - -# Make Test::Builder thread-safe for ithreads. -BEGIN { - use Config; - # Load threads::shared when threads are turned on. - # 5.8.0's threads are so busted we no longer support them. - if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'} ) { - require threads::shared; - - # Hack around YET ANOTHER threads::shared bug. It would - # occassionally 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]; - my $data; - - if( $type eq 'HASH' ) { - %$data = %{ $_[0] }; - } - elsif( $type eq 'ARRAY' ) { - @$data = @{ $_[0] }; - } - elsif( $type eq 'SCALAR' ) { - $$data = ${ $_[0] }; - } - else { - die( "Unknown type: " . $type ); - } - - $_[0] = &threads::shared::share( $_[0] ); - - if( $type eq 'HASH' ) { - %{ $_[0] } = %$data; - } - elsif( $type eq 'ARRAY' ) { - @{ $_[0] } = @$data; - } - elsif( $type eq 'SCALAR' ) { - ${ $_[0] } = $$data; - } - else { - die( "Unknown type: " . $type ); - } - - return $_[0]; - }; - } - # 5.8.0's threads::shared is busted when threads are off - # and earlier Perls just don't have that module at all. - else { - *share = sub { return $_[0] }; - *lock = sub { 0 }; - } -} - -=head1 NAME - -Test::Builder - Backend for building test libraries - -=head1 SYNOPSIS - - package My::Test::Module; - use base 'Test::Builder::Module'; - - my $CLASS = __PACKAGE__; - - sub ok { - my($test, $name) = @_; - my $tb = $CLASS->builder; - - $tb->ok($test, $name); - } - - -=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 -building block upon which to write your own test libraries I<which can -work together>. - -=head2 Construction - -=over 4 - -=item B<new> - - my $Test = Test::Builder->new; - -Returns a Test::Builder object representing the current state of the -test. - -Since you only run one test per program C<new> always returns the same -Test::Builder object. No matter how many times you call C<new()>, you're -getting the same object. This is called a singleton. This is done so that -multiple modules share such global information as the test counter and -where test output is going. - -If you want a completely new Test::Builder object different from the -singleton, use C<create>. - -=cut - -my $Test = Test::Builder->new; - -sub new { - my($class) = shift; - $Test ||= $class->create; - return $Test; -} - -=item B<create> - - my $Test = Test::Builder->create; - -Ok, so there can be more than one Test::Builder object and this is how -you get it. You might use this instead of C<new()> if you're testing -a Test::Builder based module, but otherwise you probably want C<new>. - -B<NOTE>: the implementation is not complete. C<level>, for example, is -still shared amongst B<all> Test::Builder objects, even ones created using -this method. Also, the method name may change in the future. - -=cut - -sub create { - my $class = shift; - - my $self = bless {}, $class; - $self->reset; - - return $self; -} - -=item B<reset> - - $Test->reset; - -Reinitializes the Test::Builder singleton to its original state. -Mostly useful for tests run in persistent environments where the same -test might be run multiple times in the same process. - -=cut - -our $Level; - -sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms) - my($self) = @_; - - # We leave this a global because it has to be localized and localizing - # hash keys is just asking for pain. Also, it was documented. - $Level = 1; - - $self->{Have_Plan} = 0; - $self->{No_Plan} = 0; - $self->{Have_Output_Plan} = 0; - - $self->{Original_Pid} = $$; - - share( $self->{Curr_Test} ); - $self->{Curr_Test} = 0; - $self->{Test_Results} = &share( [] ); - - $self->{Exported_To} = undef; - $self->{Expected_Tests} = 0; - - $self->{Skip_All} = 0; - - $self->{Use_Nums} = 1; - - $self->{No_Header} = 0; - $self->{No_Ending} = 0; - - $self->{Todo} = undef; - $self->{Todo_Stack} = []; - $self->{Start_Todo} = 0; - $self->{Opened_Testhandles} = 0; - - $self->_dup_stdhandles; - - return; -} - -=back - -=head2 Setting up tests - -These methods are for setting up tests and declaring how many there -are. You usually only want to call one of these methods. - -=over 4 - -=item B<plan> - - $Test->plan('no_plan'); - $Test->plan( skip_all => $reason ); - $Test->plan( tests => $num_tests ); - -A convenient way to set up your tests. Call this and Test::Builder -will print the appropriate headers and take the appropriate actions. - -If you call C<plan()>, don't call any of the other methods below. - -=cut - -my %plan_cmds = ( - no_plan => \&no_plan, - skip_all => \&skip_all, - tests => \&_plan_tests, -); - -sub plan { - my( $self, $cmd, $arg ) = @_; - - return unless $cmd; - - local $Level = $Level + 1; - - $self->croak("You tried to plan twice") if $self->{Have_Plan}; - - if( my $method = $plan_cmds{$cmd} ) { - local $Level = $Level + 1; - $self->$method($arg); - } - else { - my @args = grep { defined } ( $cmd, $arg ); - $self->croak("plan() doesn't understand @args"); - } - - return 1; -} - - -sub _plan_tests { - my($self, $arg) = @_; - - if($arg) { - local $Level = $Level + 1; - return $self->expected_tests($arg); - } - elsif( !defined $arg ) { - $self->croak("Got an undefined number of tests"); - } - else { - $self->croak("You said to run 0 tests"); - } - - return; -} - - -=item B<expected_tests> - - my $max = $Test->expected_tests; - $Test->expected_tests($max); - -Gets/sets the number of tests we expect this test to run and prints out -the appropriate headers. - -=cut - -sub expected_tests { - my $self = shift; - my($max) = @_; - - if(@_) { - $self->croak("Number of tests must be a positive integer. You gave it '$max'") - unless $max =~ /^\+?\d+$/; - - $self->{Expected_Tests} = $max; - $self->{Have_Plan} = 1; - - $self->_output_plan($max) unless $self->no_header; - } - return $self->{Expected_Tests}; -} - -=item B<no_plan> - - $Test->no_plan; - -Declares that this test will run an indeterminate number of tests. - -=cut - -sub no_plan { - my($self, $arg) = @_; - - $self->carp("no_plan takes no arguments") if $arg; - - $self->{No_Plan} = 1; - $self->{Have_Plan} = 1; - - return 1; -} - - -=begin private - -=item B<_output_plan> - - $tb->_output_plan($max); - $tb->_output_plan($max, $directive); - $tb->_output_plan($max, $directive => $reason); - -Handles displaying the test plan. - -If a C<$directive> and/or C<$reason> are given they will be output with the -plan. So here's what skipping all tests looks like: - - $tb->_output_plan(0, "SKIP", "Because I said so"); - -It sets C<< $tb->{Have_Output_Plan} >> and will croak if the plan was already -output. - -=end private - -=cut - -sub _output_plan { - my($self, $max, $directive, $reason) = @_; - - $self->carp("The plan was already output") if $self->{Have_Output_Plan}; - - my $plan = "1..$max"; - $plan .= " # $directive" if defined $directive; - $plan .= " $reason" if defined $reason; - - $self->_print("$plan\n"); - - $self->{Have_Output_Plan} = 1; - - return; -} - -=item B<done_testing> - - $Test->done_testing(); - $Test->done_testing($num_tests); - -Declares that you are done testing, no more tests will be run after this point. - -If a plan has not yet been output, it will do so. - -$num_tests is the number of tests you planned to run. If a numbered -plan was already declared, and if this contradicts, a failing test -will be run to reflect the planning mistake. If C<no_plan> was declared, -this will override. - -If C<done_testing()> is called twice, the second call will issue a -failing test. - -If C<$num_tests> is omitted, the number of tests run will be used, like -no_plan. - -C<done_testing()> is, in effect, used when you'd want to use C<no_plan>, but -safer. You'd use it like so: - - $Test->ok($a == $b); - $Test->done_testing(); - -Or to plan a variable number of tests: - - for my $test (@tests) { - $Test->ok($test); - } - $Test->done_testing(@tests); - -=cut - -sub done_testing { - my($self, $num_tests) = @_; - - # If done_testing() specified the number of tests, shut off no_plan. - if( defined $num_tests ) { - $self->{No_Plan} = 0; - } - else { - $num_tests = $self->current_test; - } - - if( $self->{Done_Testing} ) { - my($file, $line) = @{$self->{Done_Testing}}[1,2]; - $self->ok(0, "done_testing() was already called at $file line $line"); - return; - } - - $self->{Done_Testing} = [caller]; - - if( $self->expected_tests && $num_tests != $self->expected_tests ) { - $self->ok(0, "planned to run @{[ $self->expected_tests ]} ". - "but done_testing() expects $num_tests"); - } - else { - $self->{Expected_Tests} = $num_tests; - } - - $self->_output_plan($num_tests) unless $self->{Have_Output_Plan}; - - $self->{Have_Plan} = 1; - - return 1; -} - - -=item B<has_plan> - - $plan = $Test->has_plan - -Find out whether a plan has been defined. C<$plan> is either C<undef> (no plan -has been set), C<no_plan> (indeterminate # of tests) or an integer (the number -of expected tests). - -=cut - -sub has_plan { - my $self = shift; - - return( $self->{Expected_Tests} ) if $self->{Expected_Tests}; - return('no_plan') if $self->{No_Plan}; - return(undef); -} - -=item B<skip_all> - - $Test->skip_all; - $Test->skip_all($reason); - -Skips all the tests, using the given C<$reason>. Exits immediately with 0. - -=cut - -sub skip_all { - my( $self, $reason ) = @_; - - $self->{Skip_All} = 1; - - $self->_output_plan(0, "SKIP", $reason) unless $self->no_header; - exit(0); -} - -=item B<exported_to> - - my $pack = $Test->exported_to; - $Test->exported_to($pack); - -Tells Test::Builder what package you exported your functions to. - -This method isn't terribly useful since modules which share the same -Test::Builder object might get exported to different packages and only -the last one will be honored. - -=cut - -sub exported_to { - my( $self, $pack ) = @_; - - if( defined $pack ) { - $self->{Exported_To} = $pack; - } - return $self->{Exported_To}; -} - -=back - -=head2 Running tests - -These actually run the tests, analogous to the functions in Test::More. - -They all return true if the test passed, false if the test failed. - -C<$name> is always optional. - -=over 4 - -=item B<ok> - - $Test->ok($test, $name); - -Your basic test. Pass if C<$test> is true, fail if $test is false. Just -like Test::Simple's C<ok()>. - -=cut - -sub ok { - my( $self, $test, $name ) = @_; - - # $test might contain an object which we don't want to accidentally - # store, so we turn it into a boolean. - $test = $test ? 1 : 0; - - lock $self->{Curr_Test}; - $self->{Curr_Test}++; - - # In case $name is a string overloaded object, force it to stringify. - $self->_unoverload_str( \$name ); - - $self->diag(<<"ERR") if defined $name and $name =~ /^[\d\s]+$/; - You named your test '$name'. You shouldn't use numbers for your test names. - Very confusing. -ERR - - # Capture the value of $TODO for the rest of this ok() call - # so it can more easily be found by other routines. - my $todo = $self->todo(); - my $in_todo = $self->in_todo; - local $self->{Todo} = $todo if $in_todo; - - $self->_unoverload_str( \$todo ); - - my $out; - my $result = &share( {} ); - - unless($test) { - $out .= "not "; - @$result{ 'ok', 'actual_ok' } = ( ( $self->in_todo ? 1 : 0 ), 0 ); - } - else { - @$result{ 'ok', 'actual_ok' } = ( 1, $test ); - } - - $out .= "ok"; - $out .= " $self->{Curr_Test}" if $self->use_numbers; - - if( defined $name ) { - $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness. - $out .= " - $name"; - $result->{name} = $name; - } - else { - $result->{name} = ''; - } - - if( $self->in_todo ) { - $out .= " # TODO $todo"; - $result->{reason} = $todo; - $result->{type} = 'todo'; - } - else { - $result->{reason} = ''; - $result->{type} = ''; - } - - $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = $result; - $out .= "\n"; - - $self->_print($out); - - unless($test) { - my $msg = $self->in_todo ? "Failed (TODO)" : "Failed"; - $self->_print_to_fh( $self->_diag_fh, "\n" ) if $ENV{HARNESS_ACTIVE}; - - my( undef, $file, $line ) = $self->caller; - if( defined $name ) { - $self->diag(qq[ $msg test '$name'\n]); - $self->diag(qq[ at $file line $line.\n]); - } - else { - $self->diag(qq[ $msg test at $file line $line.\n]); - } - } - - return $test ? 1 : 0; -} - -sub _unoverload { - my $self = shift; - my $type = shift; - - $self->_try(sub { require overload; }, die_on_fail => 1); - - foreach my $thing (@_) { - if( $self->_is_object($$thing) ) { - if( my $string_meth = overload::Method( $$thing, $type ) ) { - $$thing = $$thing->$string_meth(); - } - } - } - - return; -} - -sub _is_object { - my( $self, $thing ) = @_; - - return $self->_try( sub { ref $thing && $thing->isa('UNIVERSAL') } ) ? 1 : 0; -} - -sub _unoverload_str { - my $self = shift; - - return $self->_unoverload( q[""], @_ ); -} - -sub _unoverload_num { - my $self = shift; - - $self->_unoverload( '0+', @_ ); - - for my $val (@_) { - next unless $self->_is_dualvar($$val); - $$val = $$val + 0; - } - - return; -} - -# This is a hack to detect a dualvar such as $! -sub _is_dualvar { - my( $self, $val ) = @_; - - # Objects are not dualvars. - return 0 if ref $val; - - no warnings 'numeric'; - my $numval = $val + 0; - return $numval != 0 and $numval ne $val ? 1 : 0; -} - -=item B<is_eq> - - $Test->is_eq($got, $expected, $name); - -Like Test::More's C<is()>. Checks if C<$got eq $expected>. This is the -string version. - -=item B<is_num> - - $Test->is_num($got, $expected, $name); - -Like Test::More's C<is()>. Checks if C<$got == $expected>. This is the -numeric version. - -=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; - - $self->ok( $test, $name ); - $self->_is_diag( $got, 'eq', $expect ) unless $test; - return $test; - } - - return $self->cmp_ok( $got, 'eq', $expect, $name ); -} - -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; - - $self->ok( $test, $name ); - $self->_is_diag( $got, '==', $expect ) unless $test; - return $test; - } - - return $self->cmp_ok( $got, '==', $expect, $name ); -} - -sub _diag_fmt { - my( $self, $type, $val ) = @_; - - if( defined $$val ) { - if( $type eq 'eq' or $type eq 'ne' ) { - # quote and force string context - $$val = "'$$val'"; - } - else { - # force numeric context - $self->_unoverload_num($val); - } - } - else { - $$val = 'undef'; - } - - return; -} - -sub _is_diag { - my( $self, $got, $type, $expect ) = @_; - - $self->_diag_fmt( $type, $_ ) for \$got, \$expect; - - local $Level = $Level + 1; - return $self->diag(<<"DIAGNOSTIC"); - got: $got - expected: $expect -DIAGNOSTIC - -} - -sub _isnt_diag { - my( $self, $got, $type ) = @_; - - $self->_diag_fmt( $type, \$got ); - - local $Level = $Level + 1; - return $self->diag(<<"DIAGNOSTIC"); - got: $got - expected: anything else -DIAGNOSTIC -} - -=item B<isnt_eq> - - $Test->isnt_eq($got, $dont_expect, $name); - -Like Test::More's C<isnt()>. Checks if C<$got ne $dont_expect>. This is -the string version. - -=item B<isnt_num> - - $Test->isnt_num($got, $dont_expect, $name); - -Like Test::More's C<isnt()>. Checks if C<$got ne $dont_expect>. This is -the numeric version. - -=cut - -sub isnt_eq { - my( $self, $got, $dont_expect, $name ) = @_; - local $Level = $Level + 1; - - if( !defined $got || !defined $dont_expect ) { - # undef only matches undef and nothing else - my $test = defined $got || defined $dont_expect; - - $self->ok( $test, $name ); - $self->_isnt_diag( $got, 'ne' ) unless $test; - return $test; - } - - return $self->cmp_ok( $got, 'ne', $dont_expect, $name ); -} - -sub isnt_num { - my( $self, $got, $dont_expect, $name ) = @_; - local $Level = $Level + 1; - - if( !defined $got || !defined $dont_expect ) { - # undef only matches undef and nothing else - my $test = defined $got || defined $dont_expect; - - $self->ok( $test, $name ); - $self->_isnt_diag( $got, '!=' ) unless $test; - return $test; - } - - return $self->cmp_ok( $got, '!=', $dont_expect, $name ); -} - -=item B<like> - - $Test->like($this, qr/$regex/, $name); - $Test->like($this, '/$regex/', $name); - -Like Test::More's C<like()>. Checks if $this matches the given C<$regex>. - -You'll want to avoid C<qr//> if you want your tests to work before 5.005. - -=item B<unlike> - - $Test->unlike($this, qr/$regex/, $name); - $Test->unlike($this, '/$regex/', $name); - -Like Test::More's C<unlike()>. Checks if $this B<does not match> the -given C<$regex>. - -=cut - -sub like { - my( $self, $this, $regex, $name ) = @_; - - local $Level = $Level + 1; - return $self->_regex_ok( $this, $regex, '=~', $name ); -} - -sub unlike { - my( $self, $this, $regex, $name ) = @_; - - local $Level = $Level + 1; - return $self->_regex_ok( $this, $regex, '!~', $name ); -} - -=item B<cmp_ok> - - $Test->cmp_ok($this, $type, $that, $name); - -Works just like Test::More's C<cmp_ok()>. - - $Test->cmp_ok($big_num, '!=', $other_big_num); - -=cut - -my %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" ); - -sub cmp_ok { - my( $self, $got, $type, $expect, $name ) = @_; - - my $test; - my $error; - { - ## no critic (BuiltinFunctions::ProhibitStringyEval) - - local( $@, $!, $SIG{__DIE__} ); # isolate eval - - my($pack, $file, $line) = $self->caller(); - - $test = eval qq[ -#line 1 "cmp_ok [from $file line $line]" -\$got $type \$expect; -]; - $error = $@; - } - local $Level = $Level + 1; - my $ok = $self->ok( $test, $name ); - - # Treat overloaded objects as numbers if we're asked to do a - # numeric comparison. - my $unoverload - = $numeric_cmps{$type} - ? '_unoverload_num' - : '_unoverload_str'; - - $self->diag(<<"END") if $error; -An error occurred while using $type: ------------------------------------- -$error ------------------------------------- -END - - unless($ok) { - $self->$unoverload( \$got, \$expect ); - - if( $type =~ /^(eq|==)$/ ) { - $self->_is_diag( $got, $type, $expect ); - } - elsif( $type =~ /^(ne|!=)$/ ) { - $self->_isnt_diag( $got, $type ); - } - else { - $self->_cmp_diag( $got, $type, $expect ); - } - } - return $ok; -} - -sub _cmp_diag { - my( $self, $got, $type, $expect ) = @_; - - $got = defined $got ? "'$got'" : 'undef'; - $expect = defined $expect ? "'$expect'" : 'undef'; - - local $Level = $Level + 1; - return $self->diag(<<"DIAGNOSTIC"); - $got - $type - $expect -DIAGNOSTIC -} - -sub _caller_context { - my $self = shift; - - my( $pack, $file, $line ) = $self->caller(1); - - my $code = ''; - $code .= "#line $line $file\n" if defined $file and defined $line; - - return $code; -} - -=back - - -=head2 Other Testing Methods - -These are methods which are used in the course of writing a test but are not themselves tests. - -=over 4 - -=item B<BAIL_OUT> - - $Test->BAIL_OUT($reason); - -Indicates to the Test::Harness that things are going so badly all -testing should terminate. This includes running any additional test -scripts. - -It will exit with 255. - -=cut - -sub BAIL_OUT { - my( $self, $reason ) = @_; - - $self->{Bailed_Out} = 1; - $self->_print("Bail out! $reason"); - exit 255; -} - -=for deprecated -BAIL_OUT() used to be BAILOUT() - -=cut - -*BAILOUT = \&BAIL_OUT; - -=item B<skip> - - $Test->skip; - $Test->skip($why); - -Skips the current test, reporting C<$why>. - -=cut - -sub skip { - my( $self, $why ) = @_; - $why ||= ''; - $self->_unoverload_str( \$why ); - - lock( $self->{Curr_Test} ); - $self->{Curr_Test}++; - - $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share( - { - 'ok' => 1, - actual_ok => 1, - name => '', - type => 'skip', - reason => $why, - } - ); - - my $out = "ok"; - $out .= " $self->{Curr_Test}" if $self->use_numbers; - $out .= " # skip"; - $out .= " $why" if length $why; - $out .= "\n"; - - $self->_print($out); - - return 1; -} - -=item B<todo_skip> - - $Test->todo_skip; - $Test->todo_skip($why); - -Like C<skip()>, only it will declare the test as failing and TODO. Similar -to - - print "not ok $tnum # TODO $why\n"; - -=cut - -sub todo_skip { - my( $self, $why ) = @_; - $why ||= ''; - - lock( $self->{Curr_Test} ); - $self->{Curr_Test}++; - - $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share( - { - 'ok' => 1, - actual_ok => 0, - name => '', - type => 'todo_skip', - reason => $why, - } - ); - - my $out = "not ok"; - $out .= " $self->{Curr_Test}" if $self->use_numbers; - $out .= " # TODO & SKIP $why\n"; - - $self->_print($out); - - return 1; -} - -=begin _unimplemented - -=item B<skip_rest> - - $Test->skip_rest; - $Test->skip_rest($reason); - -Like C<skip()>, only it skips all the rest of the tests you plan to run -and terminates the test. - -If you're running under C<no_plan>, it skips once and terminates the -test. - -=end _unimplemented - -=back - - -=head2 Test building utility methods - -These methods are useful when writing your own test methods. - -=over 4 - -=item B<maybe_regex> - - $Test->maybe_regex(qr/$regex/); - $Test->maybe_regex('/$regex/'); - -Convenience method for building testing functions that take regular -expressions as arguments, but need to work before perl 5.005. - -Takes a quoted regular expression produced by C<qr//>, or a string -representing a regular expression. - -Returns a Perl value which may be used instead of the corresponding -regular expression, or C<undef> if its argument is not recognised. - -For example, a version of C<like()>, sans the useful diagnostic messages, -could be written as: - - sub laconic_like { - my ($self, $this, $regex, $name) = @_; - my $usable_regex = $self->maybe_regex($regex); - die "expecting regex, found '$regex'\n" - unless $usable_regex; - $self->ok($this =~ m/$usable_regex/, $name); - } - -=cut - -sub maybe_regex { - my( $self, $regex ) = @_; - my $usable_regex = undef; - - return $usable_regex unless defined $regex; - - my( $re, $opts ); - - # Check for qr/foo/ - if( _is_qr($regex) ) { - $usable_regex = $regex; - } - # Check for '/foo/' or 'm,foo,' - elsif(( $re, $opts ) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or - ( undef, $re, $opts ) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx - ) - { - $usable_regex = length $opts ? "(?$opts)$re" : $re; - } - - return $usable_regex; -} - -sub _is_qr { - my $regex = shift; - - # is_regexp() checks for regexes in a robust manner, say if they're - # blessed. - return re::is_regexp($regex) if defined &re::is_regexp; - return ref $regex eq 'Regexp'; -} - -sub _regex_ok { - my( $self, $this, $regex, $cmp, $name ) = @_; - - my $ok = 0; - my $usable_regex = $self->maybe_regex($regex); - unless( defined $usable_regex ) { - local $Level = $Level + 1; - $ok = $self->ok( 0, $name ); - $self->diag(" '$regex' doesn't look much like a regex to me."); - return $ok; - } - - { - ## no critic (BuiltinFunctions::ProhibitStringyEval) - - my $test; - my $code = $self->_caller_context; - - local( $@, $!, $SIG{__DIE__} ); # isolate eval - - # Yes, it has to look like this or 5.4.5 won't see the #line - # directive. - # Don't ask me, man, I just work here. - $test = eval " -$code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0}; - - $test = !$test if $cmp eq '!~'; - - local $Level = $Level + 1; - $ok = $self->ok( $test, $name ); - } - - unless($ok) { - $this = defined $this ? "'$this'" : 'undef'; - my $match = $cmp eq '=~' ? "doesn't match" : "matches"; - - local $Level = $Level + 1; - $self->diag( sprintf <<'DIAGNOSTIC', $this, $match, $regex ); - %s - %13s '%s' -DIAGNOSTIC - - } - - return $ok; -} - -# I'm not ready to publish this. It doesn't deal with array return -# values from the code or context. - -=begin private - -=item B<_try> - - my $return_from_code = $Test->try(sub { code }); - my($return_from_code, $error) = $Test->try(sub { code }); - -Works like eval BLOCK except it ensures it has no effect on the rest -of the test (ie. C<$@> is not set) nor is effected by outside -interference (ie. C<$SIG{__DIE__}>) and works around some quirks in older -Perls. - -C<$error> is what would normally be in C<$@>. - -It is suggested you use this in place of eval BLOCK. - -=cut - -sub _try { - my( $self, $code, %opts ) = @_; - - my $error; - my $return; - { - local $!; # eval can mess up $! - local $@; # don't set $@ in the test - local $SIG{__DIE__}; # don't trip an outside DIE handler. - $return = eval { $code->() }; - $error = $@; - } - - die $error if $error and $opts{die_on_fail}; - - return wantarray ? ( $return, $error ) : $return; -} - -=end private - - -=item B<is_fh> - - my $is_fh = $Test->is_fh($thing); - -Determines if the given C<$thing> can be used as a filehandle. - -=cut - -sub is_fh { - my $self = shift; - my $maybe_fh = shift; - return 0 unless defined $maybe_fh; - - return 1 if ref $maybe_fh eq 'GLOB'; # its a glob ref - return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob - - return eval { $maybe_fh->isa("IO::Handle") } || - # 5.5.4's tied() and can() doesn't like getting undef - eval { ( tied($maybe_fh) || '' )->can('TIEHANDLE') }; -} - -=back - - -=head2 Test style - - -=over 4 - -=item B<level> - - $Test->level($how_high); - -How far up the call stack should C<$Test> look when reporting where the -test failed. - -Defaults to 1. - -Setting L<$Test::Builder::Level> overrides. This is typically useful -localized: - - sub my_ok { - my $test = shift; - - local $Test::Builder::Level = $Test::Builder::Level + 1; - $TB->ok($test); - } - -To be polite to other functions wrapping your own you usually want to increment C<$Level> rather than set it to a constant. - -=cut - -sub level { - my( $self, $level ) = @_; - - if( defined $level ) { - $Level = $level; - } - return $Level; -} - -=item B<use_numbers> - - $Test->use_numbers($on_or_off); - -Whether or not the test should output numbers. That is, this if true: - - ok 1 - ok 2 - ok 3 - -or this if false - - ok - ok - ok - -Most useful when you can't depend on the test output order, such as -when threads or forking is involved. - -Defaults to on. - -=cut - -sub use_numbers { - my( $self, $use_nums ) = @_; - - if( defined $use_nums ) { - $self->{Use_Nums} = $use_nums; - } - return $self->{Use_Nums}; -} - -=item B<no_diag> - - $Test->no_diag($no_diag); - -If set true no diagnostics will be printed. This includes calls to -C<diag()>. - -=item B<no_ending> - - $Test->no_ending($no_ending); - -Normally, Test::Builder does some extra diagnostics when the test -ends. It also changes the exit code as described below. - -If this is true, none of that will be done. - -=item B<no_header> - - $Test->no_header($no_header); - -If set to true, no "1..N" header will be printed. - -=cut - -foreach my $attribute (qw(No_Header No_Ending No_Diag)) { - my $method = lc $attribute; - - my $code = sub { - my( $self, $no ) = @_; - - if( defined $no ) { - $self->{$attribute} = $no; - } - return $self->{$attribute}; - }; - - no strict 'refs'; ## no critic - *{ __PACKAGE__ . '::' . $method } = $code; -} - -=back - -=head2 Output - -Controlling where the test output goes. - -It's ok for your test to change where STDOUT and STDERR point to, -Test::Builder's default output settings will not be affected. - -=over 4 - -=item B<diag> - - $Test->diag(@msgs); - -Prints out the given C<@msgs>. Like C<print>, arguments are simply -appended together. - -Normally, it uses the C<failure_output()> handle, but if this is for a -TODO test, the C<todo_output()> handle is used. - -Output will be indented and marked with a # so as not to interfere -with test output. A newline will be put on the end if there isn't one -already. - -We encourage using this rather than calling print directly. - -Returns false. Why? Because C<diag()> is often used in conjunction with -a failing test (C<ok() || diag()>) it "passes through" the failure. - - return ok(...) || diag(...); - -=for blame transfer -Mark Fowler <mark@twoshortplanks.com> - -=cut - -sub diag { - my $self = shift; - - $self->_print_comment( $self->_diag_fh, @_ ); -} - -=item B<note> - - $Test->note(@msgs); - -Like C<diag()>, but it prints to the C<output()> handle so it will not -normally be seen by the user except in verbose mode. - -=cut - -sub note { - my $self = shift; - - $self->_print_comment( $self->output, @_ ); -} - -sub _diag_fh { - my $self = shift; - - local $Level = $Level + 1; - return $self->in_todo ? $self->todo_output : $self->failure_output; -} - -sub _print_comment { - my( $self, $fh, @msgs ) = @_; - - return if $self->no_diag; - return unless @msgs; - - # Prevent printing headers when compiling (i.e. -c) - return if $^C; - - # Smash args together like print does. - # Convert undef to 'undef' so its readable. - my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs; - - # Escape the beginning, _print will take care of the rest. - $msg =~ s/^/# /; - - local $Level = $Level + 1; - $self->_print_to_fh( $fh, $msg ); - - return 0; -} - -=item B<explain> - - my @dump = $Test->explain(@msgs); - -Will dump the contents of any references in a human readable format. -Handy for things like... - - is_deeply($have, $want) || diag explain $have; - -or - - is_deeply($have, $want) || note explain $have; - -=cut - -sub explain { - my $self = shift; - - return map { - ref $_ - ? do { - $self->_try(sub { require Data::Dumper }, die_on_fail => 1); - - my $dumper = Data::Dumper->new( [$_] ); - $dumper->Indent(1)->Terse(1); - $dumper->Sortkeys(1) if $dumper->can("Sortkeys"); - $dumper->Dump; - } - : $_ - } @_; -} - -=begin _private - -=item B<_print> - - $Test->_print(@msgs); - -Prints to the C<output()> filehandle. - -=end _private - -=cut - -sub _print { - my $self = shift; - return $self->_print_to_fh( $self->output, @_ ); -} - -sub _print_to_fh { - my( $self, $fh, @msgs ) = @_; - - # Prevent printing headers when only compiling. Mostly for when - # tests are deparsed with B::Deparse - return if $^C; - - my $msg = join '', @msgs; - - local( $\, $", $, ) = ( undef, ' ', '' ); - - # Escape each line after the first with a # so we don't - # confuse Test::Harness. - $msg =~ s{\n(?!\z)}{\n# }sg; - - # Stick a newline on the end if it needs it. - $msg .= "\n" unless $msg =~ /\n\z/; - - return print $fh $msg; -} - -=item B<output> - -=item B<failure_output> - -=item B<todo_output> - - my $filehandle = $Test->output; - $Test->output($filehandle); - $Test->output($filename); - $Test->output(\$scalar); - -These methods control where Test::Builder will print its output. -They take either an open C<$filehandle>, a C<$filename> to open and write to -or a C<$scalar> reference to append to. It will always return a C<$filehandle>. - -B<output> is where normal "ok/not ok" test output goes. - -Defaults to STDOUT. - -B<failure_output> is where diagnostic output on test failures and -C<diag()> goes. It is normally not read by Test::Harness and instead is -displayed to the user. - -Defaults to STDERR. - -C<todo_output> is used instead of C<failure_output()> for the -diagnostics of a failing TODO test. These will not be seen by the -user. - -Defaults to STDOUT. - -=cut - -sub output { - my( $self, $fh ) = @_; - - if( defined $fh ) { - $self->{Out_FH} = $self->_new_fh($fh); - } - return $self->{Out_FH}; -} - -sub failure_output { - my( $self, $fh ) = @_; - - if( defined $fh ) { - $self->{Fail_FH} = $self->_new_fh($fh); - } - return $self->{Fail_FH}; -} - -sub todo_output { - my( $self, $fh ) = @_; - - if( defined $fh ) { - $self->{Todo_FH} = $self->_new_fh($fh); - } - return $self->{Todo_FH}; -} - -sub _new_fh { - my $self = shift; - my($file_or_fh) = shift; - - my $fh; - if( $self->is_fh($file_or_fh) ) { - $fh = $file_or_fh; - } - elsif( ref $file_or_fh eq 'SCALAR' ) { - # Scalar refs as filehandles was added in 5.8. - if( $] >= 5.008 ) { - open $fh, ">>", $file_or_fh - or $self->croak("Can't open scalar ref $file_or_fh: $!"); - } - # Emulate scalar ref filehandles with a tie. - else { - $fh = Test::Builder::IO::Scalar->new($file_or_fh) - or $self->croak("Can't tie scalar ref $file_or_fh"); - } - } - else { - open $fh, ">", $file_or_fh - or $self->croak("Can't open test output log $file_or_fh: $!"); - _autoflush($fh); - } - - return $fh; -} - -sub _autoflush { - my($fh) = shift; - my $old_fh = select $fh; - $| = 1; - select $old_fh; - - return; -} - -my( $Testout, $Testerr ); - -sub _dup_stdhandles { - my $self = shift; - - $self->_open_testhandles; - - # Set everything to unbuffered else plain prints to STDOUT will - # come out in the wrong order from our own prints. - _autoflush($Testout); - _autoflush( \*STDOUT ); - _autoflush($Testerr); - _autoflush( \*STDERR ); - - $self->reset_outputs; - - return; -} - -sub _open_testhandles { - my $self = shift; - - return if $self->{Opened_Testhandles}; - - # We dup STDOUT and STDERR so people can change them in their - # test suites while still getting normal test output. - 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->{Opened_Testhandles} = 1; - - return; -} - -sub _copy_io_layers { - my( $self, $src, $dst ) = @_; - - $self->_try( - sub { - require PerlIO; - my @src_layers = PerlIO::get_layers($src); - - binmode $dst, join " ", map ":$_", @src_layers if @src_layers; - } - ); - - return; -} - -=item reset_outputs - - $tb->reset_outputs; - -Resets all the output filehandles back to their defaults. - -=cut - -sub reset_outputs { - my $self = shift; - - $self->output ($Testout); - $self->failure_output($Testerr); - $self->todo_output ($Testout); - - return; -} - -=item carp - - $tb->carp(@message); - -Warns with C<@message> but the message will appear to come from the -point where the original test function was called (C<< $tb->caller >>). - -=item croak - - $tb->croak(@message); - -Dies with C<@message> but the message will appear to come from the -point where the original test function was called (C<< $tb->caller >>). - -=cut - -sub _message_at_caller { - my $self = shift; - - local $Level = $Level + 1; - my( $pack, $file, $line ) = $self->caller; - return join( "", @_ ) . " at $file line $line.\n"; -} - -sub carp { - my $self = shift; - return warn $self->_message_at_caller(@_); -} - -sub croak { - my $self = shift; - return die $self->_message_at_caller(@_); -} - - -=back - - -=head2 Test Status and Info - -=over 4 - -=item B<current_test> - - my $curr_test = $Test->current_test; - $Test->current_test($num); - -Gets/sets the current test number we're on. You usually shouldn't -have to set this. - -If set forward, the details of the missing tests are filled in as 'unknown'. -if set backward, the details of the intervening tests are deleted. You -can erase history if you really want to. - -=cut - -sub current_test { - my( $self, $num ) = @_; - - lock( $self->{Curr_Test} ); - if( defined $num ) { - $self->{Curr_Test} = $num; - - # If the test counter is being pushed forward fill in the details. - my $test_results = $self->{Test_Results}; - if( $num > @$test_results ) { - my $start = @$test_results ? @$test_results : 0; - for( $start .. $num - 1 ) { - $test_results->[$_] = &share( - { - 'ok' => 1, - actual_ok => undef, - reason => 'incrementing test number', - type => 'unknown', - name => undef - } - ); - } - } - # If backward, wipe history. Its their funeral. - elsif( $num < @$test_results ) { - $#{$test_results} = $num - 1; - } - } - return $self->{Curr_Test}; -} - -=item B<summary> - - my @tests = $Test->summary; - -A simple summary of the tests so far. True for pass, false for fail. -This is a logical pass/fail, so todos are passes. - -Of course, test #1 is $tests[0], etc... - -=cut - -sub summary { - my($self) = shift; - - return map { $_->{'ok'} } @{ $self->{Test_Results} }; -} - -=item B<details> - - my @tests = $Test->details; - -Like C<summary()>, but with a lot more detail. - - $tests[$test_num - 1] = - { 'ok' => is the test considered a pass? - actual_ok => did it literally say 'ok'? - name => name of the test (if any) - type => type of test (if any, see below). - reason => reason for the above (if any) - }; - -'ok' is true if Test::Harness will consider the test to be a pass. - -'actual_ok' is a reflection of whether or not the test literally -printed 'ok' or 'not ok'. This is for examining the result of 'todo' -tests. - -'name' is the name of the test. - -'type' indicates if it was a special test. Normal tests have a type -of ''. Type can be one of the following: - - skip see skip() - todo see todo() - todo_skip see todo_skip() - unknown see below - -Sometimes the Test::Builder test counter is incremented without it -printing any test output, for example, when C<current_test()> is changed. -In these cases, Test::Builder doesn't know the result of the test, so -its type is 'unknown'. These details for these tests are filled in. -They are considered ok, but the name and actual_ok is left C<undef>. - -For example "not ok 23 - hole count # TODO insufficient donuts" would -result in this structure: - - $tests[22] = # 23 - 1, since arrays start from 0. - { ok => 1, # logically, the test passed since its todo - actual_ok => 0, # in absolute terms, it failed - name => 'hole count', - type => 'todo', - reason => 'insufficient donuts' - }; - -=cut - -sub details { - my $self = shift; - return @{ $self->{Test_Results} }; -} - -=item B<todo> - - my $todo_reason = $Test->todo; - my $todo_reason = $Test->todo($pack); - -If the current tests are considered "TODO" it will return the reason, -if any. This reason can come from a C<$TODO> variable or the last call -to C<todo_start()>. - -Since a TODO test does not need a reason, this function can return an -empty string even when inside a TODO block. Use C<< $Test->in_todo >> -to determine if you are currently inside a TODO block. - -C<todo()> is about finding the right package to look for C<$TODO> in. It's -pretty good at guessing the right package to look at. It first looks for -the caller based on C<$Level + 1>, since C<todo()> is usually called inside -a test function. As a last resort it will use C<exported_to()>. - -Sometimes there is some confusion about where todo() should be looking -for the C<$TODO> variable. If you want to be sure, tell it explicitly -what $pack to use. - -=cut - -sub todo { - my( $self, $pack ) = @_; - - return $self->{Todo} if defined $self->{Todo}; - - local $Level = $Level + 1; - my $todo = $self->find_TODO($pack); - return $todo if defined $todo; - - return ''; -} - -=item B<find_TODO> - - my $todo_reason = $Test->find_TODO(); - my $todo_reason = $Test->find_TODO($pack): - -Like C<todo()> but only returns the value of C<$TODO> ignoring -C<todo_start()>. - -=cut - -sub find_TODO { - my( $self, $pack ) = @_; - - $pack = $pack || $self->caller(1) || $self->exported_to; - return unless $pack; - - no strict 'refs'; ## no critic - return ${ $pack . '::TODO' }; -} - -=item B<in_todo> - - my $in_todo = $Test->in_todo; - -Returns true if the test is currently inside a TODO block. - -=cut - -sub in_todo { - my $self = shift; - - local $Level = $Level + 1; - return( defined $self->{Todo} || $self->find_TODO ) ? 1 : 0; -} - -=item B<todo_start> - - $Test->todo_start(); - $Test->todo_start($message); - -This method allows you declare all subsequent tests as TODO tests, up until -the C<todo_end> method has been called. - -The C<TODO:> and C<$TODO> syntax is generally pretty good about figuring out -whether or not we're in a TODO test. However, often we find that this is not -possible to determine (such as when we want to use C<$TODO> but -the tests are being executed in other packages which can't be inferred -beforehand). - -Note that you can use this to nest "todo" tests - - $Test->todo_start('working on this'); - # lots of code - $Test->todo_start('working on that'); - # more code - $Test->todo_end; - $Test->todo_end; - -This is generally not recommended, but large testing systems often have weird -internal needs. - -We've tried to make this also work with the TODO: syntax, but it's not -guaranteed and its use is also discouraged: - - TODO: { - local $TODO = 'We have work to do!'; - $Test->todo_start('working on this'); - # lots of code - $Test->todo_start('working on that'); - # more code - $Test->todo_end; - $Test->todo_end; - } - -Pick one style or another of "TODO" to be on the safe side. - -=cut - -sub todo_start { - my $self = shift; - my $message = @_ ? shift : ''; - - $self->{Start_Todo}++; - if( $self->in_todo ) { - push @{ $self->{Todo_Stack} } => $self->todo; - } - $self->{Todo} = $message; - - return; -} - -=item C<todo_end> - - $Test->todo_end; - -Stops running tests as "TODO" tests. This method is fatal if called without a -preceding C<todo_start> method call. - -=cut - -sub todo_end { - my $self = shift; - - if( !$self->{Start_Todo} ) { - $self->croak('todo_end() called without todo_start()'); - } - - $self->{Start_Todo}--; - - if( $self->{Start_Todo} && @{ $self->{Todo_Stack} } ) { - $self->{Todo} = pop @{ $self->{Todo_Stack} }; - } - else { - delete $self->{Todo}; - } - - return; -} - -=item B<caller> - - my $package = $Test->caller; - my($pack, $file, $line) = $Test->caller; - my($pack, $file, $line) = $Test->caller($height); - -Like the normal C<caller()>, except it reports according to your C<level()>. - -C<$height> will be added to the C<level()>. - -If C<caller()> winds up off the top of the stack it report the highest context. - -=cut - -sub caller { ## no critic (Subroutines::ProhibitBuiltinHomonyms) - my( $self, $height ) = @_; - $height ||= 0; - - my $level = $self->level + $height + 1; - my @caller; - do { - @caller = CORE::caller( $level ); - $level--; - } until @caller; - return wantarray ? @caller : $caller[0]; -} - -=back - -=cut - -=begin _private - -=over 4 - -=item B<_sanity_check> - - $self->_sanity_check(); - -Runs a bunch of end of test sanity checks to make sure reality came -through ok. If anything is wrong it will die with a fairly friendly -error message. - -=cut - -#'# -sub _sanity_check { - my $self = shift; - - $self->_whoa( $self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!' ); - $self->_whoa( $self->{Curr_Test} != @{ $self->{Test_Results} }, - 'Somehow you got a different number of results than tests ran!' ); - - return; -} - -=item B<_whoa> - - $self->_whoa($check, $description); - -A sanity check, similar to C<assert()>. If the C<$check> is true, something -has gone horribly wrong. It will die with the given C<$description> and -a note to contact the author. - -=cut - -sub _whoa { - my( $self, $check, $desc ) = @_; - if($check) { - local $Level = $Level + 1; - $self->croak(<<"WHOA"); -WHOA! $desc -This should never happen! Please contact the author immediately! -WHOA - } - - return; -} - -=item B<_my_exit> - - _my_exit($exit_num); - -Perl seems to have some trouble with exiting inside an C<END> block. 5.005_03 -and 5.6.1 both seem to do odd things. Instead, this function edits C<$?> -directly. It should B<only> be called from inside an C<END> block. It -doesn't actually exit, that's your job. - -=cut - -sub _my_exit { - $? = $_[0]; ## no critic (Variables::RequireLocalizedPunctuationVars) - - return 1; -} - -=back - -=end _private - -=cut - -sub _ending { - my $self = shift; - - my $real_exit_code = $?; - - # Don't bother with an ending if this is a forked copy. Only the parent - # should do the ending. - if( $self->{Original_Pid} != $$ ) { - return; - } - - # Ran tests but never declared a plan or hit done_testing - if( !$self->{Have_Plan} and $self->{Curr_Test} ) { - $self->diag("Tests were run but no plan was declared and done_testing() was not seen."); - } - - # Exit if plan() was never called. This is so "require Test::Simple" - # doesn't puke. - if( !$self->{Have_Plan} ) { - return; - } - - # Don't do an ending if we bailed out. - if( $self->{Bailed_Out} ) { - return; - } - - # Figure out if we passed or failed and print helpful messages. - my $test_results = $self->{Test_Results}; - if(@$test_results) { - # The plan? We have no plan. - if( $self->{No_Plan} ) { - $self->_output_plan($self->{Curr_Test}) unless $self->no_header; - $self->{Expected_Tests} = $self->{Curr_Test}; - } - - # Auto-extended arrays and elements which aren't explicitly - # filled in with a shared reference will puke under 5.8.0 - # ithreads. So we have to fill them in by hand. :( - my $empty_result = &share( {} ); - for my $idx ( 0 .. $self->{Expected_Tests} - 1 ) { - $test_results->[$idx] = $empty_result - unless defined $test_results->[$idx]; - } - - my $num_failed = grep !$_->{'ok'}, @{$test_results}[ 0 .. $self->{Curr_Test} - 1 ]; - - my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests}; - - if( $num_extra != 0 ) { - my $s = $self->{Expected_Tests} == 1 ? '' : 's'; - $self->diag(<<"FAIL"); -Looks like you planned $self->{Expected_Tests} test$s but ran $self->{Curr_Test}. -FAIL - } - - if($num_failed) { - my $num_tests = $self->{Curr_Test}; - my $s = $num_failed == 1 ? '' : 's'; - - my $qualifier = $num_extra == 0 ? '' : ' run'; - - $self->diag(<<"FAIL"); -Looks like you failed $num_failed test$s of $num_tests$qualifier. -FAIL - } - - if($real_exit_code) { - $self->diag(<<"FAIL"); -Looks like your test exited with $real_exit_code just after $self->{Curr_Test}. -FAIL - - _my_exit($real_exit_code) && return; - } - - my $exit_code; - if($num_failed) { - $exit_code = $num_failed <= 254 ? $num_failed : 254; - } - elsif( $num_extra != 0 ) { - $exit_code = 255; - } - else { - $exit_code = 0; - } - - _my_exit($exit_code) && return; - } - elsif( $self->{Skip_All} ) { - _my_exit(0) && return; - } - elsif($real_exit_code) { - $self->diag(<<"FAIL"); -Looks like your test exited with $real_exit_code before it could output anything. -FAIL - _my_exit($real_exit_code) && return; - } - else { - $self->diag("No tests run!\n"); - _my_exit(255) && return; - } - - $self->_whoa( 1, "We fell off the end of _ending()" ); -} - -END { - $Test->_ending if defined $Test and !$Test->no_ending; -} - -=head1 EXIT CODES - -If all your tests passed, Test::Builder will exit with zero (which is -normal). If anything failed it will exit with how many failed. If -you run less (or more) tests than you planned, the missing (or extras) -will be considered failures. If no tests were ever run Test::Builder -will throw a warning and exit with 255. If the test died, even after -having successfully completed all its tests, it will still be -considered a failure and will exit with 255. - -So the exit codes are... - - 0 all tests successful - 255 test died or all passed but wrong # of tests run - any other number how many failed (including missing or extras) - -If you fail more than 254 tests, it will be reported as 254. - -=head1 THREADS - -In perl 5.8.1 and later, Test::Builder is thread-safe. The test -number is shared amongst all threads. This means if one thread sets -the test number using C<current_test()> they will all be effected. - -While versions earlier than 5.8.1 had threads they contain too many -bugs to support. - -Test::Builder is only thread-aware if threads.pm is loaded I<before> -Test::Builder. - -=head1 MEMORY - -An informative hash, accessable 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) -combinatorics tests in the same run. - -In such cases, you are advised to either split the test file into smaller -ones, or use a reverse approach, doing "normal" (code) compares and -triggering fail() should anything go unexpected. - -Future versions of Test::Builder will have a way to turn history off. - - -=head1 EXAMPLES - -CPAN can provide the best examples. Test::Simple, Test::More, -Test::Exception and Test::Differences all use Test::Builder. - -=head1 SEE ALSO - -Test::Simple, Test::More, Test::Harness - -=head1 AUTHORS - -Original code by chromatic, maintained by Michael G Schwern -E<lt>schwern@pobox.comE<gt> - -=head1 COPYRIGHT - -Copyright 2002-2008 by chromatic E<lt>chromatic@wgz.orgE<gt> and - 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> - -=cut - -1; - diff --git a/lib/Test/Builder/Module.pm b/lib/Test/Builder/Module.pm deleted file mode 100644 index a2d8e5bb60..0000000000 --- a/lib/Test/Builder/Module.pm +++ /dev/null @@ -1,181 +0,0 @@ -package Test::Builder::Module; - -use strict; - -use Test::Builder; - -require Exporter; -our @ISA = qw(Exporter); - -our $VERSION = '0.92'; -$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) - -# 5.004's Exporter doesn't have export_to_level. -my $_export_to_level = sub { - my $pkg = shift; - my $level = shift; - (undef) = shift; # redundant arg - my $callpkg = caller($level); - $pkg->export( $callpkg, @_ ); -}; - -=head1 NAME - -Test::Builder::Module - Base class for test modules - -=head1 SYNOPSIS - - # Emulates Test::Simple - package Your::Module; - - my $CLASS = __PACKAGE__; - - use base 'Test::Builder::Module'; - @EXPORT = qw(ok); - - sub ok ($;$) { - my $tb = $CLASS->builder; - return $tb->ok(@_); - } - - 1; - - -=head1 DESCRIPTION - -This is a superclass for Test::Builder-based modules. It provides a -handful of common functionality and a method of getting at the underlying -Test::Builder object. - - -=head2 Importing - -Test::Builder::Module is a subclass of Exporter which means your -module is also a subclass of Exporter. @EXPORT, @EXPORT_OK, etc... -all act normally. - -A few methods are provided to do the C<use Your::Module tests => 23> part -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 -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)]>. - - use Your::Module import => [qw(this that)], tests => 23; - -says to import the functions this() and that() as well as set the plan -to be 23 tests. - -import() also sets the exported_to() attribute of your builder to be -the caller of the import() function. - -Additional behaviors can be added to your import() method by overriding -import_extra(). - -=cut - -sub import { - my($class) = shift; - - # Don't run all this when loading ourself. - return 1 if $class eq 'Test::Builder::Module'; - - my $test = $class->builder; - - my $caller = caller; - - $test->exported_to($caller); - - $class->import_extra( \@_ ); - my(@imports) = $class->_strip_imports( \@_ ); - - $test->plan(@_); - - $class->$_export_to_level( 1, $class, @imports ); -} - -sub _strip_imports { - my $class = shift; - my $list = shift; - - my @imports = (); - my @other = (); - my $idx = 0; - while( $idx <= $#{$list} ) { - my $item = $list->[$idx]; - - if( defined $item and $item eq 'import' ) { - push @imports, @{ $list->[ $idx + 1 ] }; - $idx++; - } - else { - push @other, $item; - } - - $idx++; - } - - @$list = @other; - - return @imports; -} - -=head3 import_extra - - Your::Module->import_extra(\@import_args); - -import_extra() is called by import(). It provides an opportunity for you -to add behaviors to your module based on its import list. - -Any extra arguments which shouldn't be passed on to plan() should be -stripped off by this method. - -See Test::More for an example of its use. - -B<NOTE> This mechanism is I<VERY ALPHA AND LIKELY TO CHANGE> as it -feels like a bit of an ugly hack in its current form. - -=cut - -sub import_extra { } - -=head2 Builder - -Test::Builder::Module provides some methods of getting at the underlying -Test::Builder object. - -=head3 builder - - my $builder = Your::Class->builder; - -This method returns the Test::Builder object associated with Your::Class. -It is not a constructor so you can call it as often as you like. - -This is the preferred way to get the Test::Builder object. You should -I<not> get it via C<< Test::Builder->new >> as was previously -recommended. - -The object returned by builder() may change at runtime so you should -call builder() inside each function rather than store it in a global. - - sub ok { - my $builder = Your::Class->builder; - - return $builder->ok(@_); - } - - -=cut - -sub builder { - return Test::Builder->new; -} - -1; diff --git a/lib/Test/Builder/Tester.pm b/lib/Test/Builder/Tester.pm deleted file mode 100644 index c019635584..0000000000 --- a/lib/Test/Builder/Tester.pm +++ /dev/null @@ -1,620 +0,0 @@ -package Test::Builder::Tester; - -use strict; -our $VERSION = "1.18"; - -use Test::Builder; -use Symbol; -use Carp; - -=head1 NAME - -Test::Builder::Tester - test testsuites that have been built with -Test::Builder - -=head1 SYNOPSIS - - use Test::Builder::Tester tests => 1; - use Test::More; - - test_out("not ok 1 - foo"); - test_fail(+1); - fail("foo"); - test_test("fail works"); - -=head1 DESCRIPTION - -A module that helps you test testing modules that are built with -B<Test::Builder>. - -The testing system is designed to be used by performing a three step -process for each test you wish to test. This process starts with using -C<test_out> and C<test_err> in advance to declare what the testsuite you -are testing will output with B<Test::Builder> to stdout and stderr. - -You then can run the test(s) from your test suite that call -B<Test::Builder>. At this point the output of B<Test::Builder> is -safely captured by B<Test::Builder::Tester> rather than being -interpreted as real test output. - -The final stage is to call C<test_test> that will simply compare what you -predeclared to what B<Test::Builder> actually outputted, and report the -results back with a "ok" or "not ok" (with debugging) to the normal -output. - -=cut - -#### -# set up testing -#### - -my $t = Test::Builder->new; - -### -# make us an exporter -### - -use Exporter; -our @ISA = qw(Exporter); - -our @EXPORT = qw(test_out test_err test_fail test_diag test_test line_num); - -# _export_to_level and import stolen directly from Test::More. I am -# the king of cargo cult programming ;-) - -# 5.004's Exporter doesn't have export_to_level. -sub _export_to_level { - my $pkg = shift; - my $level = shift; - (undef) = shift; # XXX redundant arg - my $callpkg = caller($level); - $pkg->export( $callpkg, @_ ); -} - -sub import { - my $class = shift; - my(@plan) = @_; - - my $caller = caller; - - $t->exported_to($caller); - $t->plan(@plan); - - my @imports = (); - foreach my $idx ( 0 .. $#plan ) { - if( $plan[$idx] eq 'import' ) { - @imports = @{ $plan[ $idx + 1 ] }; - last; - } - } - - __PACKAGE__->_export_to_level( 1, __PACKAGE__, @imports ); -} - -### -# set up file handles -### - -# create some private file handles -my $output_handle = gensym; -my $error_handle = gensym; - -# and tie them to this package -my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT"; -my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR"; - -#### -# exported functions -#### - -# for remembering that we're testing and where we're testing at -my $testing = 0; -my $testing_num; - -# remembering where the file handles were originally connected -my $original_output_handle; -my $original_failure_handle; -my $original_todo_handle; - -my $original_test_number; -my $original_harness_state; - -my $original_harness_env; - -# function that starts testing and redirects the filehandles for now -sub _start_testing { - # 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; - - # remember what the handles were set to - $original_output_handle = $t->output(); - $original_failure_handle = $t->failure_output(); - $original_todo_handle = $t->todo_output(); - - # switch out to our own handles - $t->output($output_handle); - $t->failure_output($error_handle); - $t->todo_output($error_handle); - - # clear the expected list - $out->reset(); - $err->reset(); - - # remeber that we're testing - $testing = 1; - $testing_num = $t->current_test; - $t->current_test(0); - - # look, we shouldn't do the ending stuff - $t->no_ending(1); -} - -=head2 Functions - -These are the six methods that are exported as default. - -=over 4 - -=item test_out - -=item test_err - -Procedures for predeclaring the output that your test suite is -expected to produce until C<test_test> is called. These procedures -automatically assume that each line terminates with "\n". So - - test_out("ok 1","ok 2"); - -is the same as - - test_out("ok 1\nok 2"); - -which is even the same as - - test_out("ok 1"); - 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 -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) - -=cut - -sub test_out { - # do we need to do any setup? - _start_testing() unless $testing; - - $out->expect(@_); -} - -sub test_err { - # do we need to do any setup? - _start_testing() unless $testing; - - $err->expect(@_); -} - -=item test_fail - -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 -than forcing you to call C<test_err> with the string all the time like -so - - test_err("# Failed test ($0 at line ".line_num(+1).")"); - -C<test_fail> exists as a convenience function that can be called -instead. It takes one argument, the offset from the current line that -the line that causes the fail is on. - - test_fail(+1); - -This means that the example in the synopsis could be rewritten -more simply as: - - test_out("not ok 1 - foo"); - test_fail(+1); - fail("foo"); - test_test("fail works"); - -=cut - -sub test_fail { - # do we need to do any setup? - _start_testing() unless $testing; - - # work out what line we should be on - my( $package, $filename, $line ) = caller; - $line = $line + ( shift() || 0 ); # prevent warnings - - # expect that on stderr - $err->expect("# Failed test ($0 at line $line)"); -} - -=item test_diag - -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 -C<test_err>. - -The C<test_diag> function prepends comment hashes and spacing to the -start and newlines to the end of the expected output passed to it and -adds it to the list of expected error output. So, instead of writing - - test_err("# Couldn't open file"); - -you can write - - test_diag("Couldn't open file"); - -Remember that B<Test::Builder>'s diag function will not add newlines to -the end of output and test_diag will. So to check - - Test::Builder->new->diag("foo\n","bar\n"); - -You would do - - test_diag("foo","bar") - -without the newlines. - -=cut - -sub test_diag { - # do we need to do any setup? - _start_testing() unless $testing; - - # expect the same thing, but prepended with "# " - local $_; - $err->expect( map { "# $_" } @_ ); -} - -=item test_test - -Actually performs the output check testing the tests, comparing the -data (with C<eq>) that we have captured from B<Test::Builder> against -that that was declared with C<test_out> and C<test_err>. - -This takes name/value pairs that effect how the test is run. - -=over - -=item title (synonym 'name', 'label') - -The name of the test that will be displayed after the C<ok> or C<not -ok>. - -=item skip_out - -Setting this to a true value will cause the test to ignore if the -output sent by the test to the output stream does not match that -declared with C<test_out>. - -=item skip_err - -Setting this to a true value will cause the test to ignore if the -output sent by the test to the error stream does not match that -declared with C<test_err>. - -=back - -As a convience, 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 -the original filehandles that B<Test::Builder> was connected to -(probably STDOUT and STDERR,) meaning any further tests you run -will function normally and cause success/errors for B<Test::Harness>. - -=cut - -sub test_test { - # decode the arguements as described in the pod - my $mess; - my %args; - if( @_ == 1 ) { - $mess = shift - } - else { - %args = @_; - $mess = $args{name} if exists( $args{name} ); - $mess = $args{title} if exists( $args{title} ); - $mess = $args{label} if exists( $args{label} ); - } - - # er, are we testing? - croak "Not testing. You must declare output with a test function first." - unless $testing; - - # okay, reconnect the test suite back to the saved handles - $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 - $t->current_test($testing_num); - $testing = 0; - - # re-enable the original setting of the harness - $ENV{HARNESS_ACTIVE} = $original_harness_env; - - # check the output we've stashed - unless( $t->ok( ( $args{skip_out} || $out->check ) && - ( $args{skip_err} || $err->check ), $mess ) - ) - { - # print out the diagnostic information about why this - # test failed - - local $_; - - $t->diag( map { "$_\n" } $out->complaint ) - unless $args{skip_out} || $out->check; - - $t->diag( map { "$_\n" } $err->complaint ) - unless $args{skip_err} || $err->check; - } -} - -=item line_num - -A utility function that returns the line number that the function was -called on. You can pass it an offset which will be added to the -result. This is very useful for working out the correct text of -diagnostic functions that contain line numbers. - -Essentially this is the same as the C<__LINE__> macro, but the -C<line_num(+3)> idiom is arguably nicer. - -=cut - -sub line_num { - my( $package, $filename, $line ) = caller; - return $line + ( shift() || 0 ); # prevent warnings -} - -=back - -In addition to the six exported functions there there exists one -function that can only be accessed with a fully qualified function -call. - -=over 4 - -=item color - -When C<test_test> is called and the output that your tests generate -does not match that which you declared, C<test_test> will print out -debug information showing the two conflicting versions. As this -output itself is debug information it can be confusing which part of -the output is from C<test_test> and which was the original output from -your original tests. Also, it may be hard to spot things like -extraneous whitespace at the end of lines that may cause your test to -fail even though the output looks similar. - -To assist you, if you have the B<Term::ANSIColor> module installed -(which you should do by default from perl 5.005 onwards), 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 part represents the text which is -the same between the executed and actual output, the red shows which -part differs. - -The C<color> function determines if colouring should occur or not. -Passing it a true or false value will enable or disable colouring -respectively, and the function called with no argument will return the -current setting. - -To enable colouring from the command line, you can use the -B<Text::Builder::Tester::Color> module like so: - - perl -Mlib=Text::Builder::Tester::Color test.t - -Or by including the B<Test::Builder::Tester::Color> module directly in -the PERL5LIB. - -=cut - -my $color; - -sub color { - $color = shift if @_; - $color; -} - -=back - -=head1 BUGS - -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 B<Term::ANSIColor> is installed -and is compatible with your terminal. - -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 AUTHOR - -Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002, 2004. - -Some code taken from B<Test::More> and B<Test::Catch>, written by by -Michael G Schwern E<lt>schwern@pobox.comE<gt>. Hence, those parts -Copyright Micheal G Schwern 2001. Used and distributed with -permission. - -This program is free software; you can redistribute it -and/or modify it under the same terms as Perl itself. - -=head1 NOTES - -This code has been tested explicitly on the following versions -of perl: 5.7.3, 5.6.1, 5.6.0, 5.005_03, 5.004_05 and 5.004. - -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 - -L<Test::Builder>, L<Test::Builder::Tester::Color>, L<Test::More>. - -=cut - -1; - -#################################################################### -# Helper class that is used to remember expected and received data - -package Test::Builder::Tester::Tie; - -## -# add line(s) to be expected - -sub expect { - my $self = shift; - - my @checks = @_; - foreach my $check (@checks) { - $check = $self->_translate_Failed_check($check); - push @{ $self->{wanted} }, ref $check ? $check : "$check\n"; - } -} - -sub _translate_Failed_check { - my( $self, $check ) = @_; - - if( $check =~ /\A(.*)# (Failed .*test) \((.*?) at line (\d+)\)\Z(?!\n)/ ) { - $check = "/\Q$1\E#\\s+\Q$2\E.*?\\n?.*?\Qat $3\E line \Q$4\E.*\\n?/"; - } - - return $check; -} - -## -# return true iff the expected data matches the got data - -sub check { - my $self = shift; - - # turn off warnings as these might be undef - local $^W = 0; - - my @checks = @{ $self->{wanted} }; - my $got = $self->{got}; - foreach my $check (@checks) { - $check = "\Q$check\E" unless( $check =~ s,^/(.*)/$,$1, or ref $check ); - return 0 unless $got =~ s/^$check//; - } - - return length $got == 0; -} - -## -# a complaint message about the inputs not matching (to be -# used for debugging messages) - -sub complaint { - my $self = shift; - my $type = $self->type; - my $got = $self->got; - my $wanted = join "\n", @{ $self->wanted }; - - # are we running in colour mode? - if(Test::Builder::Tester::color) { - # get color - eval { require Term::ANSIColor }; - unless($@) { - # colours - - my $green = Term::ANSIColor::color("black") . Term::ANSIColor::color("on_green"); - my $red = Term::ANSIColor::color("black") . Term::ANSIColor::color("on_red"); - my $reset = Term::ANSIColor::color("reset"); - - # work out where the two strings start to differ - my $char = 0; - $char++ while substr( $got, $char, 1 ) eq substr( $wanted, $char, 1 ); - - # get the start string and the two end strings - my $start = $green . substr( $wanted, 0, $char ); - my $gotend = $red . substr( $got, $char ) . $reset; - my $wantedend = $red . substr( $wanted, $char ) . $reset; - - # make the start turn green on and off - $start =~ s/\n/$reset\n$green/g; - - # make the ends turn red on and off - $gotend =~ s/\n/$reset\n$red/g; - $wantedend =~ s/\n/$reset\n$red/g; - - # rebuild the strings - $got = $start . $gotend; - $wanted = $start . $wantedend; - } - } - - return "$type is:\n" . "$got\nnot:\n$wanted\nas expected"; -} - -## -# forget all expected and got data - -sub reset { - my $self = shift; - %$self = ( - type => $self->{type}, - got => '', - wanted => [], - ); -} - -sub got { - my $self = shift; - return $self->{got}; -} - -sub wanted { - my $self = shift; - return $self->{wanted}; -} - -sub type { - my $self = shift; - return $self->{type}; -} - -### -# tie interface -### - -sub PRINT { - my $self = shift; - $self->{got} .= join '', @_; -} - -sub TIEHANDLE { - my( $class, $type ) = @_; - - my $self = bless { type => $type }, $class; - - $self->reset; - - return $self; -} - -sub READ { } -sub READLINE { } -sub GETC { } -sub FILENO { } - -1; diff --git a/lib/Test/Builder/Tester/Color.pm b/lib/Test/Builder/Tester/Color.pm deleted file mode 100644 index 264fddbfd8..0000000000 --- a/lib/Test/Builder/Tester/Color.pm +++ /dev/null @@ -1,51 +0,0 @@ -package Test::Builder::Tester::Color; - -use strict; -our $VERSION = "1.18"; - -require Test::Builder::Tester; - - -=head1 NAME - -Test::Builder::Tester::Color - turn on colour in Test::Builder::Tester - -=head1 SYNOPSIS - - When running a test script - - perl -MTest::Builder::Tester::Color test.t - -=head1 DESCRIPTION - -Importing this module causes the subroutine color in Test::Builder::Tester -to be called with a true value causing colour highlighting to be turned -on in debug output. - -The sole purpose of this module is to enable colour highlighting -from the command line. - -=cut - -sub import { - Test::Builder::Tester::color(1); -} - -=head1 AUTHOR - -Copyright Mark Fowler E<lt>mark@twoshortplanks.comE<gt> 2002. - -This program is free software; you can redistribute it -and/or modify it under the same terms as Perl itself. - -=head1 BUGS - -This module will have no effect unless Term::ANSIColor is installed. - -=head1 SEE ALSO - -L<Test::Builder::Tester>, L<Term::ANSIColor> - -=cut - -1; diff --git a/lib/Test/More.pm b/lib/Test/More.pm deleted file mode 100644 index aaf6d8721b..0000000000 --- a/lib/Test/More.pm +++ /dev/null @@ -1,1737 +0,0 @@ -package Test::More; - -use 5.006; -use strict; -use warnings; - -#---- perlcritic exemptions. ----# - -# We use a lot of subroutine prototypes -## no critic (Subroutines::ProhibitSubroutinePrototypes) - -# Can't use Carp because it might cause use_ok() to accidentally succeed -# even though the module being used forgot to use Carp. Yes, this -# actually happened. -sub _carp { - my( $file, $line ) = ( caller(1) )[ 1, 2 ]; - return warn @_, " at $file line $line\n"; -} - -our $VERSION = '0.92'; -$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) - -use Test::Builder::Module; -our @ISA = qw(Test::Builder::Module); -our @EXPORT = qw(ok use_ok require_ok - is isnt like unlike is_deeply - cmp_ok - skip todo todo_skip - pass fail - eq_array eq_hash eq_set - $TODO - plan - done_testing - can_ok isa_ok new_ok - diag note explain - BAIL_OUT -); - -=head1 NAME - -Test::More - yet another framework for writing test scripts - -=head1 SYNOPSIS - - use Test::More tests => 23; - # or - use Test::More skip_all => $reason; - # or - use Test::More; # see done_testing() - - BEGIN { use_ok( 'Some::Module' ); } - require_ok( 'Some::Module' ); - - # Various ways to say "ok" - ok($got eq $expected, $test_name); - - is ($got, $expected, $test_name); - isnt($got, $expected, $test_name); - - # Rather than print STDERR "# here's what went wrong\n" - diag("here's what went wrong"); - - like ($got, qr/expected/, $test_name); - unlike($got, qr/expected/, $test_name); - - cmp_ok($got, '==', $expected, $test_name); - - is_deeply($got_complex_structure, $expected_complex_structure, $test_name); - - SKIP: { - skip $why, $how_many unless $have_some_feature; - - ok( foo(), $test_name ); - is( foo(42), 23, $test_name ); - }; - - TODO: { - local $TODO = $why; - - ok( foo(), $test_name ); - is( foo(42), 23, $test_name ); - }; - - can_ok($module, @methods); - isa_ok($object, $class); - - pass($test_name); - fail($test_name); - - BAIL_OUT($why); - - # UNIMPLEMENTED!!! - my @status = Test::More::status; - - -=head1 DESCRIPTION - -B<STOP!> If you're just getting started writing tests, have a look at -L<Test::Simple> first. This is a drop in replacement for Test::Simple -which you can switch to once you get the hang of basic testing. - -The purpose of this module is to provide a wide range of testing -utilities. Various ways to say "ok" with better diagnostics, -facilities to skip tests, test future features and compare complicated -data structures. While you can do almost anything with a simple -C<ok()> function, it doesn't provide good diagnostic output. - - -=head2 I love it when a plan comes together - -Before anything else, you need a testing plan. This basically declares -how many tests your script is going to run to protect against premature -failure. - -The preferred way to do this is to declare a plan when you C<use Test::More>. - - use Test::More tests => 23; - -There are cases when you will not know beforehand how many tests your -script is going to run. In this case, you can declare your tests at -the end. - - use Test::More; - - ... run your tests ... - - done_testing( $number_of_tests_run ); - -Sometimes you really don't know how many tests were run, or it's too -difficult to calculate. In which case you can leave off -$number_of_tests_run. - -In some cases, you'll want to completely skip an entire testing script. - - use Test::More skip_all => $skip_reason; - -Your script will declare a skip with the reason why you skipped and -exit immediately with a zero (success). See L<Test::Harness> for -details. - -If you want to control what functions Test::More will export, you -have to use the 'import' option. For example, to import everything -but 'fail', you'd do: - - use Test::More tests => 23, import => ['!fail']; - -Alternatively, you can use the plan() function. Useful for when you -have to calculate the number of tests. - - use Test::More; - plan tests => keys %Stuff * 3; - -or for deciding between running the tests at all: - - use Test::More; - if( $^O eq 'MacOS' ) { - plan skip_all => 'Test irrelevant on MacOS'; - } - else { - plan tests => 42; - } - -=cut - -sub plan { - my $tb = Test::More->builder; - - return $tb->plan(@_); -} - -# This implements "use Test::More 'no_diag'" but the behavior is -# deprecated. -sub import_extra { - my $class = shift; - my $list = shift; - - my @other = (); - my $idx = 0; - while( $idx <= $#{$list} ) { - my $item = $list->[$idx]; - - if( defined $item and $item eq 'no_diag' ) { - $class->builder->no_diag(1); - } - else { - push @other, $item; - } - - $idx++; - } - - @$list = @other; - - return; -} - -=over 4 - -=item B<done_testing> - - done_testing(); - done_testing($number_of_tests); - -If you don't know how many tests you're going to run, you can issue -the plan when you're done running tests. - -$number_of_tests is the same as plan(), it's the number of tests you -expected to run. You can omit this, in which case the number of tests -you ran doesn't matter, just the fact that your tests ran to -conclusion. - -This is safer than and replaces the "no_plan" plan. - -=back - -=cut - -sub done_testing { - my $tb = Test::More->builder; - $tb->done_testing(@_); -} - -=head2 Test names - -By convention, each test is assigned a number in order. This is -largely done automatically for you. However, it's often very useful to -assign a name to each test. Which would you rather see: - - ok 4 - not ok 5 - ok 6 - -or - - ok 4 - basic multi-variable - not ok 5 - simple exponential - ok 6 - force == mass * acceleration - -The later gives you some idea of what failed. It also makes it easier -to find the test in your script, simply search for "simple -exponential". - -All test functions take a name argument. It's optional, but highly -suggested that you use it. - - -=head2 I'm ok, you're not ok. - -The basic purpose of this module is to print out either "ok #" or "not -ok #" depending on if a given test succeeded or failed. Everything -else is just gravy. - -All of the following print "ok" or "not ok" depending on if the test -succeeded or failed. They all also return true or false, -respectively. - -=over 4 - -=item B<ok> - - ok($got eq $expected, $test_name); - -This simply evaluates any expression (C<$got eq $expected> is just a -simple example) and uses that to determine if the test succeeded or -failed. A true expression passes, a false one fails. Very simple. - -For example: - - ok( $exp{9} == 81, 'simple exponential' ); - ok( Film->can('db_Main'), 'set_db()' ); - ok( $p->tests == 4, 'saw tests' ); - ok( !grep !defined $_, @items, 'items populated' ); - -(Mnemonic: "This is ok.") - -$test_name is a very short description of the test that will be printed -out. It makes it very easy to find a test in your script when it fails -and gives others an idea of your intentions. $test_name is optional, -but we B<very> strongly encourage its use. - -Should an ok() fail, it will produce some diagnostics: - - not ok 18 - sufficient mucus - # Failed test 'sufficient mucus' - # in foo.t at line 42. - -This is the same as Test::Simple's ok() routine. - -=cut - -sub ok ($;$) { - my( $test, $name ) = @_; - my $tb = Test::More->builder; - - return $tb->ok( $test, $name ); -} - -=item B<is> - -=item B<isnt> - - is ( $got, $expected, $test_name ); - isnt( $got, $expected, $test_name ); - -Similar to ok(), is() and isnt() compare their two arguments -with C<eq> and C<ne> respectively and use the result of that to -determine if the test succeeded or failed. So these: - - # Is the ultimate answer 42? - is( ultimate_answer(), 42, "Meaning of Life" ); - - # $foo isn't empty - isnt( $foo, '', "Got some foo" ); - -are similar to these: - - ok( ultimate_answer() eq 42, "Meaning of Life" ); - ok( $foo ne '', "Got some foo" ); - -(Mnemonic: "This is that." "This isn't that.") - -So why use these? They produce better diagnostics on failure. ok() -cannot know what you are testing for (beyond the name), but is() and -isnt() know what the test was and why it failed. For example this -test: - - my $foo = 'waffle'; my $bar = 'yarblokos'; - is( $foo, $bar, 'Is foo the same as bar?' ); - -Will produce something like this: - - not ok 17 - Is foo the same as bar? - # Failed test 'Is foo the same as bar?' - # in foo.t at line 139. - # got: 'waffle' - # expected: 'yarblokos' - -So you can figure out what went wrong without rerunning the test. - -You are encouraged to use is() and isnt() over ok() where possible, -however do not be tempted to use them to find out if something is -true or false! - - # XXX BAD! - is( exists $brooklyn{tree}, 1, 'A tree grows in Brooklyn' ); - -This does not check if C<exists $brooklyn{tree}> is true, it checks if -it returns 1. Very different. Similar caveats exist for false and 0. -In these cases, use ok(). - - ok( exists $brooklyn{tree}, 'A tree grows in Brooklyn' ); - -A simple call to isnt() usually does not provide a strong test but there -are cases when you cannot say much more about a value than that it is -different from some other value: - - new_ok $obj, "Foo"; - - my $clone = $obj->clone; - isa_ok $obj, "Foo", "Foo->clone"; - - isnt $obj, $clone, "clone() produces a different object"; - -For those grammatical pedants out there, there's an C<isn't()> -function which is an alias of isnt(). - -=cut - -sub is ($$;$) { - my $tb = Test::More->builder; - - return $tb->is_eq(@_); -} - -sub isnt ($$;$) { - my $tb = Test::More->builder; - - return $tb->isnt_eq(@_); -} - -*isn't = \&isnt; - -=item B<like> - - like( $got, qr/expected/, $test_name ); - -Similar to ok(), like() matches $got against the regex C<qr/expected/>. - -So this: - - like($got, qr/expected/, 'this is like that'); - -is similar to: - - ok( $got =~ /expected/, 'this is like that'); - -(Mnemonic "This is like that".) - -The second argument is a regular expression. It may be given as a -regex reference (i.e. C<qr//>) or (for better compatibility with older -perls) as a string that looks like a regex (alternative delimiters are -currently not supported): - - like( $got, '/expected/', 'this is like that' ); - -Regex options may be placed on the end (C<'/expected/i'>). - -Its advantages over ok() are similar to that of is() and isnt(). Better -diagnostics on failure. - -=cut - -sub like ($$;$) { - my $tb = Test::More->builder; - - return $tb->like(@_); -} - -=item B<unlike> - - unlike( $got, qr/expected/, $test_name ); - -Works exactly as like(), only it checks if $got B<does not> match the -given pattern. - -=cut - -sub unlike ($$;$) { - my $tb = Test::More->builder; - - return $tb->unlike(@_); -} - -=item B<cmp_ok> - - cmp_ok( $got, $op, $expected, $test_name ); - -Halfway between ok() and is() lies cmp_ok(). This allows you to -compare two arguments using any binary perl operator. - - # ok( $got eq $expected ); - cmp_ok( $got, 'eq', $expected, 'this eq that' ); - - # ok( $got == $expected ); - cmp_ok( $got, '==', $expected, 'this == that' ); - - # ok( $got && $expected ); - cmp_ok( $got, '&&', $expected, 'this && that' ); - ...etc... - -Its advantage over ok() is when the test fails you'll know what $got -and $expected were: - - not ok 1 - # Failed test in foo.t at line 12. - # '23' - # && - # undef - -It's also useful in those cases where you are comparing numbers and -is()'s use of C<eq> will interfere: - - cmp_ok( $big_hairy_number, '==', $another_big_hairy_number ); - -It's especially useful when comparing greater-than or smaller-than -relation between values: - - cmp_ok( $some_value, '<=', $upper_limit ); - - -=cut - -sub cmp_ok($$$;$) { - my $tb = Test::More->builder; - - return $tb->cmp_ok(@_); -} - -=item B<can_ok> - - can_ok($module, @methods); - can_ok($object, @methods); - -Checks to make sure the $module or $object can do these @methods -(works with functions, too). - - can_ok('Foo', qw(this that whatever)); - -is almost exactly like saying: - - ok( Foo->can('this') && - Foo->can('that') && - Foo->can('whatever') - ); - -only without all the typing and with a better interface. Handy for -quickly testing an interface. - -No matter how many @methods you check, a single can_ok() call counts -as one test. If you desire otherwise, use: - - foreach my $meth (@methods) { - can_ok('Foo', $meth); - } - -=cut - -sub can_ok ($@) { - my( $proto, @methods ) = @_; - my $class = ref $proto || $proto; - my $tb = Test::More->builder; - - unless($class) { - my $ok = $tb->ok( 0, "->can(...)" ); - $tb->diag(' can_ok() called with empty class or reference'); - return $ok; - } - - unless(@methods) { - my $ok = $tb->ok( 0, "$class->can(...)" ); - $tb->diag(' can_ok() called with no methods'); - return $ok; - } - - my @nok = (); - foreach my $method (@methods) { - $tb->_try( sub { $proto->can($method) } ) or push @nok, $method; - } - - my $name = (@methods == 1) ? "$class->can('$methods[0]')" : - "$class->can(...)" ; - - my $ok = $tb->ok( !@nok, $name ); - - $tb->diag( map " $class->can('$_') failed\n", @nok ); - - return $ok; -} - -=item B<isa_ok> - - isa_ok($object, $class, $object_name); - isa_ok($subclass, $class, $object_name); - isa_ok($ref, $type, $ref_name); - -Checks to see if the given C<< $object->isa($class) >>. Also checks to make -sure the object was defined in the first place. Handy for this sort -of thing: - - my $obj = Some::Module->new; - isa_ok( $obj, 'Some::Module' ); - -where you'd otherwise have to write - - my $obj = Some::Module->new; - ok( defined $obj && $obj->isa('Some::Module') ); - -to safeguard against your test script blowing up. - -You can also test a class, to make sure that it has the right ancestor: - - isa_ok( 'Vole', 'Rodent' ); - -It works on references, too: - - isa_ok( $array_ref, 'ARRAY' ); - -The diagnostics of this test normally just refer to 'the object'. If -you'd like them to be more specific, you can supply an $object_name -(for example 'Test customer'). - -=cut - -sub isa_ok ($$;$) { - my( $object, $class, $obj_name ) = @_; - my $tb = Test::More->builder; - - my $diag; - - if( !defined $object ) { - $obj_name = 'The thing' unless defined $obj_name; - $diag = "$obj_name isn't defined"; - } - else { - my $whatami = ref $object ? 'object' : 'class'; - # We can't use UNIVERSAL::isa because we want to honor isa() overrides - my( $rslt, $error ) = $tb->_try( sub { $object->isa($class) } ); - if($error) { - if( $error =~ /^Can't call method "isa" on unblessed reference/ ) { - # Its an unblessed reference - $obj_name = 'The reference' unless defined $obj_name; - if( !UNIVERSAL::isa( $object, $class ) ) { - my $ref = ref $object; - $diag = "$obj_name isn't a '$class' it's a '$ref'"; - } - } - elsif( $error =~ /Can't call method "isa" without a package/ ) { - # It's something that can't even be a class - $diag = "$obj_name isn't a class or reference"; - } - else { - die <<WHOA; -WHOA! I tried to call ->isa on your $whatami and got some weird error. -Here's the error. -$error -WHOA - } - } - else { - $obj_name = "The $whatami" unless defined $obj_name; - if( !$rslt ) { - my $ref = ref $object; - $diag = "$obj_name isn't a '$class' it's a '$ref'"; - } - } - } - - my $name = "$obj_name isa $class"; - my $ok; - if($diag) { - $ok = $tb->ok( 0, $name ); - $tb->diag(" $diag\n"); - } - else { - $ok = $tb->ok( 1, $name ); - } - - return $ok; -} - -=item B<new_ok> - - my $obj = new_ok( $class ); - my $obj = new_ok( $class => \@args ); - my $obj = new_ok( $class => \@args, $object_name ); - -A convenience function which combines creating an object and calling -isa_ok() on that object. - -It is basically equivalent to: - - my $obj = $class->new(@args); - isa_ok $obj, $class, $object_name; - -If @args is not given, an empty list will be used. - -This function only works on new() and it assumes new() will return -just a single object which isa C<$class>. - -=cut - -sub new_ok { - my $tb = Test::More->builder; - $tb->croak("new_ok() must be given at least a class") unless @_; - - my( $class, $args, $object_name ) = @_; - - $args ||= []; - $object_name = "The object" unless defined $object_name; - - my $obj; - my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } ); - if($success) { - local $Test::Builder::Level = $Test::Builder::Level + 1; - isa_ok $obj, $class, $object_name; - } - else { - $tb->ok( 0, "new() died" ); - $tb->diag(" Error was: $error"); - } - - return $obj; -} - -=item B<pass> - -=item B<fail> - - pass($test_name); - fail($test_name); - -Sometimes you just want to say that the tests have passed. Usually -the case is you've got some complicated condition that is difficult to -wedge into an ok(). In this case, you can simply use pass() (to -declare the test ok) or fail (for not ok). They are synonyms for -ok(1) and ok(0). - -Use these very, very, very sparingly. - -=cut - -sub pass (;$) { - my $tb = Test::More->builder; - - return $tb->ok( 1, @_ ); -} - -sub fail (;$) { - my $tb = Test::More->builder; - - return $tb->ok( 0, @_ ); -} - -=back - - -=head2 Module tests - -You usually want to test if the module you're testing loads ok, rather -than just vomiting if its load fails. For such purposes we have -C<use_ok> and C<require_ok>. - -=over 4 - -=item B<use_ok> - - BEGIN { use_ok($module); } - BEGIN { use_ok($module, @imports); } - -These simply use the given $module and test to make sure the load -happened ok. It's recommended that you run use_ok() inside a BEGIN -block so its functions are exported at compile-time and prototypes are -properly honored. - -If @imports are given, they are passed through to the use. So this: - - BEGIN { use_ok('Some::Module', qw(foo bar)) } - -is like doing this: - - use Some::Module qw(foo bar); - -Version numbers can be checked like so: - - # Just like "use Some::Module 1.02" - BEGIN { use_ok('Some::Module', 1.02) } - -Don't try to do this: - - BEGIN { - use_ok('Some::Module'); - - ...some code that depends on the use... - ...happening at compile time... - } - -because the notion of "compile-time" is relative. Instead, you want: - - BEGIN { use_ok('Some::Module') } - BEGIN { ...some code that depends on the use... } - - -=cut - -sub use_ok ($;@) { - my( $module, @imports ) = @_; - @imports = () unless @imports; - my $tb = Test::More->builder; - - my( $pack, $filename, $line ) = caller; - - my $code; - if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) { - # probably a version check. Perl needs to see the bare number - # for it to work with non-Exporter based modules. - $code = <<USE; -package $pack; -use $module $imports[0]; -1; -USE - } - else { - $code = <<USE; -package $pack; -use $module \@{\$args[0]}; -1; -USE - } - - my( $eval_result, $eval_error ) = _eval( $code, \@imports ); - my $ok = $tb->ok( $eval_result, "use $module;" ); - - unless($ok) { - chomp $eval_error; - $@ =~ s{^BEGIN failed--compilation aborted at .*$} - {BEGIN failed--compilation aborted at $filename line $line.}m; - $tb->diag(<<DIAGNOSTIC); - Tried to use '$module'. - Error: $eval_error -DIAGNOSTIC - - } - - return $ok; -} - -sub _eval { - my( $code, @args ) = @_; - - # Work around oddities surrounding resetting of $@ by immediately - # storing it. - my( $sigdie, $eval_result, $eval_error ); - { - local( $@, $!, $SIG{__DIE__} ); # isolate eval - $eval_result = eval $code; ## no critic (BuiltinFunctions::ProhibitStringyEval) - $eval_error = $@; - $sigdie = $SIG{__DIE__} || undef; - } - # make sure that $code got a chance to set $SIG{__DIE__} - $SIG{__DIE__} = $sigdie if defined $sigdie; - - return( $eval_result, $eval_error ); -} - -=item B<require_ok> - - require_ok($module); - require_ok($file); - -Like use_ok(), except it requires the $module or $file. - -=cut - -sub require_ok ($) { - my($module) = shift; - my $tb = Test::More->builder; - - my $pack = caller; - - # Try to deterine 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); - - my $code = <<REQUIRE; -package $pack; -require $module; -1; -REQUIRE - - my( $eval_result, $eval_error ) = _eval($code); - my $ok = $tb->ok( $eval_result, "require $module;" ); - - unless($ok) { - chomp $eval_error; - $tb->diag(<<DIAGNOSTIC); - Tried to require '$module'. - Error: $eval_error -DIAGNOSTIC - - } - - return $ok; -} - -sub _is_module_name { - my $module = shift; - - # Module names start with a letter. - # End with an alphanumeric. - # The rest is an alphanumeric or :: - $module =~ s/\b::\b//g; - - return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0; -} - -=back - - -=head2 Complex data structures - -Not everything is a simple eq check or regex. There are times you -need to see if two data structures are equivalent. For these -instances Test::More provides a handful of useful functions. - -B<NOTE> I'm not quite sure what will happen with filehandles. - -=over 4 - -=item B<is_deeply> - - is_deeply( $got, $expected, $test_name ); - -Similar to is(), except that if $got and $expected are references, it -does a deep comparison walking each data structure to see if they are -equivalent. If the two structures are different, it will display the -place where they start differing. - -is_deeply() compares the dereferenced values of references, the -references themselves (except for their type) are ignored. This means -aspects such as blessing and ties are not considered "different". - -is_deeply() currently has very limited handling of function reference -and globs. It merely checks if they have the same referent. This may -improve in the future. - -L<Test::Differences> and L<Test::Deep> provide more in-depth functionality -along these lines. - -=cut - -our( @Data_Stack, %Refs_Seen ); -my $DNE = bless [], 'Does::Not::Exist'; - -sub _dne { - return ref $_[0] eq ref $DNE; -} - -## no critic (Subroutines::RequireArgUnpacking) -sub is_deeply { - my $tb = Test::More->builder; - - unless( @_ == 2 or @_ == 3 ) { - my $msg = <<'WARNING'; -is_deeply() takes two or three args, you gave %d. -This usually means you passed an array or hash instead -of a reference to it -WARNING - chop $msg; # clip off newline so carp() will put in line/file - - _carp sprintf $msg, scalar @_; - - return $tb->ok(0); - } - - my( $got, $expected, $name ) = @_; - - $tb->_unoverload_str( \$expected, \$got ); - - my $ok; - if( !ref $got and !ref $expected ) { # neither is a reference - $ok = $tb->is_eq( $got, $expected, $name ); - } - elsif( !ref $got xor !ref $expected ) { # one's a reference, one isn't - $ok = $tb->ok( 0, $name ); - $tb->diag( _format_stack({ vals => [ $got, $expected ] }) ); - } - else { # both references - local @Data_Stack = (); - if( _deep_check( $got, $expected ) ) { - $ok = $tb->ok( 1, $name ); - } - else { - $ok = $tb->ok( 0, $name ); - $tb->diag( _format_stack(@Data_Stack) ); - } - } - - return $ok; -} - -sub _format_stack { - my(@Stack) = @_; - - my $var = '$FOO'; - my $did_arrow = 0; - foreach my $entry (@Stack) { - my $type = $entry->{type} || ''; - my $idx = $entry->{'idx'}; - if( $type eq 'HASH' ) { - $var .= "->" unless $did_arrow++; - $var .= "{$idx}"; - } - elsif( $type eq 'ARRAY' ) { - $var .= "->" unless $did_arrow++; - $var .= "[$idx]"; - } - elsif( $type eq 'REF' ) { - $var = "\${$var}"; - } - } - - my @vals = @{ $Stack[-1]{vals} }[ 0, 1 ]; - my @vars = (); - ( $vars[0] = $var ) =~ s/\$FOO/ \$got/; - ( $vars[1] = $var ) =~ s/\$FOO/\$expected/; - - my $out = "Structures begin differing at:\n"; - foreach my $idx ( 0 .. $#vals ) { - my $val = $vals[$idx]; - $vals[$idx] - = !defined $val ? 'undef' - : _dne($val) ? "Does not exist" - : ref $val ? "$val" - : "'$val'"; - } - - $out .= "$vars[0] = $vals[0]\n"; - $out .= "$vars[1] = $vals[1]\n"; - - $out =~ s/^/ /msg; - return $out; -} - -sub _type { - my $thing = shift; - - return '' if !ref $thing; - - for my $type (qw(ARRAY HASH REF SCALAR GLOB CODE Regexp)) { - return $type if UNIVERSAL::isa( $thing, $type ); - } - - return ''; -} - -=back - - -=head2 Diagnostics - -If you pick the right test function, you'll usually get a good idea of -what went wrong when it failed. But sometimes it doesn't work out -that way. So here we have ways for you to write your own diagnostic -messages which are safer than just C<print STDERR>. - -=over 4 - -=item B<diag> - - diag(@diagnostic_message); - -Prints a diagnostic message which is guaranteed not to interfere with -test output. Like C<print> @diagnostic_message is simply concatenated -together. - -Returns false, so as to preserve failure. - -Handy for this sort of thing: - - ok( grep(/foo/, @users), "There's a foo user" ) or - diag("Since there's no foo, check that /etc/bar is set up right"); - -which would produce: - - not ok 42 - There's a foo user - # Failed test 'There's a foo user' - # in foo.t at line 52. - # Since there's no foo, check that /etc/bar is set up right. - -You might remember C<ok() or diag()> with the mnemonic C<open() or -die()>. - -B<NOTE> The exact formatting of the diagnostic output is still -changing, but it is guaranteed that whatever you throw at it it won't -interfere with the test. - -=item B<note> - - note(@diagnostic_message); - -Like diag(), except the message will not be seen when the test is run -in a harness. It will only be visible in the verbose TAP stream. - -Handy for putting in notes which might be useful for debugging, but -don't indicate a problem. - - note("Tempfile is $tempfile"); - -=cut - -sub diag { - return Test::More->builder->diag(@_); -} - -sub note { - return Test::More->builder->note(@_); -} - -=item B<explain> - - my @dump = explain @diagnostic_message; - -Will dump the contents of any references in a human readable format. -Usually you want to pass this into C<note> or C<diag>. - -Handy for things like... - - is_deeply($have, $want) || diag explain $have; - -or - - note explain \%args; - Some::Class->method(%args); - -=cut - -sub explain { - return Test::More->builder->explain(@_); -} - -=back - - -=head2 Conditional tests - -Sometimes running a test under certain conditions will cause the -test script to die. A certain function or method isn't implemented -(such as fork() on MacOS), some resource isn't available (like a -net connection) or a module isn't available. In these cases it's -necessary to skip tests, or declare that they are supposed to fail -but will work in the future (a todo test). - -For more details on the mechanics of skip and todo tests see -L<Test::Harness>. - -The way Test::More handles this is with a named block. Basically, a -block of tests which can be skipped over or made todo. It's best if I -just show you... - -=over 4 - -=item B<SKIP: BLOCK> - - SKIP: { - skip $why, $how_many if $condition; - - ...normal testing code goes here... - } - -This declares a block of tests that might be skipped, $how_many tests -there are, $why and under what $condition to skip them. An example is -the easiest way to illustrate: - - SKIP: { - eval { require HTML::Lint }; - - skip "HTML::Lint not installed", 2 if $@; - - my $lint = new HTML::Lint; - isa_ok( $lint, "HTML::Lint" ); - - $lint->parse( $html ); - is( $lint->errors, 0, "No errors found in HTML" ); - } - -If the user does not have HTML::Lint installed, the whole block of -code I<won't be run at all>. Test::More will output special ok's -which Test::Harness interprets as skipped, but passing, tests. - -It's important that $how_many accurately reflects the number of tests -in the SKIP block so the # of tests run will match up with your plan. -If your plan is C<no_plan> $how_many is optional and will default to 1. - -It's perfectly safe to nest SKIP blocks. Each SKIP block must have -the label C<SKIP>, or Test::More can't work its magic. - -You don't skip tests which are failing because there's a bug in your -program, or for which you don't yet have code written. For that you -use TODO. Read on. - -=cut - -## no critic (Subroutines::RequireFinalReturn) -sub skip { - my( $why, $how_many ) = @_; - my $tb = Test::More->builder; - - unless( defined $how_many ) { - # $how_many can only be avoided when no_plan is in use. - _carp "skip() needs to know \$how_many tests are in the block" - unless $tb->has_plan eq 'no_plan'; - $how_many = 1; - } - - if( defined $how_many and $how_many =~ /\D/ ) { - _carp - "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?"; - $how_many = 1; - } - - for( 1 .. $how_many ) { - $tb->skip($why); - } - - no warnings 'exiting'; - last SKIP; -} - -=item B<TODO: BLOCK> - - TODO: { - local $TODO = $why if $condition; - - ...normal testing code goes here... - } - -Declares a block of tests you expect to fail and $why. Perhaps it's -because you haven't fixed a bug or haven't finished a new feature: - - TODO: { - local $TODO = "URI::Geller not finished"; - - my $card = "Eight of clubs"; - is( URI::Geller->your_card, $card, 'Is THIS your card?' ); - - my $spoon; - URI::Geller->bend_spoon; - is( $spoon, 'bent', "Spoon bending, that's original" ); - } - -With a todo block, the tests inside are expected to fail. Test::More -will run the tests normally, but print out special flags indicating -they are "todo". Test::Harness will interpret failures as being ok. -Should anything succeed, it will report it as an unexpected success. -You then know the thing you had todo is done and can remove the -TODO flag. - -The nice part about todo tests, as opposed to simply commenting out a -block of tests, is it's like having a programmatic todo list. You know -how much work is left to be done, you're aware of what bugs there are, -and you'll know immediately when they're fixed. - -Once a todo test starts succeeding, simply move it outside the block. -When the block is empty, delete it. - -B<NOTE>: TODO tests require a Test::Harness upgrade else it will -treat it as a normal failure. See L<CAVEATS and NOTES>). - - -=item B<todo_skip> - - TODO: { - todo_skip $why, $how_many if $condition; - - ...normal testing code... - } - -With todo tests, it's best to have the tests actually run. That way -you'll know when they start passing. Sometimes this isn't possible. -Often a failing test will cause the whole program to die or hang, even -inside an C<eval BLOCK> with and using C<alarm>. In these extreme -cases you have no choice but to skip over the broken tests entirely. - -The syntax and behavior is similar to a C<SKIP: BLOCK> except the -tests will be marked as failing but todo. Test::Harness will -interpret them as passing. - -=cut - -sub todo_skip { - my( $why, $how_many ) = @_; - my $tb = Test::More->builder; - - unless( defined $how_many ) { - # $how_many can only be avoided when no_plan is in use. - _carp "todo_skip() needs to know \$how_many tests are in the block" - unless $tb->has_plan eq 'no_plan'; - $how_many = 1; - } - - for( 1 .. $how_many ) { - $tb->todo_skip($why); - } - - no warnings 'exiting'; - last TODO; -} - -=item When do I use SKIP vs. TODO? - -B<If it's something the user might not be able to do>, use SKIP. -This includes optional modules that aren't installed, running under -an OS that doesn't have some feature (like fork() or symlinks), or maybe -you need an Internet connection and one isn't available. - -B<If it's something the programmer hasn't done yet>, use TODO. This -is for any code you haven't written yet, or bugs you have yet to fix, -but want to put tests in your testing script (always a good idea). - - -=back - - -=head2 Test control - -=over 4 - -=item B<BAIL_OUT> - - 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. - -This is typically used when testing cannot continue such as a critical -module failing to compile or a necessary external utility not being -available such as a database connection failing. - -The test will exit with 255. - -For even better control look at L<Test::Most>. - -=cut - -sub BAIL_OUT { - my $reason = shift; - my $tb = Test::More->builder; - - $tb->BAIL_OUT($reason); -} - -=back - - -=head2 Discouraged comparison functions - -The use of the following functions is discouraged as they are not -actually testing functions and produce no diagnostics to help figure -out what went wrong. They were written before is_deeply() existed -because I couldn't figure out how to display a useful diff of two -arbitrary data structures. - -These functions are usually used inside an ok(). - - ok( eq_array(\@got, \@expected) ); - -C<is_deeply()> can do that better and with diagnostics. - - is_deeply( \@got, \@expected ); - -They may be deprecated in future versions. - -=over 4 - -=item B<eq_array> - - my $is_eq = eq_array(\@got, \@expected); - -Checks if two arrays are equivalent. This is a deep check, so -multi-level structures are handled correctly. - -=cut - -#'# -sub eq_array { - local @Data_Stack = (); - _deep_check(@_); -} - -sub _eq_array { - my( $a1, $a2 ) = @_; - - if( grep _type($_) ne 'ARRAY', $a1, $a2 ) { - warn "eq_array passed a non-array ref"; - return 0; - } - - return 1 if $a1 eq $a2; - - my $ok = 1; - my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2; - for( 0 .. $max ) { - my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_]; - my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_]; - - push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [ $e1, $e2 ] }; - $ok = _deep_check( $e1, $e2 ); - pop @Data_Stack if $ok; - - last unless $ok; - } - - return $ok; -} - -sub _deep_check { - my( $e1, $e2 ) = @_; - my $tb = Test::More->builder; - - my $ok = 0; - - # Effectively turn %Refs_Seen into a stack. This avoids picking up - # the same referenced used twice (such as [\$a, \$a]) to be considered - # circular. - 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. - my $same_ref = !( !ref $e1 xor !ref $e2 ); - my $not_ref = ( !ref $e1 and !ref $e2 ); - - if( defined $e1 xor defined $e2 ) { - $ok = 0; - } - elsif( !defined $e1 and !defined $e2 ) { - # Shortcut if they're both defined. - $ok = 1; - } - elsif( _dne($e1) xor _dne($e2) ) { - $ok = 0; - } - elsif( $same_ref and( $e1 eq $e2 ) ) { - $ok = 1; - } - elsif($not_ref) { - push @Data_Stack, { type => '', vals => [ $e1, $e2 ] }; - $ok = 0; - } - else { - if( $Refs_Seen{$e1} ) { - return $Refs_Seen{$e1} eq $e2; - } - else { - $Refs_Seen{$e1} = "$e2"; - } - - my $type = _type($e1); - $type = 'DIFFERENT' unless _type($e2) eq $type; - - if( $type eq 'DIFFERENT' ) { - push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] }; - $ok = 0; - } - elsif( $type eq 'ARRAY' ) { - $ok = _eq_array( $e1, $e2 ); - } - elsif( $type eq 'HASH' ) { - $ok = _eq_hash( $e1, $e2 ); - } - elsif( $type eq 'REF' ) { - push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] }; - $ok = _deep_check( $$e1, $$e2 ); - pop @Data_Stack if $ok; - } - elsif( $type eq 'SCALAR' ) { - push @Data_Stack, { type => 'REF', vals => [ $e1, $e2 ] }; - $ok = _deep_check( $$e1, $$e2 ); - pop @Data_Stack if $ok; - } - elsif($type) { - push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] }; - $ok = 0; - } - else { - _whoa( 1, "No type in _deep_check" ); - } - } - } - - return $ok; -} - -sub _whoa { - my( $check, $desc ) = @_; - if($check) { - die <<"WHOA"; -WHOA! $desc -This should never happen! Please contact the author immediately! -WHOA - } -} - -=item B<eq_hash> - - my $is_eq = eq_hash(\%got, \%expected); - -Determines if the two hashes contain the same keys and values. This -is a deep check. - -=cut - -sub eq_hash { - local @Data_Stack = (); - return _deep_check(@_); -} - -sub _eq_hash { - my( $a1, $a2 ) = @_; - - if( grep _type($_) ne 'HASH', $a1, $a2 ) { - warn "eq_hash passed a non-hash ref"; - return 0; - } - - return 1 if $a1 eq $a2; - - my $ok = 1; - my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2; - foreach my $k ( keys %$bigger ) { - my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE; - my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE; - - push @Data_Stack, { type => 'HASH', idx => $k, vals => [ $e1, $e2 ] }; - $ok = _deep_check( $e1, $e2 ); - pop @Data_Stack if $ok; - - last unless $ok; - } - - return $ok; -} - -=item B<eq_set> - - my $is_eq = eq_set(\@got, \@expected); - -Similar to eq_array(), except the order of the elements is B<not> -important. This is a deep check, but the irrelevancy of order only -applies to the top level. - - ok( eq_set(\@got, \@expected) ); - -Is better written: - - is_deeply( [sort @got], [sort @expected] ); - -B<NOTE> By historical accident, this is not a true set comparison. -While the order of elements does not matter, duplicate elements do. - -B<NOTE> eq_set() does not know how to deal with references at the top -level. The following is an example of a comparison which might not work: - - eq_set([\1, \2], [\2, \1]); - -L<Test::Deep> contains much better set comparison functions. - -=cut - -sub eq_set { - my( $a1, $a2 ) = @_; - return 0 unless @$a1 == @$a2; - - no warnings 'uninitialized'; - - # It really doesn't matter how we sort them, as long as both arrays are - # sorted with the same algorithm. - # - # Ensure that references are not accidentally treated the same as a - # string containing the reference. - # - # Have to inline the sort routine due to a threading/sort bug. - # See [rt.cpan.org 6782] - # - # I don't know how references would be sorted so we just don't sort - # them. This means eq_set doesn't really work with refs. - return eq_array( - [ grep( ref, @$a1 ), sort( grep( !ref, @$a1 ) ) ], - [ grep( ref, @$a2 ), sort( grep( !ref, @$a2 ) ) ], - ); -} - -=back - - -=head2 Extending and Embedding Test::More - -Sometimes the Test::More interface isn't quite enough. Fortunately, -Test::More is built on top of Test::Builder which provides a single, -unified backend for any test library to use. This means two test -libraries which both use Test::Builder B<can be used together in the -same program>. - -If you simply want to do a little tweaking of how the tests behave, -you can access the underlying Test::Builder object like so: - -=over 4 - -=item B<builder> - - my $test_builder = Test::More->builder; - -Returns the Test::Builder object underlying Test::More for you to play -with. - - -=back - - -=head1 EXIT CODES - -If all your tests passed, Test::Builder will exit with zero (which is -normal). If anything failed it will exit with how many failed. If -you run less (or more) tests than you planned, the missing (or extras) -will be considered failures. If no tests were ever run Test::Builder -will throw a warning and exit with 255. If the test died, even after -having successfully completed all its tests, it will still be -considered a failure and will exit with 255. - -So the exit codes are... - - 0 all tests successful - 255 test died or all passed but wrong # of tests run - any other number how many failed (including missing or extras) - -If you fail more than 254 tests, it will be reported as 254. - -B<NOTE> This behavior may go away in future versions. - - -=head1 CAVEATS and NOTES - -=over 4 - -=item Backwards compatibility - -Test::More works with Perls as old as 5.6.0. - - -=item utf8 / "Wide character in print" - -If you use utf8 or other non-ASCII characters with Test::More you -might get a "Wide character in print" warning. Using C<binmode -STDOUT, ":utf8"> will not fix it. Test::Builder (which powers -Test::More) duplicates STDOUT and STDERR. So any changes to them, -including changing their output disciplines, will not be seem by -Test::More. - -The work around is to change the filehandles used by Test::Builder -directly. - - my $builder = Test::More->builder; - binmode $builder->output, ":utf8"; - binmode $builder->failure_output, ":utf8"; - binmode $builder->todo_output, ":utf8"; - - -=item Overloaded objects - -String overloaded objects are compared B<as strings> (or in cmp_ok()'s -case, strings or numbers as appropriate to the comparison op). This -prevents Test::More from piercing an object's interface allowing -better blackbox testing. So if a function starts returning overloaded -objects instead of bare strings your tests won't notice the -difference. This is good. - -However, it does mean that functions like is_deeply() cannot be used to -test the internals of string overloaded objects. In this case I would -suggest L<Test::Deep> which contains more flexible testing functions for -complex data structures. - - -=item Threads - -Test::More will only be aware of threads if "use threads" has been done -I<before> Test::More is loaded. This is ok: - - use threads; - use Test::More; - -This may cause problems: - - use Test::More - use threads; - -5.8.1 and above are supported. Anything below that has too many bugs. - - -=item Test::Harness upgrade - -no_plan, todo and done_testing() depend on new Test::Harness features -and fixes. If you're going to distribute tests that use no_plan or -todo your end-users will have to upgrade Test::Harness to the latest -one on CPAN. If you avoid no_plan and TODO tests, the stock -Test::Harness will work fine. - -Installing Test::More should also upgrade Test::Harness. - -=back - - -=head1 HISTORY - -This is a case of convergent evolution with Joshua Pritikin's Test -module. I was largely unaware of its existence when I'd first -written my own ok() routines. This module exists because I can't -figure out how to easily wedge test names into Test's interface (along -with a few other problems). - -The goal here is to have a testing utility that's simple to learn, -quick to use and difficult to trip yourself up with while still -providing more flexibility than the existing Test.pm. As such, the -names of the most common routines are kept tiny, special cases and -magic side-effects are kept to a minimum. WYSIWYG. - - -=head1 SEE ALSO - -L<Test::Simple> if all this confuses you and you just want to write -some tests. You can upgrade to Test::More later (it's forward -compatible). - -L<Test::Harness> is the test runner and output interpreter for Perl. -It's the thing that powers C<make test> and where the C<prove> utility -comes from. - -L<Test::Legacy> tests written with Test.pm, the original testing -module, do not play well with other testing libraries. Test::Legacy -emulates the Test.pm interface and does play well with others. - -L<Test::Differences> for more ways to test complex data structures. -And it plays well with Test::More. - -L<Test::Class> is like xUnit but more perlish. - -L<Test::Deep> gives you more powerful complex data structure testing. - -L<Test::Inline> shows the idea of embedded testing. - -L<Bundle::Test> installs a whole bunch of useful test modules. - - -=head1 AUTHORS - -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. - - -=head1 BUGS - -See F<http://rt.cpan.org> to report and view bugs. - - -=head1 SOURCE - -The source code repository for Test::More can be found at -F<http://github.com/schwern/test-more/>. - - -=head1 COPYRIGHT - -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> - -=cut - -1; diff --git a/lib/Test/Simple.pm b/lib/Test/Simple.pm deleted file mode 100644 index 48c72e27fc..0000000000 --- a/lib/Test/Simple.pm +++ /dev/null @@ -1,214 +0,0 @@ -package Test::Simple; - -use 5.004; - -use strict; - -our $VERSION = '0.92'; -$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) - -use Test::Builder::Module; -our @ISA = qw(Test::Builder::Module); -our @EXPORT = qw(ok); - -my $CLASS = __PACKAGE__; - -=head1 NAME - -Test::Simple - Basic utilities for writing tests. - -=head1 SYNOPSIS - - use Test::Simple tests => 1; - - ok( $foo eq $bar, 'foo is bar' ); - - -=head1 DESCRIPTION - -** If you are unfamiliar with testing B<read Test::Tutorial> first! ** - -This is an extremely simple, extremely basic module for writing tests -suitable for CPAN modules and other pursuits. If you wish to do more -complicated testing, use the Test::More module (a drop-in replacement -for this one). - -The basic unit of Perl testing is the ok. For each thing you want to -test your program will print out an "ok" or "not ok" to indicate pass -or fail. You do this with the ok() function (see below). - -The only other constraint is you must pre-declare how many tests you -plan to run. This is in case something goes horribly wrong during the -test and your test program aborts, or skips a test or whatever. You -do this like so: - - use Test::Simple tests => 23; - -You must have a plan. - - -=over 4 - -=item B<ok> - - ok( $foo eq $bar, $name ); - ok( $foo eq $bar ); - -ok() is given an expression (in this case C<$foo eq $bar>). If it's -true, the test passed. If it's false, it didn't. That's about it. - -ok() prints out either "ok" or "not ok" along with a test number (it -keeps track of that for you). - - # This produces "ok 1 - Hell not yet frozen over" (or not ok) - ok( get_temperature($hell) > 0, 'Hell not yet frozen over' ); - -If you provide a $name, that will be printed along with the "ok/not -ok" to make it easier to find your test when if fails (just search for -the name). It also makes it easier for the next guy to understand -what your test is for. It's highly recommended you use test names. - -All tests are run in scalar context. So this: - - ok( @stuff, 'I have some stuff' ); - -will do what you mean (fail if stuff is empty) - -=cut - -sub ok ($;$) { ## no critic (Subroutines::ProhibitSubroutinePrototypes) - return $CLASS->builder->ok(@_); -} - -=back - -Test::Simple will start by printing number of tests run in the form -"1..M" (so "1..5" means you're going to run 5 tests). This strange -format lets Test::Harness know how many tests you plan on running in -case something goes horribly wrong. - -If all your tests passed, Test::Simple will exit with zero (which is -normal). If anything failed it will exit with how many failed. If -you run less (or more) tests than you planned, the missing (or extras) -will be considered failures. If no tests were ever run Test::Simple -will throw a warning and exit with 255. If the test died, even after -having successfully completed all its tests, it will still be -considered a failure and will exit with 255. - -So the exit codes are... - - 0 all tests successful - 255 test died or all passed but wrong # of tests run - any other number how many failed (including missing or extras) - -If you fail more than 254 tests, it will be reported as 254. - -This module is by no means trying to be a complete testing system. -It's just to get you started. Once you're off the ground its -recommended you look at L<Test::More>. - - -=head1 EXAMPLE - -Here's an example of a simple .t file for the fictional Film module. - - use Test::Simple tests => 5; - - use Film; # What you're testing. - - my $btaste = Film->new({ Title => 'Bad Taste', - Director => 'Peter Jackson', - Rating => 'R', - NumExplodingSheep => 1 - }); - 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' ); - ok( $btaste->Rating eq 'R', 'Rating() get' ); - ok( $btaste->NumExplodingSheep == 1, 'NumExplodingSheep() get' ); - -It will produce output like this: - - 1..5 - ok 1 - new() works - ok 2 - Title() get - ok 3 - Director() get - not ok 4 - Rating() get - # Failed test 'Rating() get' - # in t/film.t at line 14. - ok 5 - NumExplodingSheep() get - # Looks like you failed 1 tests of 5 - -Indicating the Film::Rating() method is broken. - - -=head1 CAVEATS - -Test::Simple will only report a maximum of 254 failures in its exit -code. If this is a problem, you probably have a huge test script. -Split it into multiple files. (Otherwise blame the Unix folks for -using an unsigned short integer as the exit status). - -Because VMS's exit codes are much, much different than the rest of the -universe, and perl does horrible mangling to them that gets in my way, -it works like this on VMS. - - 0 SS$_NORMAL all tests successful - 4 SS$_ABORT something went wrong - -Unfortunately, I can't differentiate any further. - - -=head1 NOTES - -Test::Simple is B<explicitly> tested all the way back to perl 5.004. - -Test::Simple is thread-safe in perl 5.8.0 and up. - -=head1 HISTORY - -This module was conceived while talking with Tony Bowden in his -kitchen one night about the problems I was having writing some really -complicated feature into the new Testing module. He observed that the -main problem is not dealing with these edge cases but that people hate -to write tests B<at all>. What was needed was a dead simple module -that took all the hard work out of testing and was really, really easy -to learn. Paul Johnson simultaneously had this idea (unfortunately, -he wasn't in Tony's kitchen). This is it. - - -=head1 SEE ALSO - -=over 4 - -=item L<Test::More> - -More testing functions! Once you outgrow Test::Simple, look at -Test::More. Test::Simple is 100% forward compatible with Test::More -(i.e. you can just use Test::More instead of Test::Simple in your -programs and things will still work). - -=back - -Look in Test::More's SEE ALSO for more testing modules. - - -=head1 AUTHORS - -Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern -E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein. - - -=head1 COPYRIGHT - -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> - -=cut - -1; diff --git a/lib/Test/Simple/Changes b/lib/Test/Simple/Changes deleted file mode 100644 index 0c955f2908..0000000000 --- a/lib/Test/Simple/Changes +++ /dev/null @@ -1,738 +0,0 @@ -0.92 Fri Jul 3 11:08:56 PDT 2009 - Test Fixes - * Silence noise on VMS in exit.t (Craig Berry) - * Skip Builder/fork_with_new_stdout.t on systems without fork (Craig Berry) - - -0.90 Thu Jul 2 13:18:25 PDT 2009 - Docs - * Finally added a note about the "Wide character in print" warning and - how to work around it. - * Note the IO::Stringy license in our copy of it. - [test-more.googlecode.com 47] - - Test Fixes - * Small fixes for integration with the Perl core - [bleadperl eaa0815147e13cd4ab5b3d6ca8f26544a9f0c3b4] - * exit code tests could be effected by errno when PERLIO=stdio - [bleadperl c76230386fc5e6fba9fdbeab473abbf4f4adcbe3] - - Other - * This is a stable release for 5.10.1. It does not include - the subtest() work in 0.89_01. - - -0.88 Sat May 30 12:31:24 PDT 2009 - Turing 0.87_03 into a stable release. - - -0.87_03 Sun May 24 13:41:40 PDT 2009 - New Features - * isa_ok() now works on classes. (Peter Scott) - - -0.87_02 Sat Apr 11 12:54:14 PDT 2009 - Test Fixes - * Some filesystems don't like it when you open a file for writing multiple - times. Fixes t/Builder/reset.t. [rt.cpan.org 17298] - * Check how an operating system is going to map exit codes. Some OS' - will map them... sometimes. [rt.cpan.org 42148] - * Fix Test::Builder::NoOutput on 5.6.2. - - -0.87_01 Sun Mar 29 09:56:52 BST 2009 - New Features - * done_testing() allows you to declare that you have finished running tests, - and how many you ran. It is a safer no_plan and effectively replaces it. - * output() now supports scalar references. - - Feature Changes - * You can now run a test without first declaring a plan. This allows - done_testing() to work. - * You can now call current_test() without first declaring a plan. - - Bug Fixes - * skip_all() with no reason would output "1..0" which is invalid TAP. It will - now always include the SKIP directive. - - Other - * Repository moved to github. - - -0.86 Sun Nov 9 01:09:05 PST 2008 - Same as 0.85_01 - - -0.85_01 Thu Oct 23 18:57:38 PDT 2008 - New Features - * cmp_ok() now displays the error if the comparison throws one. - For example, broken overloaded objects. - - Bug Fixes - * cmp_ok() no longer stringifies or numifies its arguments before comparing. - This makes cmp_ok() properly test overloaded ops. - [rt.cpan.org 24186] [code.google.com 16] - * diag() properly escapes blank lines. - - Feature Changes - * cmp_ok() now reports warnings and errors as coming from inside cmp_ok, - as well as reporting the caller's file and line. This let's the user - know where cmp_ok() was called from while reminding them that it is - being run in a different context. - - Other - * Dependency on ExtUtils::MakeMaker 6.27 only on Windows otherwise the - nested tests won't run. - - -0.84 Wed Oct 15 09:06:12 EDT 2008 - Other - * 0.82 accidentally shipped with experimental Mouse dependency. - - -0.82 Tue Oct 14 23:06:56 EDT 2008 - Bug Fixes - - 0.81_01 broke $TODO such that $TODO = '' was considered todo. - - -0.81_02 Tue Sep 9 04:35:40 PDT 2008 - New Features - * Test::Builder->reset_outputs() to reset all the output methods back to - their defaults. - - Bug Fixes - - Fixed the file and line number reported by like when it gets a bad - regex. - - Features Changed - - Now preserves the tests' exit code if it exits abnormally, rather than - setting it to 255. - - Changed the "Looks like your test died" message to - "Looks like your test exited with $exit_code" - - no_plan now only warns if given an argument. There were a lot of people - doing that, and it's a sensible mistake. [test-more.googlecode.com 13] - - -0.81_01 Sat Sep 6 15:13:50 PDT 2008 - New Features - * Adam Kennedy bribed me to add new_ok(). The price was one DEFCON license key. - [rt.cpan.org 8891] - * TODO tests can now start and end with 'todo_start' and 'todo_end' - Test::Builder methods. [rt.cpan.org 38018] - * Added Test::Builder->in_todo() for a safe way to check if a test is inside a - TODO block. This allows TODO tests with no reason. - * Added note() and explain() to both Test::More and Test::Builder. - [rt.cpan.org 14764] [test-more.googlecode.com 3] - - Features Changed - * Changed the message for extra tests run to show the number of tests run rather than - the number extra to avoid the user having to do mental math. - [rt.cpan.org 7022] - - Bug fixes - - using a relative path to perl broke tests [rt.cpan.org 34050] - - use_ok() broke $SIG{__DIE__} in the used module [rt.cpan.org 34065] - - diagnostics for isnt() were confusing on failure [rt.cpan.org 33642] - - warnings when MakeMaker's version contained _ [rt.cpan.org 33626] - - add explicit test that non-integer plans die correctly [rt.cpan.org 28836] - (Thanks to Hans Dieter Pearcey [confound] for fixing the above) - - die if no_plan is given an argument [rt.cpan.org 27429] - - -0.80 Sun Apr 6 17:25:01 CEST 2008 - Test fixes - - Completely disable the utf8 test. It was causing perl to panic on some OS's. - - -0.79_01 Wed Feb 27 03:04:54 PST 2008 - Bug fixes - - Let's try the IO layer copying again, this time with the test - fixed for 5.10. - - -0.78 Wed Feb 27 01:59:09 PST 2008 - Bug fixes - * Whoops, the version of Test::Builder::Tester got moved backwards. - - -0.77 Wed Feb 27 01:55:55 PST 2008 - Bug fixes - - "use Test::Builder::Module" no longer sets exported_to() or does - any other importing. - - Fix the $TODO finding code so it can find $TODO without the benefit - of exported_to(), which is often wrong. - - Turn off the filehandle locale stuff for the moment, there's a - problem on 5.10. We'll try it again next release. - - Doc improvements - - Improve the Test::Builder SYNOPSIS to use Test::Builder::Module - rather than write it's own import(). - - -0.76_02 Sun Feb 24 13:12:55 PST 2008 - Bug fixes - * The default test output filehandles will NOT use utf8. - They will now copy the IO layers from STDOUT and STDERR. - This means if :utf8 is on then it will honor it and not - warn about wide characters. - - -0.76_01 Sat Feb 23 20:44:32 PST 2008 - Bug fixes - * Test::Builder no longer uses a __DIE__ handler. This resolves a number - of problems with exit codes being swallowed or other module's handlers - being interfered with. [rt.cpan.org 25294] - - Allow maybe_regex() to detect blessed regexes. [bleadperl @32880] - - The default test output filehandles will now use utf8. - [rt.cpan.org 21091] - - Test fixes - - Remove the signature test. Adds no security and just generates - failures. - - -0.75 Sat Feb 23 19:03:38 PST 2008 - Incompatibilities - * The minimum version is now 5.6.0. - - Bug fixes - - Turns out require_ok() had the same bug as use_ok() in a BEGIN block. - - ok() was not honoring exported_to() when looking for $TODO as it - should be. - - Test fixes - * is_deeply_with_threads.t will not run unless AUTHOR_TESTING is set. - This is because it tickles intermittent threading bugs in many perls - and causes a lot of bug reports about which I can do nothing. - - Misc - - Ran through perlcritic and did some cleaning. - -0.74 Thu Nov 29 15:39:57 PST 2007 - Misc - - Add abstract and author to the meta information. - -0.73_01 Mon Oct 15 20:35:15 EDT 2007 - Bug fixes - * Put the use_ok() fix from 0.71 back. - -0.72 Wed Sep 19 20:08:07 PDT 2007 - Bug unfixes - * The BEGIN { use_ok } fix for [rt.cpan.org 28345] revealed a small pile of - mistakes in CPAN module test suites. Rolling the fix back to give the - authors a bit of time to fix their tests. - -0.71 Thu Sep 13 20:42:36 PDT 2007 - Bug fixes - - Fixed a problem with BEGIN { use_ok } silently failing when there's no - plan set. [rt.cpan.org 28345] Thanks Adriano Ferreira and Yitzchak. - - Fixed an obscure problem with is_deeply() and overloading == - [rt.cpan.org 20768]. Thanks Sisyphus. - - Test fixes - - Removed dependency on Text::Soundex [rt.cpan.org 25022] - - Fixed a 5.5.x failure in fail-more.t - * Got rid of the annoying sort_bug.t test that revealed problems with some - threaded perls. It was testing the deprecated eq_* functions and not - worth the bother. Now it tests is_deeply(). [rt.cpan.org 17791] - - Doc fixes - - Minor POD mistake in Test::Builder [rt.cpan.org 28869] - * Test::FAQ has been updated with some more answers. - - Install fixes - - Fixed the "LICENSE is not a known MakeMaker parameter name" warning - on older MakeMakers for real this time. - -0.70 Thu Mar 15 15:53:05 PDT 2007 - Bug Fixes - * The change to is_fh() in 0.68 broke the case where a reference to - a tied filehandle is used for perl 5.6 and back. This made the tests - puke their guts out. - -0.69 Wed Mar 14 06:43:35 PDT 2007 - Test fixes - - Minor filename compatibility fix to t/fail-more.t [rt.cpan.org 25428] - -0.68 Tue Mar 13 17:27:26 PDT 2007 - Bug fixes - * If your code has a $SIG{__DIE__} handler in some cases functions like - use_ok(), require_ok(), can_ok() and isa_ok() could trigger that - handler. [rt.cpan.org 23509] - - Minor improvement to TB's filehandle detection in the case of overridden - isa(). [rt.cpan.org 20890] - - Will now install as a core module in 5.6.2 which ships with Test::More. - [rt.cpan.org 25163] - - New Features - - Test::Builder->is_fh() provides a way to determine if a thing - can be used as a filehandle. - - Documentation improvements - - Improved the docs for $Test::Builder::Level showing the encouraged - use (increment, don't set) - - Documented the return value of Test::Builder's test methods - - Split out TB's method documentation to differenciate between test - methods (ok, is_eq...), methods useful in testing (skip, BAILOUT...) - and methods useful for building your own tests (maybe_regex...). - - Test fixes - - We required too old a version of Test::Pod::Coverage. Need 1.08 and not - 1.00. [rt.cpan.org 25351] - -0.67 Mon Jan 22 13:27:40 PST 2007 - Test fixes - - t/pod_coverage.t would fail if Test::Pod::Coverage between 1.07 and - 1.00 were installed as it depended on all_modules being exported. - [rt.cpan.org 24483] - -0.66 Sun Dec 3 15:25:45 PST 2006 - - Restore 5.4.5 compatibility (unobe@cpan.org) [rt.cpan.org 20513] - -0.65 Fri Nov 10 10:26:51 CST 2006 - -0.64_03 Sun Nov 5 13:09:55 EST 2006 - - Tests will no longer warn when run against an alpha version of - Test::Harness [rt.cpan.org #20501] - - Now testing our POD and POD coverage. - - Added a LICENSE field. - - Removed warning from the docs about mixing numbered and unnumbered - tests. There's nothing wrong with that. [rt.cpan.org 21358] - - Change doc examples to talk about $got and $expected rather than - $this and $that to correspond better to the diagnostic output - [rt.cpan.org 2655] - -0.64_02 Sat Sep 9 12:16:56 EDT 2006 - - Last release broke Perls earlier than 5.8. - -0.64_01 Mon Sep 4 04:40:42 EDT 2006 - - Small improvement to the docs to avoid user confusion over - "use Test::More tests => $num_tests" (Thanks Eric Wilhelm) - - Minor fix for a test failure in is_deeply_fail for some Windows - users. Not a real bug. [rt.cpan.org 21310] - - _print_diag() accidentally leaked into the public documentation. - It is a private method. - * Added Test::Builder->carp() and croak() - * Made most of the error messages report in the caller's context. - [rt.cpan.org #20639] - * Made the failure diagnostic message file and line reporting portion - match Perl's for easier integration with Perl aware editors. - (so its "at $file line $line_num." now) - [rt.cpan.org #20639] - * 5.8.0 threads are no longer supported. There's too many bugs. - -0.64 Sun Jul 16 02:47:29 PDT 2006 - * 0.63's change to test_fail() broke backwards compatibility. They - have been removed for the time being. test_pass() went with it. - This is [rt.cpan.org 11317] and [rt.cpan.org 11319]. - - skip() will now warn if you get the args backwards. - -0.63 Sun Jul 9 02:36:36 PDT 2006 - * Fixed can_ok() to gracefully handle no class name. - Submitted by "Pete Krawczyk" <perl@bsod.net> - Implemented by "Richard Foley" <richard.foley@rfi.net> - [rt.cpan.org 15654] - * Added test_pass() to Test::Builder::Tester rather than having to - call test_out("ok 1 - foo"). <chromatic@wgz.org> [rt.cpan.org 11317] - * test_fail() now accepts a test diagnostic rather than having to - call test_out() separately. <chromatic@wgz.org> [rt.cpan.org 11319] - - Changed Test::Builder::Tester docs to show best practice using - test_fail() and test_pass(). - - isnt_num() doc example wrongly showed is_num(). <chromatic@wgz.org> - - Fixed a minor typo in the BAIL_OUT() docs. <Jeff Deifik> - - Removed the LICENSE field from the Makefile.PL as the release of - MakeMaker with that feature has been delayed. - -0.62 Sat Oct 8 01:25:03 PDT 2005 - * Absorbed Test::Builder::Tester. The last release broke it because its - screen scraping Test::More and the failure output changed. By - distributing them together we ensure TBT won't break again. - * Test::Builder->BAILOUT() was missing. - - is_deeply() can now handle function and code refs in a very limited - way. It simply looks to see if they have the same referent. - [rt.cpan.org 14746] - -0.61 Fri Sep 23 23:26:05 PDT 2005 - - create.t was trying to read from a file before it had been closed - (and thus the changes may not have yet been written). - * is_deeply() would call stringification methods on non-object strings - which happened to be the name of a string overloaded class. - [rt.cpan.org 14675] - -0.60_02 Tue Aug 9 00:27:41 PDT 2005 - * Added Test::Builder::Module. - - Changed Test::More and Test::Simple to use Test::Builder::Module - - Minor Win32 testing nit in fail-more.t - * Added no_diag() method to Test::Builder and changed Test::More's - no_diag internals to use that. [rt.cpan.org 8655] - * Deprecated no_diag() as an option to "use Test::More". Call the - Test::Builder method instead. - -0.60_01 Sun Jul 3 18:11:58 PDT 2005 - - Moved the docs around a little to better group all the testing - functions together. [rt.cpan.org 8388] - * Added a BAIL_OUT() function to Test::More [rt.cpan.org 8381] - - Changed Test::Builder->BAILOUT to BAIL_OUT to match other method's - naming conventions. BAILOUT remains but is deprecated. - * Changed the standard failure diagnostics to include the test name. - [rt.cpan.org 12490] - - is_deeply() was broken for overloaded objects in the top level in - 0.59_01. [rt.cpan.org 13506] - - String overloaded objects without an 'eq' or '==' method are now - handled in cmp_ok() and is(). - - cmp_ok() will now treat overloaded objects as numbers if the comparison - operator is numeric. [rt.cpan.org 13156] - - cmp_ok(), like() and unlike will now throw uninit warnings if their - arguments are undefined. [rt.cpan.org 13155] - - cmp_ok() will now throw warnings as if the comparison were run - normally, for example cmp_ok(2, '==', 'foo') will warn about 'foo' - not being numeric. Previously all warnings in the comparison were - supressed. [rt.cpan.org 13155] - - Tests will now report *both* the number of tests failed and if the - wrong number of tests were run. Previously if tests failed and the - wrong number were run it would only report the latter. - [rt.cpan.org 13494] - - Missing or extra tests are not considered failures for the purposes - of calculating the exit code. Should there be no failures but the - wrong number of tests the exit code will be 254. - - Avoiding an unbalanced sort in eq_set() [bugs.perl.org 36354] - - Documenting that eq_set() doesn't deal well with refs. - - Clarified how is_deeply() compares a bit. - * Once again working on 5.4.5. - -0.60 Tue May 3 14:20:34 PDT 2005 - -0.59_01 Tue Apr 26 21:51:12 PDT 2005 - * Test::Builder now has a create() method which allows you to create - a brand spanking new Test::Builder object. - * require_ok() was not working for single letter module names. - * is_deeply() and eq_* now work with circular scalar references - (Thanks Fergal) - * Use of eq_* now officially discouraged. - - Removed eq_* from the SYNOPSIS. - - is_deeply(undef, $not_undef); now works. [rt.cpan.org 9441] - - is_deeply() was mistakenly interpeting the same reference used twice - in a data structure as being circular causing failures. - [rt.cpan.org 11623] - - Loading Test::Builder but not using it would interfere with the - exit code if the code exited. [rt.cpan.org 12310] - - is_deeply() diagnostics now disambiguate between stringified references - and references. [rt.cpan.org 8865] - - Files opened by the output methods are now autoflushed. - - todo() now honors $Level when looking for $TODO. - -0.54 Wed Dec 15 04:18:43 EST 2004 - * $how_many is optional for skip() and todo_skip(). Thanks to - Devel::Cover for pointing this out. - - Removed a user defined function called err() in the tests to placate - users of older versions of the dor patch before err() was weakend. - [rt.cpan.org 8734] - -0.53_01 Sat Dec 11 19:02:18 EST 2004 - - current_test() can now be set backward. - - *output() methods now handle tied handles and *FOO{IO} properly. - - maybe_regex() now handles undef gracefully. - - maybe_regex() now handles 'm,foo,' style regexes. - - sort_bug.t wasn't checking for threads properly. Would fail on - 5.6 that had ithreads compiled in. [rt.cpan.org 8765] - -0.53 Mon Nov 29 04:43:24 EST 2004 - - Apparently its possible to have Module::Signature installed without - it being functional. Fixed the signature test to account for this. - (not a real bug) - -0.52 Sun Nov 28 21:41:03 EST 2004 - - plan() now better checks that the given plan is valid. - [rt.cpan.org 2597] - -0.51_02 Sat Nov 27 01:25:25 EST 2004 - * is_deeply() and all the eq_* functions now handle circular data - structures. [rt.cpan.org 7289] - * require_ok() now handles filepaths in addition to modules. - - Clarifying Test::More's position on overloaded objects - - Fixed a bug introduced in 0.51_01 causing is_deeply() to pierce - overloaded objects. - - Mentioning rt.cpan.org for reporting bugs. - -0.51_01 Fri Nov 26 02:59:30 EST 2004 - - plan() was accidentally exporting functions [rt.cpan.org 8385] - * diag @msgs would insert # between arguments. [rt.cpan.org 8392] - * eq_set() could cause problems under threads due to a weird sort bug - [rt.cpan.org 6782] - * undef no longer equals '' in is_deeply() [rt.cpan.org 6837] - * is_deeply() would sometimes compare references as strings. - [rt.cpan.org 7031] - - eq_array() and eq_hash() could hold onto references if they failed - keeping them in memory and preventing DESTROY. [rt.cpan.org 7032] - * is_deeply() could confuse [] with a non-existing value - [rt.cpan.org 7030] - - is_deeply() diagnostics a little off when scalar refs were inside - an array or hash ref [rt.cpan.org 7033] - - Thanks to Fergal Daly for ferretting out all these long standing - is_deeply and eq_* bugs. - -0.51 Tue Nov 23 04:51:12 EST 2004 - - Fixed bug in fail_one.t on Windows (not a real bug). - - TODO reasons as overloaded objects now won't blow up under threads. - [Autrijus Tang] - - skip() in 0.50 tickled yet another bug in threads::shared. Hacked - around it. - -0.50 Sat Nov 20 00:28:44 EST 2004 - - Fixed bug in fail-more test on Windows (not a real bug). - [rt.cpan.org 8022] - - Change from CVS to SVK. Hopefully this is the last time I move - version control systems. - - Again removing File::Spec dependency (came back in 0.48_02) - - Change from Aegis back to CVS - -0.49 Thu Oct 14 21:58:50 EDT 2004 - - t/harness_active.t would fail for frivolous reasons with older - MakeMakers (test bug) [thanks Bill Moseley for noticing] - -0.48_02 Mon Jul 19 02:07:23 EDT 2004 - * Overloaded objects as names now won't blow up under threads - [rt.cpan.org 4218 and 4232] - * Overloaded objects which stringify to undef used as test names - now won't cause internal uninit warnings. [rt.cpan.org 4232] - * Failure diagnostics now come out on their own line when run in - Test::Harness. - - eq_set() sometimes wasn't giving the right results if nested refs - were involved [rt.cpan.org 3747] - - isnt() giving wrong diagnostics and warning if given any undefs. - * Give unlike() the right prototype [rt.cpan.org 4944] - - Change from CVS to Aegis - - is_deeply() will now do some basic argument checks to guard against - accidentally passing in a whole array instead of its reference. - - Mentioning Test::Differences, Test::Deep and Bundle::Test. - - Removed dependency on File::Spec. - - Fixing the grammar of diagnostic outputs when only a single test - is run or failed (ie. "Looks like you failed 1 tests"). - [Darren Chamberlain] - -0.48_01 Mon Nov 11 02:36:43 EST 2002 - - Mention Test::Class in Test::More's SEE ALSO - * use_ok() now DWIM for version checks - - More problems with ithreads fixed. - * Test::Harness upgrade no longer optional. It was causing too - many problems when the T::H upgrade didn't work. - * Drew Taylor added a 'no_diag' option to Test::More to switch - off all diag() statements. - * Test::Builder/More no longer automatically loads threads.pm - when threads are enabled. The user must now do this manually. - * Alex Francis added reset() reset the state of Test::Builder in - persistent environments. - - David Hand noted that Test::Builder/More exit code behavior was - not documented. Only Test::Simple. - -0.47 Mon Aug 26 03:54:22 PDT 2002 - * Tatsuhiko Miyagawa noticed Test::Builder was accidentally storing - objects passed into test functions causing problems with tests - relying on object destruction. - - Added example of calculating the number of tests to Test::Tutorial - - Peter Scott made the ending logic not fire on child processes when - forking. - * Test::Builder is once again ithread safe. - -0.46 Sat Jul 20 19:57:40 EDT 2002 - - Noted eq_set() isn't really a set comparision. - - Test fix, exit codes are broken on MacPerl (bleadperl@16868) - - Make Test::Simple install itself into the core for >= 5.8 - - Small fixes to Test::Tutorial and skip examples - * Added TB->has_plan() from Adrian Howard - - Clarified the meaning of 'actual_ok' from TB->details - * Added TB->details() from chromatic - - Neil Watkiss fixed a pre-5.8 test glitch with threads.t - * If the test died before a plan, it would exit with 0 [ID 20020716.013] - -0.45 Wed Jun 19 18:41:12 EDT 2002 - - Andy Lester made the SKIP & TODO docs a bit clearer. - - Explicitly disallowing double plans. (RT #553) - - Kicking up the minimum version of Test::Harness to one that's - fairly bug free. - - Made clear a common problem with use_ok and BEGIN blocks. - - Arthur Bergman made Test::Builder thread-safe. - -0.44 Thu Apr 25 00:27:27 EDT 2002 - - names containing newlines no longer produce confusing output - (from chromatic) - - chromatic provided a fix so can_ok() honors can() overrides. - - Nick Ing-Simmons suggested todo_skip() be a bit clearer about - the skipping part. - - Making plan() vomit if it gets something it doesn't understand. - - Tatsuhiko Miyagawa fixed use_ok() with pragmata on older perls. - - quieting diag(undef) - -0.43 Thu Apr 11 22:55:23 EDT 2002 - - Adrian Howard added TB->maybe_regex() - - Adding Mark Fowler's suggestion to make diag() return - false. - - TB->current_test() still not working when no tests were run via - TB itself. Fixed by Dave Rolsky. - -0.42 Wed Mar 6 15:00:24 EST 2002 - - Setting Test::Builder->current_test() now works (see what happens - when you forget to test things?) - - The change in is()'s undef/'' handling in 0.34 was an API change, - but I forgot to declare it as such. - - The apostrophilic jihad attacks! Philip Newtons patch for - grammar mistakes in the doc's. - -0.41 Mon Dec 17 22:45:20 EST 2001 - * chromatic added diag() - - Internal eval()'s sometimes interfering with $@ and $!. Fixed. - -0.40 Fri Dec 14 15:41:39 EST 2001 - * isa_ok() now accepts unblessed references gracefully - - Nick Clark found a bug with like() and a regex with % in it. - - exit.t was hanging on 5.005_03 VMS perl. Test now skipped. - - can_ok() would pass if no methods were given. Now fails. - - isnt() diagnostic output format changed - * Added some docs about embedding and extending Test::More - * Added Test::More->builder - * Added cmp_ok() - * Added todo_skip() - * Added unlike() - - Piers pointed out that sometimes people override isa(). - isa_ok() now accounts for that. - -0.36 Thu Nov 29 14:07:39 EST 2001 - - Matthias Urlichs found that intermixed prints to STDOUT and test - output came out in the wrong order when piped. - -0.35 Tue Nov 27 19:57:03 EST 2001 - - Little glitch in the test suite. No actual bug. - -0.34 Tue Nov 27 15:43:56 EST 2001 - * **API CHANGE** Empty string no longer matches undef in is() - and isnt(). - * Added isnt_eq and isnt_num to Test::Builder. - -0.33 Mon Oct 22 21:05:47 EDT 2001 - * It's now officially safe to redirect STDOUT and STDERR without - affecting test output. - - License and POD cleanup by Autrijus Tang - - Synched up Test::Tutorial with the wiki version - - Minor VMS test nit. - -0.32 Tue Oct 16 16:52:02 EDT 2001 - * Finally added a seperate plan() function - * Adding a name field to isa_ok() - (Requested by Dave Rolsky) - - Test::More was using Carp.pm, causing the occasional false positive. - (Reported by Tatsuhiko Miyagawa) - -0.31 Mon Oct 8 19:24:53 EDT 2001 - * Added an import option to Test::More - * Added no_ending and no_header options to Test::Builder - (Thanks to Dave Rolsky for giving this a swift kick in the ass) - * Added is_deeply(). Display of scalar refs not quite 100% - (Thanks to Stas Bekman for Apache::TestUtil idea thievery) - - Fixed a minor warning with skip() - (Thanks to Wolfgang Weisselberg for finding this one) - -0.30 Thu Sep 27 22:10:04 EDT 2001 - * Added Test::Builder - (Thanks muchly to chromatic for getting this off the ground!) - * Diagnostics are back to using STDERR *unless* it's from a todo - test. Those go to STDOUT. - - Fixed it so nothing is printed if a test is run with a -c flag. - Handy when a test is being deparsed with B::Deparse. - -0.20 *UNRELEASED* - -0.19 Tue Sep 18 17:48:32 EDT 2001 - * Test::Simple and Test::More no longer print their diagnostics - to STDERR. It instead goes to STDOUT. - * TODO tests which fail now print full failure diagnostics. - - Minor bug in ok()'s test name diagnostics made it think a blank - name was a number. - - ok() less draconian about test names - - Added temporary special case for Parrot::Test - - Now requiring File::Spec for our tests. - -0.18 Wed Sep 5 20:35:24 EDT 2001 - * ***API CHANGE*** can_ok() only counts as one test - - can_ok() has better diagnostics - - Minor POD fixes from mjd - - adjusting the internal layout to make it easier to put it into - the core - -0.17 Wed Aug 29 20:16:28 EDT 2001 - * Added can_ok() and isa_ok() to Test::More - -0.16 Tue Aug 28 19:52:11 EDT 2001 - * vmsperl foiled my sensisble exit codes. Reverting to a much more - coarse scheme. - -0.15 Tue Aug 28 06:18:35 EDT 2001 *UNRELEASED* - * Now using sensible exit codes on VMS. - -0.14 Wed Aug 22 17:26:28 EDT 2001 - * Added a first cut at Test::Tutorial - -0.13 Tue Aug 14 15:30:10 EDT 2001 - * Added a reason to the skip_all interface - - Fixed a bug to allow 'use Test::More;' to work. - (Thanks to Tatsuhiko Miyagawa again) - - Now always testing backwards compatibility. - -0.12 Tue Aug 14 11:02:39 EDT 2001 - * Fixed some compatibility bugs with older Perls - (Thanks to Tatsuhiko Miyagawa) - -0.11 Sat Aug 11 23:05:19 EDT 2001 - * Will no longer warn about testing undef values - - Escaping # in test names - - Ensuring that ok() returns true or false and not undef - - Minor doc typo in the example - -0.10 Tue Jul 31 15:01:11 EDT 2001 - * Test::More is now distributed in this tarball. - * skip and todo tests work! - * Extended use_ok() so it can import - - A little internal rejiggering - - Added a TODO file - -0.09 Wed Jun 27 02:55:54 EDT 2001 - - VMS fixes - -0.08 Fri Jun 15 14:39:50 EDT 2001 - - Guarding against $/ and -l - - Reformatted the way failed tests are reported to make them stand out - a bit better. - -0.07 Tue Jun 12 15:55:54 BST 2001 - - 'use Test::Simple' by itself no longer causes death - - Yet more fixes for death in eval - - Limiting max failures reported via exit code to 254. - -0.06 Wed May 9 23:38:17 BST 2001 - - Whoops, left a private method in the public docs. - -0.05 Wed May 9 20:40:35 BST 2001 - - Forgot to include the exit tests. - - Trouble with exiting properly under 5.005_03 and 5.6.1 fixed - - Turned off buffering - * 5.004 new minimum version - - Now explicitly tested with 5.6.1, 5.6.0, 5.005_03 and 5.004 - -0.04 Mon Apr 2 11:05:01 BST 2001 - - Fixed "require Test::Simple" so it doesn't bitch and exit 255 - - Now installable with the CPAN shell. - -0.03 Fri Mar 30 08:08:33 BST 2001 - - ok() now prints on what line and file it failed. - - eval 'die' was considered abnormal. Fixed. - -0.02 Fri Mar 30 05:12:14 BST 2001 *UNRELEASED* - - exit codes tested - * exit code on abnormal exit changed to 255 (thanks to Tim Bunce for - pointing out that Unix can't do negative exit codes) - - abnormal exits now better caught. - - No longer using Test.pm to test this, but still minimum of 5.005 - due to needing $^S. - -0.01 Wed Mar 28 06:44:44 BST 2001 - - First working version released to CPAN - diff --git a/lib/Test/Simple/README b/lib/Test/Simple/README deleted file mode 100644 index 5f825bd41d..0000000000 --- a/lib/Test/Simple/README +++ /dev/null @@ -1,22 +0,0 @@ -This is the README file for Test::Simple, basic utilities for -writing tests, by Michael G Schwern <schwern@pobox.com>. - -After installation, please consult the tutorial for how to -start adding tests to your modules. 'perldoc Test::Tutorial' -should work on most systems. - -* Installation - -Test::Simple uses the standard perl module install process: - -perl Makefile.PL -make -make test -make install - -It requires Perl version 5.6.0 or newer and Test::Harness 2.03 or newer. - - -* More Info - -More information can be found at http://test-more.googlecode.com/ diff --git a/lib/Test/Simple/TODO b/lib/Test/Simple/TODO deleted file mode 100644 index c596e90876..0000000000 --- a/lib/Test/Simple/TODO +++ /dev/null @@ -1,18 +0,0 @@ -See https://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Simple plus here's -a few more I haven't put in RT yet. - - Finish (start?) Test::FAQ - - Expand the Test::Tutorial - - $^C exception control? - - Document that everything goes through Test::Builder->ok() - - Add diag() to details(). - - Add at_end() callback? - - Combine all *output methods into outputs(). - - Change *output* to return the old FH, not the new one when setting. diff --git a/lib/Test/Simple/t/00test_harness_check.t b/lib/Test/Simple/t/00test_harness_check.t deleted file mode 100644 index 3ff4a13c63..0000000000 --- a/lib/Test/Simple/t/00test_harness_check.t +++ /dev/null @@ -1,26 +0,0 @@ -#!/usr/bin/perl -w - -# A test to make sure the new Test::Harness was installed properly. - -use Test::More; -plan tests => 1; - -my $TH_Version = 2.03; - -require Test::Harness; -unless( cmp_ok( eval $Test::Harness::VERSION, '>=', $TH_Version, "T::H version" ) ) { - diag <<INSTRUCTIONS; - -Test::Simple/More/Builder has features which depend on a version of -Test::Harness greater than $TH_Version. You have $Test::Harness::VERSION. -Please install a new version from CPAN. - -If you've already tried to upgrade Test::Harness and still get this -message, the new version may be "shadowed" by the old. Check the -output of Test::Harness's "make install" for "## Differing version" -messages. You can delete the old version by running -"make install UNINST=1". - -INSTRUCTIONS -} - diff --git a/lib/Test/Simple/t/BEGIN_require_ok.t b/lib/Test/Simple/t/BEGIN_require_ok.t deleted file mode 100644 index 733d0bb861..0000000000 --- a/lib/Test/Simple/t/BEGIN_require_ok.t +++ /dev/null @@ -1,27 +0,0 @@ -#!/usr/bin/perl -w - -# Fixed a problem with BEGIN { use_ok or require_ok } silently failing when there's no -# plan set. [rt.cpan.org 28345] Thanks Adriano Ferreira and Yitzchak. - -use strict; - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::More; - -my $result; -BEGIN { - $result = require_ok("strict"); -} - -ok $result, "require_ok ran"; - -done_testing(2); diff --git a/lib/Test/Simple/t/BEGIN_use_ok.t b/lib/Test/Simple/t/BEGIN_use_ok.t deleted file mode 100644 index 476badf7a2..0000000000 --- a/lib/Test/Simple/t/BEGIN_use_ok.t +++ /dev/null @@ -1,26 +0,0 @@ -#!/usr/bin/perl -w - -# [rt.cpan.org 28345] -# -# A use_ok() inside a BEGIN block lacking a plan would be silently ignored. - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::More; - -my $result; -BEGIN { - $result = use_ok("strict"); -} - -ok( $result, "use_ok() ran" ); -done_testing(2); - diff --git a/lib/Test/Simple/t/Builder/Builder.t b/lib/Test/Simple/t/Builder/Builder.t deleted file mode 100644 index a5bfd155a6..0000000000 --- a/lib/Test/Simple/t/Builder/Builder.t +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::Builder; -my $Test = Test::Builder->new; - -$Test->plan( tests => 7 ); - -my $default_lvl = $Test->level; -$Test->level(0); - -$Test->ok( 1, 'compiled and new()' ); -$Test->ok( $default_lvl == 1, 'level()' ); - -$Test->is_eq('foo', 'foo', 'is_eq'); -$Test->is_num('23.0', '23', 'is_num'); - -$Test->is_num( $Test->current_test, 4, 'current_test() get' ); - -my $test_num = $Test->current_test + 1; -$Test->current_test( $test_num ); -print "ok $test_num - current_test() set\n"; - -$Test->ok( 1, 'counter still good' ); diff --git a/lib/Test/Simple/t/Builder/carp.t b/lib/Test/Simple/t/Builder/carp.t deleted file mode 100644 index e89eeebfb9..0000000000 --- a/lib/Test/Simple/t/Builder/carp.t +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/perl - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - - -use Test::More tests => 3; -use Test::Builder; - -my $tb = Test::Builder->create; -sub foo { $tb->croak("foo") } -sub bar { $tb->carp("bar") } - -eval { foo() }; -is $@, sprintf "foo at %s line %s.\n", $0, __LINE__ - 1; - -eval { $tb->croak("this") }; -is $@, sprintf "this at %s line %s.\n", $0, __LINE__ - 1; - -{ - my $warning = ''; - local $SIG{__WARN__} = sub { - $warning .= join '', @_; - }; - - bar(); - is $warning, sprintf "bar at %s line %s.\n", $0, __LINE__ - 1; -} diff --git a/lib/Test/Simple/t/Builder/create.t b/lib/Test/Simple/t/Builder/create.t deleted file mode 100644 index d584b30955..0000000000 --- a/lib/Test/Simple/t/Builder/create.t +++ /dev/null @@ -1,40 +0,0 @@ -#!/usr/bin/perl -w - -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::More tests => 7; -use Test::Builder; -use Test::Builder::NoOutput; - -my $more_tb = Test::More->builder; -isa_ok $more_tb, 'Test::Builder'; - -is $more_tb, Test::More->builder, 'create does not interfere with ->builder'; -is $more_tb, Test::Builder->new, ' does not interfere with ->new'; - -{ - my $new_tb = Test::Builder::NoOutput->create; - - isa_ok $new_tb, 'Test::Builder'; - isnt $more_tb, $new_tb, 'Test::Builder->create makes a new object'; - - $new_tb->plan(tests => 1); - $new_tb->ok(1, "a test"); - - is $new_tb->read, <<'OUT'; -1..1 -ok 1 - a test -OUT -} - -pass("Changing output() of new TB doesn't interfere with singleton"); diff --git a/lib/Test/Simple/t/Builder/current_test.t b/lib/Test/Simple/t/Builder/current_test.t deleted file mode 100644 index edd201c0e9..0000000000 --- a/lib/Test/Simple/t/Builder/current_test.t +++ /dev/null @@ -1,11 +0,0 @@ -#!/usr/bin/perl -w - -# Dave Rolsky found a bug where if current_test() is used and no -# tests are run via Test::Builder it will blow up. - -use Test::Builder; -$TB = Test::Builder->new; -$TB->plan(tests => 2); -print "ok 1\n"; -print "ok 2\n"; -$TB->current_test(2); diff --git a/lib/Test/Simple/t/Builder/current_test_without_plan.t b/lib/Test/Simple/t/Builder/current_test_without_plan.t deleted file mode 100644 index 31f9589977..0000000000 --- a/lib/Test/Simple/t/Builder/current_test_without_plan.t +++ /dev/null @@ -1,16 +0,0 @@ -#!/usr/bin/perl -w - -# Test that current_test() will work without a declared plan. - -use Test::Builder; - -my $tb = Test::Builder->new; -$tb->current_test(2); -print <<'END'; -ok 1 -ok 2 -END - -$tb->ok(1, "Third test"); - -$tb->done_testing(3); diff --git a/lib/Test/Simple/t/Builder/details.t b/lib/Test/Simple/t/Builder/details.t deleted file mode 100644 index 05d4828b4d..0000000000 --- a/lib/Test/Simple/t/Builder/details.t +++ /dev/null @@ -1,104 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::More; -use Test::Builder; -my $Test = Test::Builder->new; - -$Test->plan( tests => 9 ); -$Test->level(0); - -my @Expected_Details; - -$Test->is_num( scalar $Test->summary(), 0, 'no tests yet, no summary' ); -push @Expected_Details, { 'ok' => 1, - actual_ok => 1, - name => 'no tests yet, no summary', - type => '', - reason => '' - }; - -# Inline TODO tests will confuse pre 1.20 Test::Harness, so we -# should just avoid the problem and not print it out. -my $start_test = $Test->current_test + 1; - -my $output = ''; -$Test->output(\$output); -$Test->todo_output(\$output); - -SKIP: { - $Test->skip( 'just testing skip' ); -} -push @Expected_Details, { 'ok' => 1, - actual_ok => 1, - name => '', - type => 'skip', - reason => 'just testing skip', - }; - -TODO: { - local $TODO = 'i need a todo'; - $Test->ok( 0, 'a test to todo!' ); - - push @Expected_Details, { 'ok' => 1, - actual_ok => 0, - name => 'a test to todo!', - type => 'todo', - reason => 'i need a todo', - }; - - $Test->todo_skip( 'i need both' ); -} -push @Expected_Details, { 'ok' => 1, - actual_ok => 0, - name => '', - type => 'todo_skip', - reason => 'i need both' - }; - -for ($start_test..$Test->current_test) { print "ok $_\n" } -$Test->reset_outputs; - -$Test->is_num( scalar $Test->summary(), 4, 'summary' ); -push @Expected_Details, { 'ok' => 1, - actual_ok => 1, - name => 'summary', - type => '', - reason => '', - }; - -$Test->current_test(6); -print "ok 6 - current_test incremented\n"; -push @Expected_Details, { 'ok' => 1, - actual_ok => undef, - name => undef, - type => 'unknown', - reason => 'incrementing test number', - }; - -my @details = $Test->details(); -$Test->is_num( scalar @details, 6, - 'details() should return a list of all test details'); - -$Test->level(1); -is_deeply( \@details, \@Expected_Details ); - - -# This test has to come last because it thrashes the test details. -{ - my $curr_test = $Test->current_test; - $Test->current_test(4); - my @details = $Test->details(); - - $Test->current_test($curr_test); - $Test->is_num( scalar @details, 4 ); -} diff --git a/lib/Test/Simple/t/Builder/done_testing.t b/lib/Test/Simple/t/Builder/done_testing.t deleted file mode 100644 index 14a8f918b0..0000000000 --- a/lib/Test/Simple/t/Builder/done_testing.t +++ /dev/null @@ -1,12 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -use Test::Builder; - -my $tb = Test::Builder->new; -$tb->level(0); - -$tb->ok(1, "testing done_testing() with no arguments"); -$tb->ok(1, " another test so we're not testing just one"); -$tb->done_testing(); diff --git a/lib/Test/Simple/t/Builder/done_testing_double.t b/lib/Test/Simple/t/Builder/done_testing_double.t deleted file mode 100644 index 3a0bae247b..0000000000 --- a/lib/Test/Simple/t/Builder/done_testing_double.t +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/perl -w - -use strict; -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::Builder; -use Test::Builder::NoOutput; - -my $tb = Test::Builder::NoOutput->create; - -{ - # Normalize test output - local $ENV{HARNESS_ACTIVE}; - - $tb->ok(1); - $tb->ok(1); - $tb->ok(1); - -#line 24 - $tb->done_testing(3); - $tb->done_testing; - $tb->done_testing; -} - -my $Test = Test::Builder->new; -$Test->plan( tests => 1 ); -$Test->level(0); -$Test->is_eq($tb->read, <<"END", "multiple done_testing"); -ok 1 -ok 2 -ok 3 -1..3 -not ok 4 - done_testing() was already called at $0 line 24 -# Failed test 'done_testing() was already called at $0 line 24' -# at $0 line 25. -not ok 5 - done_testing() was already called at $0 line 24 -# Failed test 'done_testing() was already called at $0 line 24' -# at $0 line 26. -END diff --git a/lib/Test/Simple/t/Builder/done_testing_plan_mismatch.t b/lib/Test/Simple/t/Builder/done_testing_plan_mismatch.t deleted file mode 100644 index 8208635359..0000000000 --- a/lib/Test/Simple/t/Builder/done_testing_plan_mismatch.t +++ /dev/null @@ -1,45 +0,0 @@ -#!/usr/bin/perl -w - -# What if there's a plan and done_testing but they don't match? - -use strict; -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::Builder; -use Test::Builder::NoOutput; - -my $tb = Test::Builder::NoOutput->create; - -{ - # Normalize test output - local $ENV{HARNESS_ACTIVE}; - - $tb->plan( tests => 3 ); - $tb->ok(1); - $tb->ok(1); - $tb->ok(1); - -#line 24 - $tb->done_testing(2); -} - -my $Test = Test::Builder->new; -$Test->plan( tests => 1 ); -$Test->level(0); -$Test->is_eq($tb->read, <<"END"); -1..3 -ok 1 -ok 2 -ok 3 -not ok 4 - planned to run 3 but done_testing() expects 2 -# Failed test 'planned to run 3 but done_testing() expects 2' -# at $0 line 24. -END diff --git a/lib/Test/Simple/t/Builder/done_testing_with_no_plan.t b/lib/Test/Simple/t/Builder/done_testing_with_no_plan.t deleted file mode 100644 index ff5f40c197..0000000000 --- a/lib/Test/Simple/t/Builder/done_testing_with_no_plan.t +++ /dev/null @@ -1,11 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -use Test::Builder; - -my $tb = Test::Builder->new; -$tb->plan( "no_plan" ); -$tb->ok(1); -$tb->ok(1); -$tb->done_testing(2); diff --git a/lib/Test/Simple/t/Builder/done_testing_with_number.t b/lib/Test/Simple/t/Builder/done_testing_with_number.t deleted file mode 100644 index c21458f54e..0000000000 --- a/lib/Test/Simple/t/Builder/done_testing_with_number.t +++ /dev/null @@ -1,12 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -use Test::Builder; - -my $tb = Test::Builder->new; -$tb->level(0); - -$tb->ok(1, "testing done_testing() with no arguments"); -$tb->ok(1, " another test so we're not testing just one"); -$tb->done_testing(2); diff --git a/lib/Test/Simple/t/Builder/done_testing_with_plan.t b/lib/Test/Simple/t/Builder/done_testing_with_plan.t deleted file mode 100644 index c0a3d0f014..0000000000 --- a/lib/Test/Simple/t/Builder/done_testing_with_plan.t +++ /dev/null @@ -1,11 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -use Test::Builder; - -my $tb = Test::Builder->new; -$tb->plan( tests => 2 ); -$tb->ok(1); -$tb->ok(1); -$tb->done_testing(2); diff --git a/lib/Test/Simple/t/Builder/fork_with_new_stdout.t b/lib/Test/Simple/t/Builder/fork_with_new_stdout.t deleted file mode 100644 index e38c1d08cb..0000000000 --- a/lib/Test/Simple/t/Builder/fork_with_new_stdout.t +++ /dev/null @@ -1,54 +0,0 @@ -#!perl -w -use strict; -use warnings; -use IO::Pipe; -use Test::Builder; -use Config; - -my $b = Test::Builder->new; -$b->reset; - -my $Can_Fork = $Config{d_fork} || - (($^O eq 'MSWin32' || $^O eq 'NetWare') and - $Config{useithreads} and - $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/ - ); - -if( !$Can_Fork ) { - $b->plan('skip_all' => "This system cannot fork"); -} -else { - $b->plan('tests' => 2); -} - -my $pipe = IO::Pipe->new; -if ( my $pid = fork ) { - $pipe->reader; - $b->ok((<$pipe> =~ /FROM CHILD: ok 1/), "ok 1 from child"); - $b->ok((<$pipe> =~ /FROM CHILD: 1\.\.1/), "1..1 from child"); - waitpid($pid, 0); -} -else { - $pipe->writer; - my $pipe_fd = $pipe->fileno; - close STDOUT; - open(STDOUT, ">&$pipe_fd"); - my $b = Test::Builder->new; - $b->reset; - $b->no_plan; - $b->ok(1); -} - - -=pod -#actual -1..2 -ok 1 -1..1 -ok 1 -ok 2 -#expected -1..2 -ok 1 -ok 2 -=cut diff --git a/lib/Test/Simple/t/Builder/has_plan.t b/lib/Test/Simple/t/Builder/has_plan.t deleted file mode 100644 index d0be86a97a..0000000000 --- a/lib/Test/Simple/t/Builder/has_plan.t +++ /dev/null @@ -1,23 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib'); - } -} - -use strict; -use Test::Builder; - -my $unplanned; - -BEGIN { - $unplanned = 'oops'; - $unplanned = Test::Builder->new->has_plan; -}; - -use Test::More tests => 2; - -is($unplanned, undef, 'no plan yet defined'); -is(Test::Builder->new->has_plan, 2, 'has fixed plan'); diff --git a/lib/Test/Simple/t/Builder/has_plan2.t b/lib/Test/Simple/t/Builder/has_plan2.t deleted file mode 100644 index e13ea4af94..0000000000 --- a/lib/Test/Simple/t/Builder/has_plan2.t +++ /dev/null @@ -1,22 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::More; - -BEGIN { - if( !$ENV{HARNESS_ACTIVE} && $ENV{PERL_CORE} ) { - plan skip_all => "Won't work with t/TEST"; - } -} - -use strict; -use Test::Builder; - -plan 'no_plan'; -is(Test::Builder->new->has_plan, 'no_plan', 'has no_plan'); diff --git a/lib/Test/Simple/t/Builder/is_fh.t b/lib/Test/Simple/t/Builder/is_fh.t deleted file mode 100644 index 0eb3ec0b15..0000000000 --- a/lib/Test/Simple/t/Builder/is_fh.t +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Test::More tests => 11; -use TieOut; - -ok( !Test::Builder->is_fh("foo"), 'string is not a filehandle' ); -ok( !Test::Builder->is_fh(''), 'empty string' ); -ok( !Test::Builder->is_fh(undef), 'undef' ); - -ok( open(FILE, '>foo') ); -END { close FILE; 1 while unlink 'foo' } - -ok( Test::Builder->is_fh(*FILE) ); -ok( Test::Builder->is_fh(\*FILE) ); -ok( Test::Builder->is_fh(*FILE{IO}) ); - -tie *OUT, 'TieOut'; -ok( Test::Builder->is_fh(*OUT) ); -ok( Test::Builder->is_fh(\*OUT) ); - -SKIP: { - skip "*TIED_HANDLE{IO} doesn't work in this perl", 1 - unless defined *OUT{IO}; - ok( Test::Builder->is_fh(*OUT{IO}) ); -} - - -package Lying::isa; - -sub isa { - my $self = shift; - my $parent = shift; - - return 1 if $parent eq 'IO::Handle'; -} - -::ok( Test::Builder->is_fh(bless {}, "Lying::isa")); diff --git a/lib/Test/Simple/t/Builder/maybe_regex.t b/lib/Test/Simple/t/Builder/maybe_regex.t deleted file mode 100644 index d1927a56e5..0000000000 --- a/lib/Test/Simple/t/Builder/maybe_regex.t +++ /dev/null @@ -1,60 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Test::More tests => 16; - -use Test::Builder; -my $Test = Test::Builder->new; - -my $r = $Test->maybe_regex(qr/^FOO$/i); -ok(defined $r, 'qr// detected'); -ok(('foo' =~ /$r/), 'qr// good match'); -ok(('bar' !~ /$r/), 'qr// bad match'); - -SKIP: { - skip "blessed regex checker added in 5.10", 3 if $] < 5.010; - - my $obj = bless qr/foo/, 'Wibble'; - my $re = $Test->maybe_regex($obj); - ok( defined $re, "blessed regex detected" ); - ok( ('foo' =~ /$re/), 'blessed qr/foo/ good match' ); - ok( ('bar' !~ /$re/), 'blessed qr/foo/ bad math' ); -} - -{ - my $r = $Test->maybe_regex('/^BAR$/i'); - ok(defined $r, '"//" detected'); - ok(('bar' =~ m/$r/), '"//" good match'); - ok(('foo' !~ m/$r/), '"//" bad match'); -}; - -{ - my $r = $Test->maybe_regex('not a regex'); - ok(!defined $r, 'non-regex detected'); -}; - - -{ - my $r = $Test->maybe_regex('/0/'); - ok(defined $r, 'non-regex detected'); - ok(('f00' =~ m/$r/), '"//" good match'); - ok(('b4r' !~ m/$r/), '"//" bad match'); -}; - - -{ - my $r = $Test->maybe_regex('m,foo,i'); - ok(defined $r, 'm,, detected'); - ok(('fOO' =~ m/$r/), '"//" good match'); - ok(('bar' !~ m/$r/), '"//" bad match'); -}; diff --git a/lib/Test/Simple/t/Builder/no_diag.t b/lib/Test/Simple/t/Builder/no_diag.t deleted file mode 100644 index 6fa538a82e..0000000000 --- a/lib/Test/Simple/t/Builder/no_diag.t +++ /dev/null @@ -1,8 +0,0 @@ -#!/usr/bin/perl -w - -use Test::More 'no_diag', tests => 2; - -pass('foo'); -diag('This should not be displayed'); - -is(Test::More->builder->no_diag, 1); diff --git a/lib/Test/Simple/t/Builder/no_ending.t b/lib/Test/Simple/t/Builder/no_ending.t deleted file mode 100644 index 97e968e289..0000000000 --- a/lib/Test/Simple/t/Builder/no_ending.t +++ /dev/null @@ -1,21 +0,0 @@ -use Test::Builder; - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -BEGIN { - my $t = Test::Builder->new; - $t->no_ending(1); -} - -use Test::More tests => 3; - -# Normally, Test::More would yell that we ran too few tests, but we -# supressed the ending diagnostics. -pass; -print "ok 2\n"; -print "ok 3\n"; diff --git a/lib/Test/Simple/t/Builder/no_header.t b/lib/Test/Simple/t/Builder/no_header.t deleted file mode 100644 index 93e6bec34c..0000000000 --- a/lib/Test/Simple/t/Builder/no_header.t +++ /dev/null @@ -1,21 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::Builder; - -# STDOUT must be unbuffered else our prints might come out after -# Test::More's. -$| = 1; - -BEGIN { - Test::Builder->new->no_header(1); -} - -use Test::More tests => 1; - -print "1..1\n"; -pass; diff --git a/lib/Test/Simple/t/Builder/no_plan_at_all.t b/lib/Test/Simple/t/Builder/no_plan_at_all.t deleted file mode 100644 index 9029f6f6e7..0000000000 --- a/lib/Test/Simple/t/Builder/no_plan_at_all.t +++ /dev/null @@ -1,36 +0,0 @@ -#!/usr/bin/perl -w - -# Test what happens when no plan is delcared and done_testing() is not seen - -use strict; -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::Builder; -use Test::Builder::NoOutput; - -my $Test = Test::Builder->new; -$Test->level(0); -$Test->plan( tests => 1 ); - -my $tb = Test::Builder::NoOutput->create; - -{ - $tb->level(0); - $tb->ok(1, "just a test"); - $tb->ok(1, " and another"); - $tb->_ending; -} - -$Test->is_eq($tb->read, <<'END', "proper behavior when no plan is seen"); -ok 1 - just a test -ok 2 - and another -# Tests were run but no plan was declared and done_testing() was not seen. -END diff --git a/lib/Test/Simple/t/Builder/ok_obj.t b/lib/Test/Simple/t/Builder/ok_obj.t deleted file mode 100644 index 8678dbff8d..0000000000 --- a/lib/Test/Simple/t/Builder/ok_obj.t +++ /dev/null @@ -1,29 +0,0 @@ -#!/usr/bin/perl -w - -# Testing to make sure Test::Builder doesn't accidentally store objects -# passed in as test arguments. - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::More tests => 4; - -package Foo; -my $destroyed = 0; -sub new { bless {}, shift } - -sub DESTROY { - $destroyed++; -} - -package main; - -for (1..3) { - ok(my $foo = Foo->new, 'created Foo object'); -} -is $destroyed, 3, "DESTROY called 3 times"; - diff --git a/lib/Test/Simple/t/Builder/output.t b/lib/Test/Simple/t/Builder/output.t deleted file mode 100644 index 77e0e0bbb3..0000000000 --- a/lib/Test/Simple/t/Builder/output.t +++ /dev/null @@ -1,113 +0,0 @@ -#!perl -w - -use strict; - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} -chdir 't'; - -use Test::Builder; - -# The real Test::Builder -my $Test = Test::Builder->new; -$Test->plan( tests => 6 ); - - -# The one we're going to test. -my $tb = Test::Builder->create(); - -my $tmpfile = 'foo.tmp'; -END { 1 while unlink($tmpfile) } - -# Test output to a file -{ - my $out = $tb->output($tmpfile); - $Test->ok( defined $out ); - - print $out "hi!\n"; - close *$out; - - undef $out; - open(IN, $tmpfile) or die $!; - chomp(my $line = <IN>); - close IN; - - $Test->is_eq($line, 'hi!'); -} - - -# Test output to a filehandle -{ - open(FOO, ">>$tmpfile") or die $!; - my $out = $tb->output(\*FOO); - my $old = select *$out; - print "Hello!\n"; - close *$out; - undef $out; - select $old; - open(IN, $tmpfile) or die $!; - my @lines = <IN>; - close IN; - - $Test->like($lines[1], qr/Hello!/); -} - - -# Test output to a scalar ref -{ - my $scalar = ''; - my $out = $tb->output(\$scalar); - - print $out "Hey hey hey!\n"; - $Test->is_eq($scalar, "Hey hey hey!\n"); -} - - -# Test we can output to the same scalar ref -{ - my $scalar = ''; - my $out = $tb->output(\$scalar); - my $err = $tb->failure_output(\$scalar); - - print $out "To output "; - print $err "and beyond!"; - - $Test->is_eq($scalar, "To output and beyond!", "One scalar, two filehandles"); -} - - -# Ensure stray newline in name escaping works. -{ - my $fakeout = ''; - my $out = $tb->output(\$fakeout); - $tb->exported_to(__PACKAGE__); - $tb->no_ending(1); - $tb->plan(tests => 5); - - $tb->ok(1, "ok"); - $tb->ok(1, "ok\n"); - $tb->ok(1, "ok, like\nok"); - $tb->skip("wibble\nmoof"); - $tb->todo_skip("todo\nskip\n"); - - $Test->is_eq( $fakeout, <<OUTPUT ) || print STDERR $fakeout; -1..5 -ok 1 - ok -ok 2 - ok -# -ok 3 - ok, like -# ok -ok 4 # skip wibble -# moof -not ok 5 # TODO & SKIP todo -# skip -# -OUTPUT -} diff --git a/lib/Test/Simple/t/Builder/reset.t b/lib/Test/Simple/t/Builder/reset.t deleted file mode 100644 index 6bff7fcf27..0000000000 --- a/lib/Test/Simple/t/Builder/reset.t +++ /dev/null @@ -1,73 +0,0 @@ -#!/usr/bin/perl -w - -# Test Test::Builder->reset; - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} -chdir 't'; - - -use Test::Builder; -my $Test = Test::Builder->new; -my $tb = Test::Builder->create; - -# We'll need this later to know the outputs were reset -my %Original_Output; -$Original_Output{$_} = $tb->$_ for qw(output failure_output todo_output); - -# Alter the state of Test::Builder as much as possible. -my $output = ''; -$tb->output(\$output); -$tb->failure_output(\$output); -$tb->todo_output(\$output); - -$tb->plan(tests => 14); -$tb->level(0); - -$tb->ok(1, "Running a test to alter TB's state"); - -# This won't print since we just sent output off to oblivion. -$tb->ok(0, "And a failure for fun"); - -$Test::Builder::Level = 3; - -$tb->exported_to('Foofer'); - -$tb->use_numbers(0); -$tb->no_header(1); -$tb->no_ending(1); - - -# Now reset it. -$tb->reset; - - -$Test->ok( !defined $tb->exported_to, 'exported_to' ); -$Test->is_eq( $tb->expected_tests, 0, 'expected_tests' ); -$Test->is_eq( $tb->level, 1, 'level' ); -$Test->is_eq( $tb->use_numbers, 1, 'use_numbers' ); -$Test->is_eq( $tb->no_header, 0, 'no_header' ); -$Test->is_eq( $tb->no_ending, 0, 'no_ending' ); -$Test->is_eq( $tb->current_test, 0, 'current_test' ); -$Test->is_eq( scalar $tb->summary, 0, 'summary' ); -$Test->is_eq( scalar $tb->details, 0, 'details' ); -$Test->is_eq( fileno $tb->output, - fileno $Original_Output{output}, 'output' ); -$Test->is_eq( fileno $tb->failure_output, - fileno $Original_Output{failure_output}, 'failure_output' ); -$Test->is_eq( fileno $tb->todo_output, - fileno $Original_Output{todo_output}, 'todo_output' ); - -$tb->current_test(12); -$tb->level(0); -$tb->ok(1, 'final test to make sure output was reset'); - -$Test->current_test(13); -$Test->done_testing(13); diff --git a/lib/Test/Simple/t/Builder/try.t b/lib/Test/Simple/t/Builder/try.t deleted file mode 100644 index eeb3bcb1ab..0000000000 --- a/lib/Test/Simple/t/Builder/try.t +++ /dev/null @@ -1,42 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; - -use Test::More 'no_plan'; - -require Test::Builder; -my $tb = Test::Builder->new; - - -# Test that _try() has no effect on $@ and $! and is not effected by -# __DIE__ -{ - local $SIG{__DIE__} = sub { fail("DIE handler called: @_") }; - local $@ = 42; - local $! = 23; - - is $tb->_try(sub { 2 }), 2; - is $tb->_try(sub { return '' }), ''; - - is $tb->_try(sub { die; }), undef; - - is_deeply [$tb->_try(sub { die "Foo\n" })], [undef, "Foo\n"]; - - is $@, 42; - cmp_ok $!, '==', 23; -} - -ok !eval { - $tb->_try(sub { die "Died\n" }, die_on_fail => 1); -}; -is $@, "Died\n"; diff --git a/lib/Test/Simple/t/More.t b/lib/Test/Simple/t/More.t deleted file mode 100644 index 21958cf2b6..0000000000 --- a/lib/Test/Simple/t/More.t +++ /dev/null @@ -1,179 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = qw(../lib ../lib/Test/Simple/t/lib); - } -} - -use lib 't/lib'; -use Test::More tests => 53; - -# Make sure we don't mess with $@ or $!. Test at bottom. -my $Err = "this should not be touched"; -my $Errno = 42; -$@ = $Err; -$! = $Errno; - -use_ok('Dummy'); -is( $Dummy::VERSION, '0.01', 'use_ok() loads a module' ); -require_ok('Test::More'); - - -ok( 2 eq 2, 'two is two is two is two' ); -is( "foo", "foo", 'foo is foo' ); -isnt( "foo", "bar", 'foo isnt bar'); -isn't("foo", "bar", 'foo isn\'t bar'); - -#'# -like("fooble", '/^foo/', 'foo is like fooble'); -like("FooBle", '/foo/i', 'foo is like FooBle'); -like("/usr/local/pr0n/", '/^\/usr\/local/', 'regexes with slashes in like' ); - -unlike("fbar", '/^bar/', 'unlike bar'); -unlike("FooBle", '/foo/', 'foo is unlike FooBle'); -unlike("/var/local/pr0n/", '/^\/usr\/local/','regexes with slashes in unlike' ); - -my @foo = qw(foo bar baz); -unlike(@foo, '/foo/'); - -can_ok('Test::More', qw(require_ok use_ok ok is isnt like skip can_ok - pass fail eq_array eq_hash eq_set)); -can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip - can_ok pass fail eq_array eq_hash eq_set)); - - -isa_ok(bless([], "Foo"), "Foo"); -isa_ok([], 'ARRAY'); -isa_ok(\42, 'SCALAR'); -{ - local %Bar::; - local @Foo::ISA = 'Bar'; - isa_ok( "Foo", "Bar" ); -} - - -# can_ok() & isa_ok should call can() & isa() on the given object, not -# just class, in case of custom can() -{ - local *Foo::can; - local *Foo::isa; - *Foo::can = sub { $_[0]->[0] }; - *Foo::isa = sub { $_[0]->[0] }; - my $foo = bless([0], 'Foo'); - ok( ! $foo->can('bar') ); - ok( ! $foo->isa('bar') ); - $foo->[0] = 1; - can_ok( $foo, 'blah'); - isa_ok( $foo, 'blah'); -} - - -pass('pass() passed'); - -ok( eq_array([qw(this that whatever)], [qw(this that whatever)]), - 'eq_array with simple arrays' ); -is @Test::More::Data_Stack, 0, '@Data_Stack not holding onto things'; - -ok( eq_hash({ foo => 42, bar => 23 }, {bar => 23, foo => 42}), - 'eq_hash with simple hashes' ); -is @Test::More::Data_Stack, 0; - -ok( eq_set([qw(this that whatever)], [qw(that whatever this)]), - 'eq_set with simple sets' ); -is @Test::More::Data_Stack, 0; - -my @complex_array1 = ( - [qw(this that whatever)], - {foo => 23, bar => 42}, - "moo", - "yarrow", - [qw(498 10 29)], - ); -my @complex_array2 = ( - [qw(this that whatever)], - {foo => 23, bar => 42}, - "moo", - "yarrow", - [qw(498 10 29)], - ); - -is_deeply( \@complex_array1, \@complex_array2, 'is_deeply with arrays' ); -ok( eq_array(\@complex_array1, \@complex_array2), - 'eq_array with complicated arrays' ); -ok( eq_set(\@complex_array1, \@complex_array2), - 'eq_set with complicated arrays' ); - -my @array1 = (qw(this that whatever), - {foo => 23, bar => 42} ); -my @array2 = (qw(this that whatever), - {foo => 24, bar => 42} ); - -ok( !eq_array(\@array1, \@array2), - 'eq_array with slightly different complicated arrays' ); -is @Test::More::Data_Stack, 0; - -ok( !eq_set(\@array1, \@array2), - 'eq_set with slightly different complicated arrays' ); -is @Test::More::Data_Stack, 0; - -my %hash1 = ( foo => 23, - bar => [qw(this that whatever)], - har => { foo => 24, bar => 42 }, - ); -my %hash2 = ( foo => 23, - bar => [qw(this that whatever)], - har => { foo => 24, bar => 42 }, - ); - -is_deeply( \%hash1, \%hash2, 'is_deeply with complicated hashes' ); -ok( eq_hash(\%hash1, \%hash2), 'eq_hash with complicated hashes'); - -%hash1 = ( foo => 23, - bar => [qw(this that whatever)], - har => { foo => 24, bar => 42 }, - ); -%hash2 = ( foo => 23, - bar => [qw(this tha whatever)], - har => { foo => 24, bar => 42 }, - ); - -ok( !eq_hash(\%hash1, \%hash2), - 'eq_hash with slightly different complicated hashes' ); -is @Test::More::Data_Stack, 0; - -is( Test::Builder->new, Test::More->builder, 'builder()' ); - - -cmp_ok(42, '==', 42, 'cmp_ok =='); -cmp_ok('foo', 'eq', 'foo', ' eq'); -cmp_ok(42.5, '<', 42.6, ' <'); -cmp_ok(0, '||', 1, ' ||'); - - -# Piers pointed out sometimes people override isa(). -{ - package Wibble; - sub isa { - my($self, $class) = @_; - return 1 if $class eq 'Wibblemeister'; - } - sub new { bless {} } -} -isa_ok( Wibble->new, 'Wibblemeister' ); - -my $sub = sub {}; -is_deeply( $sub, $sub, 'the same function ref' ); - -use Symbol; -my $glob = gensym; -is_deeply( $glob, $glob, 'the same glob' ); - -is_deeply( { foo => $sub, bar => [1, $glob] }, - { foo => $sub, bar => [1, $glob] } - ); - -# These two tests must remain at the end. -is( $@, $Err, '$@ untouched' ); -cmp_ok( $!, '==', $Errno, '$! untouched' ); diff --git a/lib/Test/Simple/t/Tester/tbt_01basic.t b/lib/Test/Simple/t/Tester/tbt_01basic.t deleted file mode 100644 index 769a1c4729..0000000000 --- a/lib/Test/Simple/t/Tester/tbt_01basic.t +++ /dev/null @@ -1,55 +0,0 @@ -#!/usr/bin/perl - -use Test::Builder::Tester tests => 9; -use Test::More; - -ok(1,"This is a basic test"); - -test_out("ok 1 - tested"); -ok(1,"tested"); -test_test("captured okay on basic"); - -test_out("ok 1 - tested"); -ok(1,"tested"); -test_test("captured okay again without changing number"); - -ok(1,"test unrelated to Test::Builder::Tester"); - -test_out("ok 1 - one"); -test_out("ok 2 - two"); -ok(1,"one"); -ok(2,"two"); -test_test("multiple tests"); - -test_out("not ok 1 - should fail"); -test_err("# Failed test ($0 at line 28)"); -test_err("# got: 'foo'"); -test_err("# expected: 'bar'"); -is("foo","bar","should fail"); -test_test("testing failing"); - - -test_out("not ok 1"); -test_out("not ok 2"); -test_fail(+2); -test_fail(+1); -fail(); fail(); -test_test("testing failing on the same line with no name"); - - -test_out("not ok 1 - name"); -test_out("not ok 2 - name"); -test_fail(+2); -test_fail(+1); -fail("name"); fail("name"); -test_test("testing failing on the same line with the same name"); - - -test_out("not ok 1 - name # TODO Something"); -test_err("# Failed (TODO) test ($0 at line 52)"); -TODO: { - local $TODO = "Something"; - fail("name"); -} -test_test("testing failing with todo"); - diff --git a/lib/Test/Simple/t/Tester/tbt_02fhrestore.t b/lib/Test/Simple/t/Tester/tbt_02fhrestore.t deleted file mode 100644 index e37357171b..0000000000 --- a/lib/Test/Simple/t/Tester/tbt_02fhrestore.t +++ /dev/null @@ -1,58 +0,0 @@ -#!/usr/bin/perl - -use Test::Builder::Tester tests => 4; -use Test::More; -use Symbol; - -# create temporary file handles that still point indirectly -# to the right place - -my $orig_o = gensym; -my $orig_t = gensym; -my $orig_f = gensym; - -tie *$orig_o, "My::Passthru", \*STDOUT; -tie *$orig_t, "My::Passthru", \*STDERR; -tie *$orig_f, "My::Passthru", \*STDERR; - -# redirect the file handles to somewhere else for a mo - -use Test::Builder; -my $t = Test::Builder->new(); - -$t->output($orig_o); -$t->failure_output($orig_f); -$t->todo_output($orig_t); - -# run a test - -test_out("ok 1 - tested"); -ok(1,"tested"); -test_test("standard test okay"); - -# now check that they were restored okay - -ok($orig_o == $t->output(), "output file reconnected"); -ok($orig_t == $t->todo_output(), "todo output file reconnected"); -ok($orig_f == $t->failure_output(), "failure output file reconnected"); - -##################################################################### - -package My::Passthru; - -sub PRINT { - my $self = shift; - my $handle = $self->[0]; - print $handle @_; -} - -sub TIEHANDLE { - my $class = shift; - my $self = [shift()]; - return bless $self, $class; -} - -sub READ {} -sub READLINE {} -sub GETC {} -sub FILENO {} diff --git a/lib/Test/Simple/t/Tester/tbt_03die.t b/lib/Test/Simple/t/Tester/tbt_03die.t deleted file mode 100644 index b9dba801eb..0000000000 --- a/lib/Test/Simple/t/Tester/tbt_03die.t +++ /dev/null @@ -1,12 +0,0 @@ -#!/usr/bin/perl - -use Test::Builder::Tester tests => 1; -use Test::More; - -eval { - test_test("foo"); -}; -like($@, - "/Not testing\. You must declare output with a test function first\./", - "dies correctly on error"); - diff --git a/lib/Test/Simple/t/Tester/tbt_04line_num.t b/lib/Test/Simple/t/Tester/tbt_04line_num.t deleted file mode 100644 index 9e8365acbf..0000000000 --- a/lib/Test/Simple/t/Tester/tbt_04line_num.t +++ /dev/null @@ -1,8 +0,0 @@ -#!/usr/bin/perl - -use Test::More tests => 3; -use Test::Builder::Tester; - -is(line_num(),6,"normal line num"); -is(line_num(-1),6,"line number minus one"); -is(line_num(+2),10,"line number plus two"); diff --git a/lib/Test/Simple/t/Tester/tbt_05faildiag.t b/lib/Test/Simple/t/Tester/tbt_05faildiag.t deleted file mode 100644 index 59ad721240..0000000000 --- a/lib/Test/Simple/t/Tester/tbt_05faildiag.t +++ /dev/null @@ -1,44 +0,0 @@ -#!/usr/bin/perl - -use Test::Builder::Tester tests => 5; -use Test::More; - -# test_fail - -test_out("not ok 1 - one"); -test_fail(+1); -ok(0,"one"); - -test_out("not ok 2 - two"); -test_fail(+2); - -ok(0,"two"); - -test_test("test fail"); - -test_fail(+2); -test_out("not ok 1 - one"); -ok(0,"one"); -test_test("test_fail first"); - -# test_diag - -use Test::Builder; -my $test = new Test::Builder; - -test_diag("this is a test string","so is this"); -$test->diag("this is a test string\n", "so is this\n"); -test_test("test diag"); - -test_diag("this is a test string","so is this"); -$test->diag("this is a test string\n"); -$test->diag("so is this\n"); -test_test("test diag multi line"); - -test_diag("this is a test string"); -test_diag("so is this"); -$test->diag("this is a test string\n"); -$test->diag("so is this\n"); -test_test("test diag multiple"); - - diff --git a/lib/Test/Simple/t/Tester/tbt_06errormess.t b/lib/Test/Simple/t/Tester/tbt_06errormess.t deleted file mode 100644 index d8d8a0fead..0000000000 --- a/lib/Test/Simple/t/Tester/tbt_06errormess.t +++ /dev/null @@ -1,120 +0,0 @@ -#!/usr/bin/perl -w - -use Test::More tests => 8; -use Symbol; -use Test::Builder; -use Test::Builder::Tester; - -use strict; - -# argh! now we need to test the thing we're testing. Basically we need -# to pretty much reimplement the whole code again. This is very -# annoying but can't be avoided. And onwards with the cut and paste - -# My brain is melting. My brain is melting. ETOOMANYLAYERSOFTESTING - -# create some private file handles -my $output_handle = gensym; -my $error_handle = gensym; - -# and tie them to this package -my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT"; -my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR"; - -# ooooh, use the test suite -my $t = Test::Builder->new; - -# remember the testing outputs -my $original_output_handle; -my $original_failure_handle; -my $original_todo_handle; -my $original_harness_env; -my $testing_num; - -sub start_testing -{ - # remember what the handles were set to - $original_output_handle = $t->output(); - $original_failure_handle = $t->failure_output(); - $original_todo_handle = $t->todo_output(); - $original_harness_env = $ENV{HARNESS_ACTIVE}; - - # switch out to our own handles - $t->output($output_handle); - $t->failure_output($error_handle); - $t->todo_output($error_handle); - - $ENV{HARNESS_ACTIVE} = 0; - - # clear the expected list - $out->reset(); - $err->reset(); - - # remeber that we're testing - $testing_num = $t->current_test; - $t->current_test(0); -} - -# each test test is actually two tests. This is bad and wrong -# but makes blood come out of my ears if I don't at least simplify -# it a little this way - -sub my_test_test -{ - my $text = shift; - local $^W = 0; - - # reset the outputs - $t->output($original_output_handle); - $t->failure_output($original_failure_handle); - $t->todo_output($original_todo_handle); - $ENV{HARNESS_ACTIVE} = $original_harness_env; - - # reset the number of tests - $t->current_test($testing_num); - - # check we got the same values - my $got; - my $wanted; - - # stdout - $t->ok($out->check, "STDOUT $text"); - - # stderr - $t->ok($err->check, "STDERR $text"); -} - -#################################################################### -# Meta meta tests -#################################################################### - -# this is a quick test to check the hack that I've just implemented -# actually does a cut down version of Test::Builder::Tester - -start_testing(); -$out->expect("ok 1 - foo"); -pass("foo"); -my_test_test("basic meta meta test"); - -start_testing(); -$out->expect("not ok 1 - foo"); -$err->expect("# Failed test ($0 at line ".line_num(+1).")"); -fail("foo"); -my_test_test("basic meta meta test 2"); - -start_testing(); -$out->expect("ok 1 - bar"); -test_out("ok 1 - foo"); -pass("foo"); -test_test("bar"); -my_test_test("meta meta test with tbt"); - -start_testing(); -$out->expect("ok 1 - bar"); -test_out("not ok 1 - foo"); -test_err("# Failed test ($0 at line ".line_num(+1).")"); -fail("foo"); -test_test("bar"); -my_test_test("meta meta test with tbt2 "); - -#################################################################### diff --git a/lib/Test/Simple/t/Tester/tbt_07args.t b/lib/Test/Simple/t/Tester/tbt_07args.t deleted file mode 100644 index 1b9393bdf4..0000000000 --- a/lib/Test/Simple/t/Tester/tbt_07args.t +++ /dev/null @@ -1,215 +0,0 @@ -#!/usr/bin/perl -w - -use Test::More tests => 18; -use Symbol; -use Test::Builder; -use Test::Builder::Tester; - -use strict; - -# argh! now we need to test the thing we're testing. Basically we need -# to pretty much reimplement the whole code again. This is very -# annoying but can't be avoided. And onwards with the cut and paste - -# My brain is melting. My brain is melting. ETOOMANYLAYERSOFTESTING - -# create some private file handles -my $output_handle = gensym; -my $error_handle = gensym; - -# and tie them to this package -my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT"; -my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR"; - -# ooooh, use the test suite -my $t = Test::Builder->new; - -# remember the testing outputs -my $original_output_handle; -my $original_failure_handle; -my $original_todo_handle; -my $testing_num; -my $original_harness_env; - -sub start_testing -{ - # remember what the handles were set to - $original_output_handle = $t->output(); - $original_failure_handle = $t->failure_output(); - $original_todo_handle = $t->todo_output(); - $original_harness_env = $ENV{HARNESS_ACTIVE}; - - # switch out to our own handles - $t->output($output_handle); - $t->failure_output($error_handle); - $t->todo_output($error_handle); - - $ENV{HARNESS_ACTIVE} = 0; - - # clear the expected list - $out->reset(); - $err->reset(); - - # remeber that we're testing - $testing_num = $t->current_test; - $t->current_test(0); -} - -# each test test is actually two tests. This is bad and wrong -# but makes blood come out of my ears if I don't at least simplify -# it a little this way - -sub my_test_test -{ - my $text = shift; - local $^W = 0; - - # reset the outputs - $t->output($original_output_handle); - $t->failure_output($original_failure_handle); - $t->todo_output($original_todo_handle); - $ENV{HARNESS_ACTIVE} = $original_harness_env; - - # reset the number of tests - $t->current_test($testing_num); - - # check we got the same values - my $got; - my $wanted; - - # stdout - $t->ok($out->check, "STDOUT $text"); - - # stderr - $t->ok($err->check, "STDERR $text"); -} - -#################################################################### -# Meta meta tests -#################################################################### - -# this is a quick test to check the hack that I've just implemented -# actually does a cut down version of Test::Builder::Tester - -start_testing(); -$out->expect("ok 1 - foo"); -pass("foo"); -my_test_test("basic meta meta test"); - -start_testing(); -$out->expect("not ok 1 - foo"); -$err->expect("# Failed test ($0 at line ".line_num(+1).")"); -fail("foo"); -my_test_test("basic meta meta test 2"); - -start_testing(); -$out->expect("ok 1 - bar"); -test_out("ok 1 - foo"); -pass("foo"); -test_test("bar"); -my_test_test("meta meta test with tbt"); - -start_testing(); -$out->expect("ok 1 - bar"); -test_out("not ok 1 - foo"); -test_err("# Failed test ($0 at line ".line_num(+1).")"); -fail("foo"); -test_test("bar"); -my_test_test("meta meta test with tbt2 "); - -#################################################################### -# Actual meta tests -#################################################################### - -# set up the outer wrapper again -start_testing(); -$out->expect("ok 1 - bar"); - -# set up what the inner wrapper expects -test_out("ok 1 - foo"); - -# the actual test function that we are testing -ok("1","foo"); - -# test the name -test_test(name => "bar"); - -# check that passed -my_test_test("meta test name"); - -#################################################################### - -# set up the outer wrapper again -start_testing(); -$out->expect("ok 1 - bar"); - -# set up what the inner wrapper expects -test_out("ok 1 - foo"); - -# the actual test function that we are testing -ok("1","foo"); - -# test the name -test_test(title => "bar"); - -# check that passed -my_test_test("meta test title"); - -#################################################################### - -# set up the outer wrapper again -start_testing(); -$out->expect("ok 1 - bar"); - -# set up what the inner wrapper expects -test_out("ok 1 - foo"); - -# the actual test function that we are testing -ok("1","foo"); - -# test the name -test_test(label => "bar"); - -# check that passed -my_test_test("meta test title"); - -#################################################################### - -# set up the outer wrapper again -start_testing(); -$out->expect("ok 1 - bar"); - -# set up what the inner wrapper expects -test_out("not ok 1 - foo this is wrong"); -test_fail(+3); - -# the actual test function that we are testing -ok("0","foo"); - -# test that we got what we expect, ignoring our is wrong -test_test(skip_out => 1, name => "bar"); - -# check that that passed -my_test_test("meta test skip_out"); - -#################################################################### - -# set up the outer wrapper again -start_testing(); -$out->expect("ok 1 - bar"); - -# set up what the inner wrapper expects -test_out("not ok 1 - foo"); -test_err("this is wrong"); - -# the actual test function that we are testing -ok("0","foo"); - -# test that we got what we expect, ignoring err is wrong -test_test(skip_err => 1, name => "bar"); - -# diagnostics failing out -# check that that passed -my_test_test("meta test skip_err"); - -#################################################################### diff --git a/lib/Test/Simple/t/bad_plan.t b/lib/Test/Simple/t/bad_plan.t deleted file mode 100644 index 80e0e65bca..0000000000 --- a/lib/Test/Simple/t/bad_plan.t +++ /dev/null @@ -1,23 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::Builder; -my $Test = Test::Builder->new; -$Test->plan( tests => 2 ); -$Test->level(0); - -my $tb = Test::Builder->create; - -eval { $tb->plan(7); }; -$Test->like( $@, qr/^plan\(\) doesn't understand 7/, 'bad plan()' ) || - print STDERR "# $@"; - -eval { $tb->plan(wibble => 7); }; -$Test->like( $@, qr/^plan\(\) doesn't understand wibble 7/, 'bad plan()' ) || - print STDERR "# $@"; diff --git a/lib/Test/Simple/t/bail_out.t b/lib/Test/Simple/t/bail_out.t deleted file mode 100644 index 5cdc1f9969..0000000000 --- a/lib/Test/Simple/t/bail_out.t +++ /dev/null @@ -1,43 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -my $Exit_Code; -BEGIN { - *CORE::GLOBAL::exit = sub { $Exit_Code = shift; }; -} - - -use Test::Builder; -use Test::More; - -my $output; -my $TB = Test::More->builder; -$TB->output(\$output); - -my $Test = Test::Builder->create; -$Test->level(0); - -$Test->plan(tests => 3); - -plan tests => 4; - -BAIL_OUT("ROCKS FALL! EVERYONE DIES!"); - - -$Test->is_eq( $output, <<'OUT' ); -1..4 -Bail out! ROCKS FALL! EVERYONE DIES! -OUT - -$Test->is_eq( $Exit_Code, 255 ); - -$Test->ok( $Test->can("BAILOUT"), "Backwards compat" ); diff --git a/lib/Test/Simple/t/buffer.t b/lib/Test/Simple/t/buffer.t deleted file mode 100644 index 6039e4a6f7..0000000000 --- a/lib/Test/Simple/t/buffer.t +++ /dev/null @@ -1,22 +0,0 @@ -#!/usr/bin/perl - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -# Ensure that intermixed prints to STDOUT and tests come out in the -# right order (ie. no buffering problems). - -use Test::More tests => 20; -my $T = Test::Builder->new; -$T->no_ending(1); - -for my $num (1..10) { - $tnum = $num * 2; - pass("I'm ok"); - $T->current_test($tnum); - print "ok $tnum - You're ok\n"; -} diff --git a/lib/Test/Simple/t/c_flag.t b/lib/Test/Simple/t/c_flag.t deleted file mode 100644 index a33963415e..0000000000 --- a/lib/Test/Simple/t/c_flag.t +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/perl -w - -# Test::More should not print anything when Perl is only doing -# a compile as with the -c flag or B::Deparse or perlcc. - -# HARNESS_ACTIVE=1 was causing an error with -c -{ - local $ENV{HARNESS_ACTIVE} = 1; - local $^C = 1; - - require Test::More; - Test::More->import(tests => 1); - - fail("This should not show up"); -} - -Test::More->builder->no_ending(1); - -print "1..1\n"; -print "ok 1\n"; - diff --git a/lib/Test/Simple/t/circular_data.t b/lib/Test/Simple/t/circular_data.t deleted file mode 100644 index 2fd819e1f4..0000000000 --- a/lib/Test/Simple/t/circular_data.t +++ /dev/null @@ -1,71 +0,0 @@ -#!/usr/bin/perl -w - -# Test is_deeply and friends with circular data structures [rt.cpan.org 7289] - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Test::More tests => 11; - -my $a1 = [ 1, 2, 3 ]; -push @$a1, $a1; -my $a2 = [ 1, 2, 3 ]; -push @$a2, $a2; - -is_deeply $a1, $a2; -ok( eq_array ($a1, $a2) ); -ok( eq_set ($a1, $a2) ); - -my $h1 = { 1=>1, 2=>2, 3=>3 }; -$h1->{4} = $h1; -my $h2 = { 1=>1, 2=>2, 3=>3 }; -$h2->{4} = $h2; - -is_deeply $h1, $h2; -ok( eq_hash ($h1, $h2) ); - -my ($r, $s); - -$r = \$r; -$s = \$s; - -ok( eq_array ([$s], [$r]) ); - - -{ - # Classic set of circular scalar refs. - my($a,$b,$c); - $a = \$b; - $b = \$c; - $c = \$a; - - my($d,$e,$f); - $d = \$e; - $e = \$f; - $f = \$d; - - is_deeply( $a, $a ); - is_deeply( $a, $d ); -} - - -{ - # rt.cpan.org 11623 - # Make sure the circular ref checks don't get confused by a reference - # which is simply repeating. - my $a = {}; - my $b = {}; - my $c = {}; - - is_deeply( [$a, $a], [$b, $c] ); - is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } ); - is_deeply( [\$a, \$a], [\$b, \$c] ); -} diff --git a/lib/Test/Simple/t/cmp_ok.t b/lib/Test/Simple/t/cmp_ok.t deleted file mode 100644 index de1a7e634d..0000000000 --- a/lib/Test/Simple/t/cmp_ok.t +++ /dev/null @@ -1,75 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib', '../lib/Test/Simple/t/lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; - -require Test::Simple::Catch; -my($out, $err) = Test::Simple::Catch::caught(); -local $ENV{HARNESS_ACTIVE} = 0; - -require Test::Builder; -my $TB = Test::Builder->create; -$TB->level(0); - -sub try_cmp_ok { - my($left, $cmp, $right) = @_; - - my %expect; - $expect{ok} = eval "\$left $cmp \$right"; - $expect{error} = $@; - $expect{error} =~ s/ at .*\n?//; - - local $Test::Builder::Level = $Test::Builder::Level + 1; - my $ok = cmp_ok($left, $cmp, $right, "cmp_ok"); - $TB->is_num(!!$ok, !!$expect{ok}, " right return"); - - my $diag = $err->read; - if( !$ok and $expect{error} ) { - $diag =~ s/^# //mg; - $TB->like( $diag, qr/\Q$expect{error}\E/, " expected error" ); - } - elsif( $ok ) { - $TB->is_eq( $diag, '', " passed without diagnostic" ); - } - else { - $TB->ok(1, " failed without diagnostic"); - } -} - - -use Test::More; -Test::More->builder->no_ending(1); - -require MyOverload; -my $cmp = Overloaded::Compare->new("foo", 42); -my $ify = Overloaded::Ify->new("bar", 23); - -my @Tests = ( - [1, '==', 1], - [1, '==', 2], - ["a", "eq", "b"], - ["a", "eq", "a"], - [1, "+", 1], - [1, "-", 1], - - [$cmp, '==', 42], - [$cmp, 'eq', "foo"], - [$ify, 'eq', "bar"], - [$ify, "==", 23], -); - -plan tests => scalar @Tests; -$TB->plan(tests => @Tests * 2); - -for my $test (@Tests) { - try_cmp_ok(@$test); -} diff --git a/lib/Test/Simple/t/diag.t b/lib/Test/Simple/t/diag.t deleted file mode 100644 index f5cb437d54..0000000000 --- a/lib/Test/Simple/t/diag.t +++ /dev/null @@ -1,81 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - - -# Turn on threads here, if available, since this test tends to find -# lots of threading bugs. -use Config; -BEGIN { - if( $] >= 5.008001 && $Config{useithreads} ) { - require threads; - 'threads'->import; - } -} - - -use strict; - -use Test::Builder::NoOutput; -use Test::More tests => 7; - -my $test = Test::Builder::NoOutput->create; - -# Test diag() goes to todo_output() in a todo test. -{ - $test->todo_start(); - - $test->diag("a single line"); - is( $test->read('todo'), <<'DIAG', 'diag() with todo_output set' ); -# a single line -DIAG - - my $ret = $test->diag("multiple\n", "lines"); - is( $test->read('todo'), <<'DIAG', ' multi line' ); -# multiple -# lines -DIAG - ok( !$ret, 'diag returns false' ); - - $test->todo_end(); -} - - -# Test diagnostic formatting -{ - $test->diag("# foo"); - is( $test->read('err'), "# # foo\n", "diag() adds # even if there's one already" ); - - $test->diag("foo\n\nbar"); - is( $test->read('err'), <<'DIAG', " blank lines get escaped" ); -# foo -# -# bar -DIAG - - $test->diag("foo\n\nbar\n\n"); - is( $test->read('err'), <<'DIAG', " even at the end" ); -# foo -# -# bar -# -DIAG -} - - -# [rt.cpan.org 8392] diag(@list) emulates print -{ - $test->diag(qw(one two)); - - is( $test->read('err'), <<'DIAG' ); -# onetwo -DIAG -} diff --git a/lib/Test/Simple/t/died.t b/lib/Test/Simple/t/died.t deleted file mode 100644 index b4ee2fbbff..0000000000 --- a/lib/Test/Simple/t/died.t +++ /dev/null @@ -1,45 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 3); - - -package main; - -require Test::Simple; - -chdir 't'; -push @INC, '../t/lib/'; -require Test::Simple::Catch; -my($out, $err) = Test::Simple::Catch::caught(); -local $ENV{HARNESS_ACTIVE} = 0; - -Test::Simple->import(tests => 1); -exit 250; - -END { - $TB->is_eq($out->read, <<OUT); -1..1 -OUT - - $TB->is_eq($err->read, <<ERR); -# Looks like your test exited with 250 before it could output anything. -ERR - - $TB->is_eq($?, 250, "exit code"); - - exit grep { !$_ } $TB->summary; -} diff --git a/lib/Test/Simple/t/dont_overwrite_die_handler.t b/lib/Test/Simple/t/dont_overwrite_die_handler.t deleted file mode 100644 index 0657a06ca3..0000000000 --- a/lib/Test/Simple/t/dont_overwrite_die_handler.t +++ /dev/null @@ -1,19 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -# Make sure this is in place before Test::More is loaded. -my $handler_called; -BEGIN { - $SIG{__DIE__} = sub { $handler_called++ }; -} - -use Test::More tests => 2; - -ok !eval { die }; -is $handler_called, 1, 'existing DIE handler not overridden'; diff --git a/lib/Test/Simple/t/eq_set.t b/lib/Test/Simple/t/eq_set.t deleted file mode 100644 index fbdc52db1f..0000000000 --- a/lib/Test/Simple/t/eq_set.t +++ /dev/null @@ -1,34 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} -chdir 't'; - -use strict; -use Test::More; - -plan tests => 4; - -# RT 3747 -ok( eq_set([1, 2, [3]], [[3], 1, 2]) ); -ok( eq_set([1,2,[3]], [1,[3],2]) ); - -# bugs.perl.org 36354 -my $ref = \2; -ok( eq_set( [$ref, "$ref", "$ref", $ref], - ["$ref", $ref, $ref, "$ref"] - ) ); - -TODO: { - local $TODO = q[eq_set() doesn't really handle references]; - - ok( eq_set( [\1, \2, \3], [\2, \3, \1] ) ); -} - diff --git a/lib/Test/Simple/t/exit.t b/lib/Test/Simple/t/exit.t deleted file mode 100644 index 95661eef07..0000000000 --- a/lib/Test/Simple/t/exit.t +++ /dev/null @@ -1,114 +0,0 @@ -#!/usr/bin/perl -w - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -require Test::Builder; -my $TB = Test::Builder->create(); -$TB->level(0); - - -package main; - -use Cwd; -use File::Spec; - -my $Orig_Dir = cwd; - -my $Perl = File::Spec->rel2abs($^X); -if( $^O eq 'VMS' ) { - # VMS can't use its own $^X in a system call until almost 5.8 - $Perl = "MCR $^X" if $] < 5.007003; - - # Quiet noisy 'SYS$ABORT' - $Perl .= q{ -"I../lib"} if $ENV{PERL_CORE}; - $Perl .= q{ -"Mvmsish=hushed"}; -} - - -eval { require POSIX; &POSIX::WEXITSTATUS(0) }; -if( $@ ) { - *exitstatus = sub { $_[0] >> 8 }; -} -else { - *exitstatus = sub { POSIX::WEXITSTATUS($_[0]) } -} - - -# Some OS' will alter the exit code to their own native sense... -# sometimes. Rather than deal with the exception we'll just -# build up the mapping. -print "# Building up a map of exit codes. May take a while.\n"; -my %Exit_Map; - -open my $fh, ">", "exit_map_test" or die $!; -print $fh <<'DONE'; -if ($^O eq 'VMS') { - require vmsish; - import vmsish qw(hushed); -} -my $exit = shift; -print "exit $exit\n"; -END { $? = $exit }; -DONE - -close $fh; -END { 1 while unlink "exit_map_test" } - -for my $exit (0..255) { - # This correctly emulates Test::Builder's behavior. - my $out = qx[$Perl exit_map_test $exit]; - $TB->like( $out, qr/^exit $exit\n/, "exit map test for $exit" ); - $Exit_Map{$exit} = exitstatus($?); -} -print "# Done.\n"; - - -my %Tests = ( - # File Exit Code - 'success.plx' => 0, - 'one_fail.plx' => 1, - 'two_fail.plx' => 2, - 'five_fail.plx' => 5, - 'extras.plx' => 2, - 'too_few.plx' => 255, - 'too_few_fail.plx' => 2, - 'death.plx' => 255, - 'last_minute_death.plx' => 255, - 'pre_plan_death.plx' => 'not zero', - 'death_in_eval.plx' => 0, - 'require.plx' => 0, - 'death_with_handler.plx' => 255, - 'exit.plx' => 1, - ); - -chdir 't'; -my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests)); -while( my($test_name, $exit_code) = each %Tests ) { - my $file = File::Spec->catfile($lib, $test_name); - my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file}); - my $actual_exit = exitstatus($wait_stat); - - if( $exit_code eq 'not zero' ) { - $TB->isnt_num( $actual_exit, $Exit_Map{0}, - "$test_name exited with $actual_exit ". - "(expected non-zero)"); - } - else { - $TB->is_num( $actual_exit, $Exit_Map{$exit_code}, - "$test_name exited with $actual_exit ". - "(expected $Exit_Map{$exit_code})"); - } -} - -$TB->done_testing( scalar keys(%Tests) + 256 ); - -# So any END block file cleanup works. -chdir $Orig_Dir; diff --git a/lib/Test/Simple/t/explain.t b/lib/Test/Simple/t/explain.t deleted file mode 100644 index cf2f550e95..0000000000 --- a/lib/Test/Simple/t/explain.t +++ /dev/null @@ -1,27 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use warnings; - -use Test::More tests => 5; - -can_ok "main", "explain"; - -is_deeply [explain("foo")], ["foo"]; -is_deeply [explain("foo", "bar")], ["foo", "bar"]; - -# Avoid future dump formatting changes from breaking tests by just eval'ing -# the dump -is_deeply [map { eval $_ } explain([], {})], [[], {}]; - -is_deeply [map { eval $_ } explain(23, [42,91], 99)], [23, [42, 91], 99]; diff --git a/lib/Test/Simple/t/extra.t b/lib/Test/Simple/t/extra.t deleted file mode 100644 index 57235be195..0000000000 --- a/lib/Test/Simple/t/extra.t +++ /dev/null @@ -1,59 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 2); - - -package main; - -require Test::Simple; - -chdir 't'; -push @INC, '../t/lib/'; -require Test::Simple::Catch; -my($out, $err) = Test::Simple::Catch::caught(); -local $ENV{HARNESS_ACTIVE} = 0; - -Test::Simple->import(tests => 3); - -#line 30 -ok(1, 'Foo'); -ok(0, 'Bar'); -ok(1, 'Yar'); -ok(1, 'Car'); -ok(0, 'Sar'); - -END { - $TB->is_eq($$out, <<OUT); -1..3 -ok 1 - Foo -not ok 2 - Bar -ok 3 - Yar -ok 4 - Car -not ok 5 - Sar -OUT - - $TB->is_eq($$err, <<ERR); -# Failed test 'Bar' -# at $0 line 31. -# Failed test 'Sar' -# at $0 line 34. -# Looks like you planned 3 tests but ran 5. -# Looks like you failed 2 tests of 5 run. -ERR - - exit 0; -} diff --git a/lib/Test/Simple/t/extra_one.t b/lib/Test/Simple/t/extra_one.t deleted file mode 100644 index d77404e15d..0000000000 --- a/lib/Test/Simple/t/extra_one.t +++ /dev/null @@ -1,52 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; - -require Test::Simple::Catch; -my($out, $err) = Test::Simple::Catch::caught(); - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 2); - -sub is { $TB->is_eq(@_) } - - -package main; - -require Test::Simple; -Test::Simple->import(tests => 1); -ok(1); -ok(1); -ok(1); - -END { - My::Test::is($$out, <<OUT); -1..1 -ok 1 -ok 2 -ok 3 -OUT - - My::Test::is($$err, <<ERR); -# Looks like you planned 1 test but ran 3. -ERR - - # Prevent Test::Simple from existing with non-zero - exit 0; -} diff --git a/lib/Test/Simple/t/fail-like.t b/lib/Test/Simple/t/fail-like.t deleted file mode 100644 index 0ea5fab3da..0000000000 --- a/lib/Test/Simple/t/fail-like.t +++ /dev/null @@ -1,74 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -# There was a bug with like() involving a qr// not failing properly. -# This tests against that. - -use strict; - - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 4); - - -require Test::Simple::Catch; -my($out, $err) = Test::Simple::Catch::caught(); -local $ENV{HARNESS_ACTIVE} = 0; - - -package main; - -require Test::More; -Test::More->import(tests => 1); - -{ - eval q{ like( "foo", qr/that/, 'is foo like that' ); }; - - $TB->is_eq($out->read, <<OUT, 'failing output'); -1..1 -not ok 1 - is foo like that -OUT - - my $err_re = <<ERR; -# Failed test 'is foo like that' -# at .* line 1\. -# 'foo' -# doesn't match '\\(\\?-xism:that\\)' -ERR - - $TB->like($err->read, qr/^$err_re$/, 'failing errors'); -} - -{ - # line 59 - like("foo", "not a regex"); - $TB->is_eq($out->read, <<OUT); -not ok 2 -OUT - - $TB->is_eq($err->read, <<OUT); -# Failed test at $0 line 59. -# 'not a regex' doesn't look much like a regex to me. -OUT - -} - -END { - # Test::More thinks it failed. Override that. - exit(scalar grep { !$_ } $TB->summary); -} diff --git a/lib/Test/Simple/t/fail-more.t b/lib/Test/Simple/t/fail-more.t deleted file mode 100644 index 423e216488..0000000000 --- a/lib/Test/Simple/t/fail-more.t +++ /dev/null @@ -1,511 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; - -require Test::Simple::Catch; -my($out, $err) = Test::Simple::Catch::caught(); -local $ENV{HARNESS_ACTIVE} = 0; - - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 78); - -sub like ($$;$) { - $TB->like(@_); -} - -sub is ($$;$) { - $TB->is_eq(@_); -} - -sub main::out_ok ($$) { - $TB->is_eq( $out->read, shift ); - $TB->is_eq( $err->read, shift ); -} - -sub main::out_like ($$) { - my($output, $failure) = @_; - - $TB->like( $out->read, qr/$output/ ); - $TB->like( $err->read, qr/$failure/ ); -} - - -package main; - -require Test::More; -our $TODO; -my $Total = 37; -Test::More->import(tests => $Total); -$out->read; # clear the plan from $out - -# This should all work in the presence of a __DIE__ handler. -local $SIG{__DIE__} = sub { $TB->ok(0, "DIE handler called: ".join "", @_); }; - - -my $tb = Test::More->builder; -$tb->use_numbers(0); - -my $Filename = quotemeta $0; - - -#line 38 -ok( 0, 'failing' ); -out_ok( <<OUT, <<ERR ); -not ok - failing -OUT -# Failed test 'failing' -# at $0 line 38. -ERR - - -#line 40 -is( "foo", "bar", 'foo is bar?'); -out_ok( <<OUT, <<ERR ); -not ok - foo is bar? -OUT -# Failed test 'foo is bar?' -# at $0 line 40. -# got: 'foo' -# expected: 'bar' -ERR - -#line 89 -is( undef, '', 'undef is empty string?'); -out_ok( <<OUT, <<ERR ); -not ok - undef is empty string? -OUT -# Failed test 'undef is empty string?' -# at $0 line 89. -# got: undef -# expected: '' -ERR - -#line 99 -is( undef, 0, 'undef is 0?'); -out_ok( <<OUT, <<ERR ); -not ok - undef is 0? -OUT -# Failed test 'undef is 0?' -# at $0 line 99. -# got: undef -# expected: '0' -ERR - -#line 110 -is( '', 0, 'empty string is 0?' ); -out_ok( <<OUT, <<ERR ); -not ok - empty string is 0? -OUT -# Failed test 'empty string is 0?' -# at $0 line 110. -# got: '' -# expected: '0' -ERR - -#line 121 -isnt("foo", "foo", 'foo isnt foo?' ); -out_ok( <<OUT, <<ERR ); -not ok - foo isnt foo? -OUT -# Failed test 'foo isnt foo?' -# at $0 line 121. -# got: 'foo' -# expected: anything else -ERR - -#line 132 -isn't("foo", "foo",'foo isn\'t foo?' ); -out_ok( <<OUT, <<ERR ); -not ok - foo isn't foo? -OUT -# Failed test 'foo isn\'t foo?' -# at $0 line 132. -# got: 'foo' -# expected: anything else -ERR - -#line 143 -isnt(undef, undef, 'undef isnt undef?'); -out_ok( <<OUT, <<ERR ); -not ok - undef isnt undef? -OUT -# Failed test 'undef isnt undef?' -# at $0 line 143. -# got: undef -# expected: anything else -ERR - -#line 154 -like( "foo", '/that/', 'is foo like that' ); -out_ok( <<OUT, <<ERR ); -not ok - is foo like that -OUT -# Failed test 'is foo like that' -# at $0 line 154. -# 'foo' -# doesn't match '/that/' -ERR - -#line 165 -unlike( "foo", '/foo/', 'is foo unlike foo' ); -out_ok( <<OUT, <<ERR ); -not ok - is foo unlike foo -OUT -# Failed test 'is foo unlike foo' -# at $0 line 165. -# 'foo' -# matches '/foo/' -ERR - -# Nick Clark found this was a bug. Fixed in 0.40. -# line 177 -like( "bug", '/(%)/', 'regex with % in it' ); -out_ok( <<OUT, <<ERR ); -not ok - regex with % in it -OUT -# Failed test 'regex with % in it' -# at $0 line 177. -# 'bug' -# doesn't match '/(%)/' -ERR - -#line 188 -fail('fail()'); -out_ok( <<OUT, <<ERR ); -not ok - fail() -OUT -# Failed test 'fail()' -# at $0 line 188. -ERR - -#line 197 -can_ok('Mooble::Hooble::Yooble', qw(this that)); -out_ok( <<OUT, <<ERR ); -not ok - Mooble::Hooble::Yooble->can(...) -OUT -# Failed test 'Mooble::Hooble::Yooble->can(...)' -# at $0 line 197. -# Mooble::Hooble::Yooble->can('this') failed -# Mooble::Hooble::Yooble->can('that') failed -ERR - -#line 208 -can_ok('Mooble::Hooble::Yooble', ()); -out_ok( <<OUT, <<ERR ); -not ok - Mooble::Hooble::Yooble->can(...) -OUT -# Failed test 'Mooble::Hooble::Yooble->can(...)' -# at $0 line 208. -# can_ok() called with no methods -ERR - -#line 218 -can_ok(undef, undef); -out_ok( <<OUT, <<ERR ); -not ok - ->can(...) -OUT -# Failed test '->can(...)' -# at $0 line 218. -# can_ok() called with empty class or reference -ERR - -#line 228 -can_ok([], "foo"); -out_ok( <<OUT, <<ERR ); -not ok - ARRAY->can('foo') -OUT -# Failed test 'ARRAY->can('foo')' -# at $0 line 228. -# ARRAY->can('foo') failed -ERR - -#line 238 -isa_ok(bless([], "Foo"), "Wibble"); -out_ok( <<OUT, <<ERR ); -not ok - The object isa Wibble -OUT -# Failed test 'The object isa Wibble' -# at $0 line 238. -# The object isn't a 'Wibble' it's a 'Foo' -ERR - -#line 248 -isa_ok(42, "Wibble", "My Wibble"); -out_ok( <<OUT, <<ERR ); -not ok - My Wibble isa Wibble -OUT -# Failed test 'My Wibble isa Wibble' -# at $0 line 248. -# My Wibble isn't a class or reference -ERR - -#line 258 -isa_ok(undef, "Wibble", "Another Wibble"); -out_ok( <<OUT, <<ERR ); -not ok - Another Wibble isa Wibble -OUT -# Failed test 'Another Wibble isa Wibble' -# at $0 line 258. -# Another Wibble isn't defined -ERR - -#line 268 -isa_ok([], "HASH"); -out_ok( <<OUT, <<ERR ); -not ok - The reference isa HASH -OUT -# Failed test 'The reference isa HASH' -# at $0 line 268. -# The reference isn't a 'HASH' it's a 'ARRAY' -ERR - -#line 278 -new_ok(undef); -out_like( <<OUT, <<ERR ); -not ok - new\\(\\) died -OUT -# Failed test 'new\\(\\) died' -# at $Filename line 278. -# Error was: Can't call method "new" on an undefined value at .* -ERR - -#line 288 -new_ok( "Does::Not::Exist" ); -out_like( <<OUT, <<ERR ); -not ok - new\\(\\) died -OUT -# Failed test 'new\\(\\) died' -# at $Filename line 288. -# Error was: Can't locate object method "new" via package "Does::Not::Exist" .* -ERR - - -{ package Foo; sub new { } } -{ package Bar; sub new { {} } } -{ package Baz; sub new { bless {}, "Wibble" } } - -#line 303 -new_ok( "Foo" ); -out_ok( <<OUT, <<ERR ); -not ok - The object isa Foo -OUT -# Failed test 'The object isa Foo' -# at $0 line 303. -# The object isn't defined -ERR - -# line 313 -new_ok( "Bar" ); -out_ok( <<OUT, <<ERR ); -not ok - The object isa Bar -OUT -# Failed test 'The object isa Bar' -# at $0 line 313. -# The object isn't a 'Bar' it's a 'HASH' -ERR - -#line 323 -new_ok( "Baz" ); -out_ok( <<OUT, <<ERR ); -not ok - The object isa Baz -OUT -# Failed test 'The object isa Baz' -# at $0 line 323. -# The object isn't a 'Baz' it's a 'Wibble' -ERR - -#line 333 -new_ok( "Baz", [], "no args" ); -out_ok( <<OUT, <<ERR ); -not ok - no args isa Baz -OUT -# Failed test 'no args isa Baz' -# at $0 line 333. -# no args isn't a 'Baz' it's a 'Wibble' -ERR - -#line 343 -cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' ); -out_ok( <<OUT, <<ERR ); -not ok - cmp_ok eq -OUT -# Failed test 'cmp_ok eq' -# at $0 line 343. -# got: 'foo' -# expected: 'bar' -ERR - -#line 354 -cmp_ok( 42.1, '==', 23, , ' ==' ); -out_ok( <<OUT, <<ERR ); -not ok - == -OUT -# Failed test ' ==' -# at $0 line 354. -# got: 42.1 -# expected: 23 -ERR - -#line 365 -cmp_ok( 42, '!=', 42 , ' !=' ); -out_ok( <<OUT, <<ERR ); -not ok - != -OUT -# Failed test ' !=' -# at $0 line 365. -# got: 42 -# expected: anything else -ERR - -#line 376 -cmp_ok( 1, '&&', 0 , ' &&' ); -out_ok( <<OUT, <<ERR ); -not ok - && -OUT -# Failed test ' &&' -# at $0 line 376. -# '1' -# && -# '0' -ERR - -# line 388 -cmp_ok( 42, 'eq', "foo", ' eq with numbers' ); -out_ok( <<OUT, <<ERR ); -not ok - eq with numbers -OUT -# Failed test ' eq with numbers' -# at $0 line 388. -# got: '42' -# expected: 'foo' -ERR - -{ - my $warnings = ''; - local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; - -# line 404 - cmp_ok( 42, '==', "foo", ' == with strings' ); - out_ok( <<OUT, <<ERR ); -not ok - == with strings -OUT -# Failed test ' == with strings' -# at $0 line 404. -# got: 42 -# expected: foo -ERR - My::Test::like( - $warnings, - qr/^Argument "foo" isn't numeric in .* at cmp_ok \[from $Filename line 404\] line 1\.\n$/ - ); - $warnings = ''; -} - - -{ - my $warnings = ''; - local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; - -#line 426 - cmp_ok( undef, "ne", "", "undef ne empty string" ); - - $TB->is_eq( $out->read, <<OUT ); -not ok - undef ne empty string -OUT - - TODO: { - local $::TODO = 'cmp_ok() gives the wrong "expected" for undef'; - - $TB->is_eq( $err->read, <<ERR ); -# Failed test 'undef ne empty string' -# at $0 line 426. -# got: undef -# expected: '' -ERR - } - - My::Test::like( - $warnings, - qr/^Use of uninitialized value.* in string ne at cmp_ok \[from $Filename line 426\] line 1\.\n\z/ - ); -} - - -# generate a $!, it changes its value by context. --e "wibblehibble"; -my $Errno_Number = $!+0; -my $Errno_String = $!.''; -#line 425 -cmp_ok( $!, 'eq', '', ' eq with stringified errno' ); -out_ok( <<OUT, <<ERR ); -not ok - eq with stringified errno -OUT -# Failed test ' eq with stringified errno' -# at $0 line 425. -# got: '$Errno_String' -# expected: '' -ERR - -#line 436 -cmp_ok( $!, '==', -1, ' eq with numerified errno' ); -out_ok( <<OUT, <<ERR ); -not ok - eq with numerified errno -OUT -# Failed test ' eq with numerified errno' -# at $0 line 436. -# got: $Errno_Number -# expected: -1 -ERR - -#line 447 -use_ok('Hooble::mooble::yooble'); -my $more_err_re = <<ERR; -# Failed test 'use Hooble::mooble::yooble;' -# at $Filename line 447\\. -# Tried to use 'Hooble::mooble::yooble'. -# Error: Can't locate Hooble.* in \\\@INC .* -ERR -out_like( - qr/^\Qnot ok - use Hooble::mooble::yooble;\E\n\z/, - qr/^$more_err_re/ -); - -#line 460 -require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'); -$more_err_re = <<ERR; -# Failed test 'require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;' -# at $Filename line 460\\. -# Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'. -# Error: Can't locate ALL.* in \\\@INC .* -ERR -out_like( - qr/^\Qnot ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;\E\n\z/, - qr/^$more_err_re/ -); - - -END { - out_like( <<OUT, <<ERR ); -OUT -# Looks like you failed $Total tests of $Total. -ERR - - exit(0); -} diff --git a/lib/Test/Simple/t/fail.t b/lib/Test/Simple/t/fail.t deleted file mode 100644 index ccf0c74893..0000000000 --- a/lib/Test/Simple/t/fail.t +++ /dev/null @@ -1,56 +0,0 @@ -#!perl -w - -# Simple test of what failure output looks like - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; - -# Normalize the output whether we're running under Test::Harness or not. -local $ENV{HARNESS_ACTIVE} = 0; - -use Test::Builder; -use Test::Builder::NoOutput; - -my $Test = Test::Builder->new; - -# Set up a builder to record some failing tests. -{ - my $tb = Test::Builder::NoOutput->create; - $tb->plan( tests => 5 ); - -#line 28 - $tb->ok( 1, 'passing' ); - $tb->ok( 2, 'passing still' ); - $tb->ok( 3, 'still passing' ); - $tb->ok( 0, 'oh no!' ); - $tb->ok( 0, 'damnit' ); - $tb->_ending; - - $Test->is_eq($tb->read('out'), <<OUT); -1..5 -ok 1 - passing -ok 2 - passing still -ok 3 - still passing -not ok 4 - oh no! -not ok 5 - damnit -OUT - - $Test->is_eq($tb->read('err'), <<ERR); -# Failed test 'oh no!' -# at $0 line 31. -# Failed test 'damnit' -# at $0 line 32. -# Looks like you failed 2 tests of 5. -ERR - - $Test->done_testing(2); -} diff --git a/lib/Test/Simple/t/fail_one.t b/lib/Test/Simple/t/fail_one.t deleted file mode 100644 index 61d7c081ff..0000000000 --- a/lib/Test/Simple/t/fail_one.t +++ /dev/null @@ -1,43 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; - -# Normalize the output whether we're running under Test::Harness or not. -local $ENV{HARNESS_ACTIVE} = 0; - -use Test::Builder; -use Test::Builder::NoOutput; - -my $Test = Test::Builder->new; - -{ - my $tb = Test::Builder::NoOutput->create; - - $tb->plan( tests => 1 ); - -#line 28 - $tb->ok(0); - $tb->_ending; - - $Test->is_eq($tb->read('out'), <<OUT); -1..1 -not ok 1 -OUT - - $Test->is_eq($tb->read('err'), <<ERR); -# Failed test at $0 line 28. -# Looks like you failed 1 test of 1. -ERR - - $Test->done_testing(2); -} diff --git a/lib/Test/Simple/t/filehandles.t b/lib/Test/Simple/t/filehandles.t deleted file mode 100644 index f7dad5d7ea..0000000000 --- a/lib/Test/Simple/t/filehandles.t +++ /dev/null @@ -1,18 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } -} - -use lib 't/lib'; -use Test::More tests => 1; -use Dev::Null; - -tie *STDOUT, "Dev::Null" or die $!; - -print "not ok 1\n"; # this should not print. -pass 'STDOUT can be mucked with'; - diff --git a/lib/Test/Simple/t/fork.t b/lib/Test/Simple/t/fork.t deleted file mode 100644 index 55d7aec1f9..0000000000 --- a/lib/Test/Simple/t/fork.t +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::More; -use Config; - -my $Can_Fork = $Config{d_fork} || - (($^O eq 'MSWin32' || $^O eq 'NetWare') and - $Config{useithreads} and - $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/ - ); - -if( !$Can_Fork ) { - plan skip_all => "This system cannot fork"; -} -else { - plan tests => 1; -} - -if( fork ) { # parent - pass("Only the parent should process the ending, not the child"); -} -else { - exit; # child -} - diff --git a/lib/Test/Simple/t/harness_active.t b/lib/Test/Simple/t/harness_active.t deleted file mode 100644 index 7b027a7b40..0000000000 --- a/lib/Test/Simple/t/harness_active.t +++ /dev/null @@ -1,88 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; - -use Test::Simple::Catch; -my($out, $err) = Test::Simple::Catch::caught(); - - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 4); - -# Utility testing functions. -sub ok ($;$) { - return $TB->ok(@_); -} - - -sub main::err_ok ($) { - my($expect) = @_; - my $got = $err->read; - - return $TB->is_eq( $got, $expect ); -} - - -package main; - -require Test::More; -Test::More->import(tests => 4); -Test::More->builder->no_ending(1); - -{ - local $ENV{HARNESS_ACTIVE} = 0; - -#line 62 - fail( "this fails" ); - err_ok( <<ERR ); -# Failed test 'this fails' -# at $0 line 62. -ERR - -#line 72 - is( 1, 0 ); - err_ok( <<ERR ); -# Failed test at $0 line 72. -# got: '1' -# expected: '0' -ERR -} - -{ - local $ENV{HARNESS_ACTIVE} = 1; - -#line 71 - fail( "this fails" ); - err_ok( <<ERR ); - -# Failed test 'this fails' -# at $0 line 71. -ERR - - -#line 84 - is( 1, 0 ); - err_ok( <<ERR ); - -# Failed test at $0 line 84. -# got: '1' -# expected: '0' -ERR - -} diff --git a/lib/Test/Simple/t/import.t b/lib/Test/Simple/t/import.t deleted file mode 100644 index 68a36138bc..0000000000 --- a/lib/Test/Simple/t/import.t +++ /dev/null @@ -1,12 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - - -use Test::More tests => 2, import => [qw(!fail)]; - -can_ok(__PACKAGE__, qw(ok pass like isa_ok)); -ok( !__PACKAGE__->can('fail'), 'fail() not exported' ); diff --git a/lib/Test/Simple/t/is_deeply_dne_bug.t b/lib/Test/Simple/t/is_deeply_dne_bug.t deleted file mode 100644 index f4578a6460..0000000000 --- a/lib/Test/Simple/t/is_deeply_dne_bug.t +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/perl -w - -# test for rt.cpan.org 20768 -# -# There was a bug where the internal "does not exist" object could get -# confused with an overloaded object. - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Test::More tests => 2; - -{ - package Foo; - - use overload - 'eq' => \&overload_equiv, - '==' => \&overload_equiv; - - sub new { - return bless {}, shift; - } - - sub overload_equiv { - if (ref($_[0]) ne 'Foo' || ref($_[1]) ne 'Foo') { - print ref($_[0]), " ", ref($_[1]), "\n"; - die "Invalid object passed to overload_equiv\n"; - } - - return 1; # change to 0 ... makes little difference - } -} - -my $obj1 = Foo->new(); -my $obj2 = Foo->new(); - -eval { is_deeply([$obj1, $obj2], [$obj1, $obj2]); }; -is $@, ''; - diff --git a/lib/Test/Simple/t/is_deeply_fail.t b/lib/Test/Simple/t/is_deeply_fail.t deleted file mode 100644 index bd9b634233..0000000000 --- a/lib/Test/Simple/t/is_deeply_fail.t +++ /dev/null @@ -1,371 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; - -use Test::Builder; -require Test::Simple::Catch; -my($out, $err) = Test::Simple::Catch::caught(); -Test::Builder->new->no_header(1); -Test::Builder->new->no_ending(1); -local $ENV{HARNESS_ACTIVE} = 0; - - -# Can't use Test.pm, that's a 5.005 thing. -package main; - - -my $TB = Test::Builder->create; -$TB->plan(tests => 73); - -# Utility testing functions. -sub ok ($;$) { - return $TB->ok(@_); -} - -sub is ($$;$) { - my($this, $that, $name) = @_; - - my $ok = $TB->is_eq($$this, $that, $name); - - $$this = ''; - - return $ok; -} - -sub like ($$;$) { - my($this, $regex, $name) = @_; - $regex = "/$regex/" if !ref $regex and $regex !~ m{^/.*/$}s; - - my $ok = $TB->like($$this, $regex, $name); - - $$this = ''; - - return $ok; -} - - -require Test::More; -Test::More->import(tests => 11, import => ['is_deeply']); - -my $Filename = quotemeta $0; - -#line 68 -ok !is_deeply('foo', 'bar', 'plain strings'); -is( $out, "not ok 1 - plain strings\n", 'plain strings' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'plain strings' -# at $0 line 68. -# got: 'foo' -# expected: 'bar' -ERR - - -#line 78 -ok !is_deeply({}, [], 'different types'); -is( $out, "not ok 2 - different types\n", 'different types' ); -like( $err, <<ERR, ' right diagnostic' ); -# Failed test 'different types' -# at $Filename line 78. -# Structures begin differing at: -# \\\$got = HASH\\(0x[0-9a-f]+\\) -# \\\$expected = ARRAY\\(0x[0-9a-f]+\\) -ERR - -#line 88 -ok !is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values'); -is( $out, "not ok 3 - hashes with different values\n", - 'hashes with different values' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'hashes with different values' -# at $0 line 88. -# Structures begin differing at: -# \$got->{this} = '42' -# \$expected->{this} = '43' -ERR - -#line 99 -ok !is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys'); -is( $out, "not ok 4 - hashes with different keys\n", - 'hashes with different keys' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'hashes with different keys' -# at $0 line 99. -# Structures begin differing at: -# \$got->{this} = Does not exist -# \$expected->{this} = '42' -ERR - -#line 110 -ok !is_deeply([1..9], [1..10], 'arrays of different length'); -is( $out, "not ok 5 - arrays of different length\n", - 'arrays of different length' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'arrays of different length' -# at $0 line 110. -# Structures begin differing at: -# \$got->[9] = Does not exist -# \$expected->[9] = '10' -ERR - -#line 121 -ok !is_deeply([undef, undef], [undef], 'arrays of undefs' ); -is( $out, "not ok 6 - arrays of undefs\n", 'arrays of undefs' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'arrays of undefs' -# at $0 line 121. -# Structures begin differing at: -# \$got->[1] = undef -# \$expected->[1] = Does not exist -ERR - -#line 131 -ok !is_deeply({ foo => undef }, {}, 'hashes of undefs' ); -is( $out, "not ok 7 - hashes of undefs\n", 'hashes of undefs' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'hashes of undefs' -# at $0 line 131. -# Structures begin differing at: -# \$got->{foo} = undef -# \$expected->{foo} = Does not exist -ERR - -#line 141 -ok !is_deeply(\42, \23, 'scalar refs'); -is( $out, "not ok 8 - scalar refs\n", 'scalar refs' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'scalar refs' -# at $0 line 141. -# Structures begin differing at: -# \${ \$got} = '42' -# \${\$expected} = '23' -ERR - -#line 151 -ok !is_deeply([], \23, 'mixed scalar and array refs'); -is( $out, "not ok 9 - mixed scalar and array refs\n", - 'mixed scalar and array refs' ); -like( $err, <<ERR, ' right diagnostic' ); -# Failed test 'mixed scalar and array refs' -# at $Filename line 151. -# Structures begin differing at: -# \\\$got = ARRAY\\(0x[0-9a-f]+\\) -# \\\$expected = SCALAR\\(0x[0-9a-f]+\\) -ERR - - -my($a1, $a2, $a3); -$a1 = \$a2; $a2 = \$a3; -$a3 = 42; - -my($b1, $b2, $b3); -$b1 = \$b2; $b2 = \$b3; -$b3 = 23; - -#line 173 -ok !is_deeply($a1, $b1, 'deep scalar refs'); -is( $out, "not ok 10 - deep scalar refs\n", 'deep scalar refs' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'deep scalar refs' -# at $0 line 173. -# Structures begin differing at: -# \${\${ \$got}} = '42' -# \${\${\$expected}} = '23' -ERR - -# I don't know how to properly display this structure. -# $a2 = { foo => \$a3 }; -# $b2 = { foo => \$b3 }; -# is_deeply([$a1], [$b1], 'deep mixed scalar refs'); - -my $foo = { - this => [1..10], - that => { up => "down", left => "right" }, - }; - -my $bar = { - this => [1..10], - that => { up => "down", left => "right", foo => 42 }, - }; - -#line 198 -ok !is_deeply( $foo, $bar, 'deep structures' ); -ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' ); -is( $out, "not ok 11 - deep structures\n", 'deep structures' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test 'deep structures' -# at $0 line 198. -# Structures begin differing at: -# \$got->{that}{foo} = Does not exist -# \$expected->{that}{foo} = '42' -ERR - - -#line 221 -my @tests = ([], - [qw(42)], - [qw(42 23), qw(42 23)] - ); - -foreach my $test (@tests) { - my $num_args = @$test; - - my $warning; - local $SIG{__WARN__} = sub { $warning .= join '', @_; }; - ok !is_deeply(@$test); - - like \$warning, - "/^is_deeply\\(\\) takes two or three args, you gave $num_args\.\n/"; -} - - -#line 240 -# [rt.cpan.org 6837] -ok !is_deeply([{Foo => undef}],[{Foo => ""}]), 'undef != ""'; -ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' ); - - -#line 258 -# [rt.cpan.org 7031] -my $a = []; -ok !is_deeply($a, $a.''), "don't compare refs like strings"; -ok !is_deeply([$a], [$a.'']), " even deep inside"; - - -#line 265 -# [rt.cpan.org 7030] -ok !is_deeply( {}, {key => []} ), '[] could match non-existent values'; -ok !is_deeply( [], [[]] ); - - -#line 273 -$$err = $$out = ''; -ok !is_deeply( [\'a', 'b'], [\'a', 'c'] ); -is( $out, "not ok 20\n", 'scalar refs in an array' ); -is( $err, <<ERR, ' right diagnostic' ); -# Failed test at $0 line 274. -# Structures begin differing at: -# \$got->[1] = 'b' -# \$expected->[1] = 'c' -ERR - - -#line 285 -my $ref = \23; -ok !is_deeply( 23, $ref ); -is( $out, "not ok 21\n", 'scalar vs ref' ); -is( $err, <<ERR, ' right diagnostic'); -# Failed test at $0 line 286. -# Structures begin differing at: -# \$got = '23' -# \$expected = $ref -ERR - -#line 296 -ok !is_deeply( $ref, 23 ); -is( $out, "not ok 22\n", 'ref vs scalar' ); -is( $err, <<ERR, ' right diagnostic'); -# Failed test at $0 line 296. -# Structures begin differing at: -# \$got = $ref -# \$expected = '23' -ERR - -#line 306 -ok !is_deeply( undef, [] ); -is( $out, "not ok 23\n", 'is_deeply and undef [RT 9441]' ); -like( $err, <<ERR, ' right diagnostic' ); -# Failed test at $Filename line 306\\. -# Structures begin differing at: -# \\\$got = undef -# \\\$expected = ARRAY\\(0x[0-9a-f]+\\) -ERR - - -# rt.cpan.org 8865 -{ - my $array = []; - my $hash = {}; - -#line 321 - ok !is_deeply( $array, $hash ); - is( $out, "not ok 24\n", 'is_deeply and different reference types' ); - is( $err, <<ERR, ' right diagnostic' ); -# Failed test at $0 line 321. -# Structures begin differing at: -# \$got = $array -# \$expected = $hash -ERR - -#line 332 - ok !is_deeply( [$array], [$hash] ); - is( $out, "not ok 25\n", 'nested different ref types' ); - is( $err, <<ERR, ' right diagnostic' ); -# Failed test at $0 line 332. -# Structures begin differing at: -# \$got->[0] = $array -# \$expected->[0] = $hash -ERR - - - # Overloaded object tests - { - my $foo = bless [], "Foo"; - my $bar = bless {}, "Bar"; - - { - package Bar; - "overload"->import(q[""] => sub { "wibble" }); - } - -#line 353 - ok !is_deeply( [$foo], [$bar] ); - is( $out, "not ok 26\n", 'string overloaded refs respected in diag' ); - is( $err, <<ERR, ' right diagnostic' ); -# Failed test at $0 line 353. -# Structures begin differing at: -# \$got->[0] = $foo -# \$expected->[0] = 'wibble' -ERR - - } -} - - -# rt.cpan.org 14746 -{ -# line 349 - ok !is_deeply( sub {"foo"}, sub {"bar"} ), 'function refs'; - is( $out, "not ok 27\n" ); - like( $err, <<ERR, ' right diagnostic' ); -# Failed test at $Filename line 349. -# Structures begin differing at: -# \\\$got = CODE\\(0x[0-9a-f]+\\) -# \\\$expected = CODE\\(0x[0-9a-f]+\\) -ERR - - - use Symbol; - my $glob1 = gensym; - my $glob2 = gensym; - -#line 357 - ok !is_deeply( $glob1, $glob2 ), 'typeglobs'; - is( $out, "not ok 28\n" ); - like( $err, <<ERR, ' right diagnostic' ); -# Failed test at $Filename line 357. -# Structures begin differing at: -# \\\$got = GLOB\\(0x[0-9a-f]+\\) -# \\\$expected = GLOB\\(0x[0-9a-f]+\\) -ERR - -} diff --git a/lib/Test/Simple/t/is_deeply_with_threads.t b/lib/Test/Simple/t/is_deeply_with_threads.t deleted file mode 100644 index 9908ef6608..0000000000 --- a/lib/Test/Simple/t/is_deeply_with_threads.t +++ /dev/null @@ -1,65 +0,0 @@ -#!/usr/bin/perl -w - -# Test to see if is_deeply() plays well with threads. - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Config; - -BEGIN { - unless ( $] >= 5.008001 && $Config{'useithreads'} && - eval { require threads; 'threads'->import; 1; }) - { - print "1..0 # Skip no working threads\n"; - exit 0; - } - - unless ( $ENV{AUTHOR_TESTING} ) { - print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n"; - exit 0; - } -} -use Test::More; - -my $Num_Threads = 5; - -plan tests => $Num_Threads * 100 + 6; - - -sub do_one_thread { - my $kid = shift; - my @list = ( 'x', 'yy', 'zzz', 'a', 'bb', 'ccc', 'aaaaa', 'z', - 'hello', 's', 'thisisalongname', '1', '2', '3', - 'abc', 'xyz', '1234567890', 'm', 'n', 'p' ); - my @list2 = @list; - print "# kid $kid before is_deeply\n"; - - for my $j (1..100) { - is_deeply(\@list, \@list2); - } - print "# kid $kid exit\n"; - return 42; -} - -my @kids = (); -for my $i (1..$Num_Threads) { - my $t = threads->new(\&do_one_thread, $i); - print "# parent $$: continue\n"; - push(@kids, $t); -} -for my $t (@kids) { - print "# parent $$: waiting for join\n"; - my $rc = $t->join(); - cmp_ok( $rc, '==', 42, "threads exit status is $rc" ); -} - -pass("End of test"); diff --git a/lib/Test/Simple/t/lib/Dummy.pm b/lib/Test/Simple/t/lib/Dummy.pm deleted file mode 100644 index cdff79d540..0000000000 --- a/lib/Test/Simple/t/lib/Dummy.pm +++ /dev/null @@ -1,6 +0,0 @@ -package Dummy; - -use strict; -our $VERSION = '0.01'; - -1; diff --git a/lib/Test/Simple/t/lib/MyOverload.pm b/lib/Test/Simple/t/lib/MyOverload.pm deleted file mode 100644 index 65f5ea5a7d..0000000000 --- a/lib/Test/Simple/t/lib/MyOverload.pm +++ /dev/null @@ -1,30 +0,0 @@ -package Overloaded; ##no critic (Modules::RequireFilenameMatchesPackage) - -use strict; - -sub new { - my $class = shift; - bless { string => shift, num => shift }, $class; -} - -package Overloaded::Compare; - -use strict; -our @ISA = qw(Overloaded); - -# Sometimes objects have only comparison ops overloaded and nothing else. -# For example, DateTime objects. -use overload - q{eq} => sub { $_[0]->{string} eq $_[1] }, - q{==} => sub { $_[0]->{num} == $_[1] }; - -package Overloaded::Ify; - -use strict; -our @ISA = qw(Overloaded); - -use overload - q{""} => sub { $_[0]->{string} }, - q{0+} => sub { $_[0]->{num} }; - -1; diff --git a/lib/Test/Simple/t/lib/NoExporter.pm b/lib/Test/Simple/t/lib/NoExporter.pm deleted file mode 100644 index 6273e32d74..0000000000 --- a/lib/Test/Simple/t/lib/NoExporter.pm +++ /dev/null @@ -1,12 +0,0 @@ -package NoExporter; - -use strict; -our $VERSION = 1.02; - -sub import { - shift; - die "NoExporter exports nothing. You asked for: @_" if @_; -} - -1; - diff --git a/lib/Test/Simple/t/lib/SigDie.pm b/lib/Test/Simple/t/lib/SigDie.pm deleted file mode 100644 index 0774728d4e..0000000000 --- a/lib/Test/Simple/t/lib/SigDie.pm +++ /dev/null @@ -1,8 +0,0 @@ -package SigDie; - -use strict; - -our $DIE; -$SIG{__DIE__} = sub { $DIE = $@ }; - -1; diff --git a/lib/Test/Simple/t/missing.t b/lib/Test/Simple/t/missing.t deleted file mode 100644 index 3996b6de4b..0000000000 --- a/lib/Test/Simple/t/missing.t +++ /dev/null @@ -1,56 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 2); - -sub is { $TB->is_eq(@_) } - - -package main; - -require Test::Simple; - -require Test::Simple::Catch; -my($out, $err) = Test::Simple::Catch::caught(); -local $ENV{HARNESS_ACTIVE} = 0; - -Test::Simple->import(tests => 5); - -#line 30 -ok(1, 'Foo'); -ok(0, 'Bar'); -ok(1, '1 2 3'); - -END { - My::Test::is($$out, <<OUT); -1..5 -ok 1 - Foo -not ok 2 - Bar -ok 3 - 1 2 3 -OUT - - My::Test::is($$err, <<ERR); -# Failed test 'Bar' -# at $0 line 31. -# You named your test '1 2 3'. You shouldn't use numbers for your test names. -# Very confusing. -# Looks like you planned 5 tests but ran 3. -# Looks like you failed 1 test of 3 run. -ERR - - exit 0; -} diff --git a/lib/Test/Simple/t/new_ok.t b/lib/Test/Simple/t/new_ok.t deleted file mode 100644 index d53f535d1c..0000000000 --- a/lib/Test/Simple/t/new_ok.t +++ /dev/null @@ -1,42 +0,0 @@ -#!/usr/bin/perl -w - -use strict; - -use Test::More tests => 13; - -{ - package Bar; - - sub new { - my $class = shift; - return bless {@_}, $class; - } - - - package Foo; - our @ISA = qw(Bar); -} - -{ - my $obj = new_ok("Foo"); - is_deeply $obj, {}; - isa_ok $obj, "Foo"; - - $obj = new_ok("Bar"); - is_deeply $obj, {}; - isa_ok $obj, "Bar"; - - $obj = new_ok("Foo", [this => 42]); - is_deeply $obj, { this => 42 }; - isa_ok $obj, "Foo"; - - $obj = new_ok("Foo", [], "Foo"); - is_deeply $obj, {}; - isa_ok $obj, "Foo"; -} - -# And what if we give it nothing? -eval { - new_ok(); -}; -is $@, sprintf "new_ok() must be given at least a class at %s line %d.\n", $0, __LINE__ - 2; diff --git a/lib/Test/Simple/t/no_plan.t b/lib/Test/Simple/t/no_plan.t deleted file mode 100644 index 5f392e40e1..0000000000 --- a/lib/Test/Simple/t/no_plan.t +++ /dev/null @@ -1,33 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::More tests => 7; - -my $tb = Test::Builder->create; - -#line 20 -ok !eval { $tb->plan(tests => undef) }; -is($@, "Got an undefined number of tests at $0 line 20.\n"); - -#line 24 -ok !eval { $tb->plan(tests => 0) }; -is($@, "You said to run 0 tests at $0 line 24.\n"); - -{ - my $warning = ''; - local $SIG{__WARN__} = sub { $warning .= join '', @_ }; - -#line 31 - ok $tb->plan(no_plan => 1); - is( $warning, "no_plan takes no arguments at $0 line 31.\n" ); - is $tb->has_plan, 'no_plan'; -} diff --git a/lib/Test/Simple/t/no_tests.t b/lib/Test/Simple/t/no_tests.t deleted file mode 100644 index eafa38cacc..0000000000 --- a/lib/Test/Simple/t/no_tests.t +++ /dev/null @@ -1,44 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -# Can't use Test.pm, that's a 5.005 thing. -package My::Test; - -# This has to be a require or else the END block below runs before -# Test::Builder's own and the ending diagnostics don't come out right. -require Test::Builder; -my $TB = Test::Builder->create; -$TB->plan(tests => 3); - - -package main; - -require Test::Simple; - -chdir 't'; -push @INC, '../t/lib/'; -require Test::Simple::Catch; -my($out, $err) = Test::Simple::Catch::caught(); -local $ENV{HARNESS_ACTIVE} = 0; - -Test::Simple->import(tests => 1); - -END { - $TB->is_eq($out->read, <<OUT); -1..1 -OUT - - $TB->is_eq($err->read, <<ERR); -# No tests run! -ERR - - $TB->is_eq($?, 255, "exit code"); - - exit grep { !$_ } $TB->summary; -} diff --git a/lib/Test/Simple/t/note.t b/lib/Test/Simple/t/note.t deleted file mode 100644 index fb98fb4029..0000000000 --- a/lib/Test/Simple/t/note.t +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use warnings; - -use Test::Builder::NoOutput; - -use Test::More tests => 2; - -{ - my $tb = Test::Builder::NoOutput->create; - - $tb->note("foo"); - - $tb->reset_outputs; - - is $tb->read('out'), "# foo\n"; - is $tb->read('err'), ''; -} - diff --git a/lib/Test/Simple/t/overload.t b/lib/Test/Simple/t/overload.t deleted file mode 100644 index a86103746b..0000000000 --- a/lib/Test/Simple/t/overload.t +++ /dev/null @@ -1,86 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Test::More tests => 19; - - -package Overloaded; - -use overload - q{eq} => sub { $_[0]->{string} eq $_[1] }, - q{==} => sub { $_[0]->{num} == $_[1] }, - q{""} => sub { $_[0]->{stringify}++; $_[0]->{string} }, - q{0+} => sub { $_[0]->{numify}++; $_[0]->{num} } -; - -sub new { - my $class = shift; - bless { - string => shift, - num => shift, - stringify => 0, - numify => 0, - }, $class; -} - - -package main; - -local $SIG{__DIE__} = sub { - my($call_file, $call_line) = (caller)[1,2]; - fail("SIGDIE accidentally called"); - diag("From $call_file at $call_line"); -}; - -my $obj = Overloaded->new('foo', 42); -isa_ok $obj, 'Overloaded'; - -cmp_ok $obj, 'eq', 'foo', 'cmp_ok() eq'; -is $obj->{stringify}, 0, ' does not stringify'; -is $obj, 'foo', 'is() with string overloading'; -cmp_ok $obj, '==', 42, 'cmp_ok() with number overloading'; -is $obj->{numify}, 0, ' does not numify'; - -is_deeply [$obj], ['foo'], 'is_deeply with string overloading'; -ok eq_array([$obj], ['foo']), 'eq_array ...'; -ok eq_hash({foo => $obj}, {foo => 'foo'}), 'eq_hash ...'; - -# rt.cpan.org 13506 -is_deeply $obj, 'foo', 'is_deeply with string overloading at the top'; - -Test::More->builder->is_num($obj, 42); -Test::More->builder->is_eq ($obj, "foo"); - - -{ - # rt.cpan.org 14675 - package TestPackage; - use overload q{""} => sub { ::fail("This should not be called") }; - - package Foo; - ::is_deeply(['TestPackage'], ['TestPackage']); - ::is_deeply({'TestPackage' => 'TestPackage'}, - {'TestPackage' => 'TestPackage'}); - ::is_deeply('TestPackage', 'TestPackage'); -} - - -# Make sure 0 isn't a special case. [rt.cpan.org 41109] -{ - my $obj = Overloaded->new('0', 42); - isa_ok $obj, 'Overloaded'; - - cmp_ok $obj, 'eq', '0', 'cmp_ok() eq'; - is $obj->{stringify}, 0, ' does not stringify'; - is $obj, '0', 'is() with string overloading'; -} diff --git a/lib/Test/Simple/t/overload_threads.t b/lib/Test/Simple/t/overload_threads.t deleted file mode 100644 index 379e347bae..0000000000 --- a/lib/Test/Simple/t/overload_threads.t +++ /dev/null @@ -1,60 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} -chdir 't'; - -BEGIN { - # There was a bug with overloaded objects and threads. - # See rt.cpan.org 4218 - eval { require threads; 'threads'->import; 1; }; -} - -use Test::More tests => 5; - - -package Overloaded; - -use overload - q{""} => sub { $_[0]->{string} }; - -sub new { - my $class = shift; - bless { string => shift }, $class; -} - - -package main; - -my $warnings = ''; -local $SIG{__WARN__} = sub { $warnings = join '', @_ }; - -# overloaded object as name -my $obj = Overloaded->new('foo'); -ok( 1, $obj ); - -# overloaded object which returns undef as name -my $undef = Overloaded->new(undef); -pass( $undef ); - -is( $warnings, '' ); - - -TODO: { - my $obj = Overloaded->new('not really todo, testing overloaded reason'); - local $TODO = $obj; - fail("Just checking todo as an overloaded value"); -} - - -SKIP: { - my $obj = Overloaded->new('not really skipped, testing overloaded reason'); - skip $obj, 1; -} diff --git a/lib/Test/Simple/t/plan.t b/lib/Test/Simple/t/plan.t deleted file mode 100644 index 0d3ce89edb..0000000000 --- a/lib/Test/Simple/t/plan.t +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::More; - -plan tests => 4; -eval { plan tests => 4 }; -is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ - 1), - 'disallow double plan' ); -eval { plan 'no_plan' }; -is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ -1), - 'disallow changing plan' ); - -pass('Just testing plan()'); -pass('Testing it some more'); diff --git a/lib/Test/Simple/t/plan_bad.t b/lib/Test/Simple/t/plan_bad.t deleted file mode 100644 index 179356dbc1..0000000000 --- a/lib/Test/Simple/t/plan_bad.t +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - - -use Test::More tests => 12; -use Test::Builder; -my $tb = Test::Builder->create; -$tb->level(0); - -ok !eval { $tb->plan( tests => 'no_plan' ); }; -is $@, sprintf "Number of tests must be a positive integer. You gave it 'no_plan' at %s line %d.\n", $0, __LINE__ - 1; - -my $foo = []; -my @foo = ($foo, 2, 3); -ok !eval { $tb->plan( tests => @foo ) }; -is $@, sprintf "Number of tests must be a positive integer. You gave it '$foo' at %s line %d.\n", $0, __LINE__ - 1; - -ok !eval { $tb->plan( tests => 9.99 ) }; -is $@, sprintf "Number of tests must be a positive integer. You gave it '9.99' at %s line %d.\n", $0, __LINE__ - 1; - -#line 25 -ok !eval { $tb->plan( tests => -1 ) }; -is $@, "Number of tests must be a positive integer. You gave it '-1' at $0 line 25.\n"; - -#line 29 -ok !eval { $tb->plan( tests => '' ) }; -is $@, "You said to run 0 tests at $0 line 29.\n"; - -#line 33 -ok !eval { $tb->plan( 'wibble' ) }; -is $@, "plan() doesn't understand wibble at $0 line 33.\n"; diff --git a/lib/Test/Simple/t/plan_is_noplan.t b/lib/Test/Simple/t/plan_is_noplan.t deleted file mode 100644 index 1e696042ef..0000000000 --- a/lib/Test/Simple/t/plan_is_noplan.t +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; - -use Test::More tests => 1; - -use Test::Builder::NoOutput; - -{ - my $tb = Test::Builder::NoOutput->create; - - $tb->plan('no_plan'); - - $tb->ok(1, 'foo'); - $tb->_ending; - - is($tb->read, <<OUT); -ok 1 - foo -1..1 -OUT -} - diff --git a/lib/Test/Simple/t/plan_no_plan.t b/lib/Test/Simple/t/plan_no_plan.t deleted file mode 100644 index 3111592e97..0000000000 --- a/lib/Test/Simple/t/plan_no_plan.t +++ /dev/null @@ -1,40 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::More; - -BEGIN { - if( !$ENV{HARNESS_ACTIVE} && $ENV{PERL_CORE} ) { - plan skip_all => "Won't work with t/TEST"; - } -} - -plan 'no_plan'; - -pass('Just testing'); -ok(1, 'Testing again'); - -{ - my $warning = ''; - local $SIG{__WARN__} = sub { $warning = join "", @_ }; - SKIP: { - skip 'Just testing skip with no_plan'; - fail("So very failed"); - } - is( $warning, '', 'skip with no "how_many" ok with no_plan' ); - - - $warning = ''; - TODO: { - todo_skip "Just testing todo_skip"; - - fail("Just testing todo"); - die "todo_skip should prevent this"; - pass("Again"); - } - is( $warning, '', 'skip with no "how_many" ok with no_plan' ); -} diff --git a/lib/Test/Simple/t/plan_shouldnt_import.t b/lib/Test/Simple/t/plan_shouldnt_import.t deleted file mode 100644 index b6eb064244..0000000000 --- a/lib/Test/Simple/t/plan_shouldnt_import.t +++ /dev/null @@ -1,16 +0,0 @@ -#!/usr/bin/perl -w - -# plan() used to export functions by mistake [rt.cpan.org 8385] - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - - -use Test::More (); -Test::More::plan(tests => 1); - -Test::More::ok( !__PACKAGE__->can('ok'), 'plan should not export' ); diff --git a/lib/Test/Simple/t/plan_skip_all.t b/lib/Test/Simple/t/plan_skip_all.t deleted file mode 100644 index 528df5f50d..0000000000 --- a/lib/Test/Simple/t/plan_skip_all.t +++ /dev/null @@ -1,12 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::More; - -plan skip_all => 'Just testing plan & skip_all'; - -fail('We should never get here'); diff --git a/lib/Test/Simple/t/require_ok.t b/lib/Test/Simple/t/require_ok.t deleted file mode 100644 index 463a007599..0000000000 --- a/lib/Test/Simple/t/require_ok.t +++ /dev/null @@ -1,29 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Test::More tests => 8; - -# Symbol and Class::Struct are both non-XS core modules back to 5.004. -# So they'll always be there. -require_ok("Symbol"); -ok( $INC{'Symbol.pm'}, "require_ok MODULE" ); - -require_ok("Class/Struct.pm"); -ok( $INC{'Class/Struct.pm'}, "require_ok FILE" ); - -# Its more trouble than its worth to try to create these filepaths to test -# through require_ok() so we cheat and use the internal logic. -ok !Test::More::_is_module_name('foo:bar'); -ok !Test::More::_is_module_name('foo/bar.thing'); -ok !Test::More::_is_module_name('Foo::Bar::'); -ok Test::More::_is_module_name('V'); diff --git a/lib/Test/Simple/t/simple.t b/lib/Test/Simple/t/simple.t deleted file mode 100644 index 7297e9d6dd..0000000000 --- a/lib/Test/Simple/t/simple.t +++ /dev/null @@ -1,17 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; - -BEGIN { $| = 1; $^W = 1; } - -use Test::Simple tests => 3; - -ok(1, 'compile'); - -ok(1); -ok(1, 'foo'); diff --git a/lib/Test/Simple/t/skip.t b/lib/Test/Simple/t/skip.t deleted file mode 100644 index f2ea9fbf20..0000000000 --- a/lib/Test/Simple/t/skip.t +++ /dev/null @@ -1,98 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::More tests => 17; - -# If we skip with the same name, Test::Harness will report it back and -# we won't get lots of false bug reports. -my $Why = "Just testing the skip interface."; - -SKIP: { - skip $Why, 2 - unless Pigs->can('fly'); - - my $pig = Pigs->new; - $pig->takeoff; - - ok( $pig->altitude > 0, 'Pig is airborne' ); - ok( $pig->airspeed > 0, ' and moving' ); -} - - -SKIP: { - skip "We're not skipping", 2 if 0; - - pass("Inside skip block"); - pass("Another inside"); -} - - -SKIP: { - skip "Again, not skipping", 2 if 0; - - my($pack, $file, $line) = caller; - is( $pack || '', '', 'calling package not interfered with' ); - is( $file || '', '', ' or file' ); - is( $line || '', '', ' or line' ); -} - - -SKIP: { - skip $Why, 2 if 1; - - die "A horrible death"; - fail("Deliberate failure"); - fail("And again"); -} - - -{ - my $warning; - local $SIG{__WARN__} = sub { $warning = join "", @_ }; - SKIP: { - # perl gets the line number a little wrong on the first - # statement inside a block. - 1 == 1; -#line 56 - skip $Why; - fail("So very failed"); - } - is( $warning, "skip() needs to know \$how_many tests are in the ". - "block at $0 line 56\n", - 'skip without $how_many warning' ); -} - - -SKIP: { - skip "Not skipping here.", 4 if 0; - - pass("This is supposed to run"); - - # Testing out nested skips. - SKIP: { - skip $Why, 2; - fail("AHHH!"); - fail("You're a failure"); - } - - pass("This is supposed to run, too"); -} - -{ - my $warning = ''; - local $SIG{__WARN__} = sub { $warning .= join "", @_ }; - - SKIP: { - skip 1, "This is backwards" if 1; - - pass "This does not run"; - } - - like $warning, qr/^skip\(\) was passed a non-numeric number of tests/; -} diff --git a/lib/Test/Simple/t/skipall.t b/lib/Test/Simple/t/skipall.t deleted file mode 100644 index 5491be126e..0000000000 --- a/lib/Test/Simple/t/skipall.t +++ /dev/null @@ -1,33 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; - -use Test::More; - -my $Test = Test::Builder->create; -$Test->plan(tests => 2); - -my $out = ''; -my $err = ''; -{ - my $tb = Test::More->builder; - $tb->output(\$out); - $tb->failure_output(\$err); - - plan 'skip_all'; -} - -END { - $Test->is_eq($out, "1..0 # SKIP\n"); - $Test->is_eq($err, ""); -} diff --git a/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t b/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t deleted file mode 100644 index 8bdd17753b..0000000000 --- a/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t +++ /dev/null @@ -1,24 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use warnings; - -# Can't use Test::More, that would set exported_to() -use Test::Builder; -use Test::Builder::Module; - -my $TB = Test::Builder->create; -$TB->plan( tests => 1 ); -$TB->level(0); - -$TB->is_eq( Test::Builder::Module->builder->exported_to, - undef, - 'using Test::Builder::Module does not set exported_to()' -); diff --git a/lib/Test/Simple/t/thread_taint.t b/lib/Test/Simple/t/thread_taint.t deleted file mode 100644 index ef7b89daef..0000000000 --- a/lib/Test/Simple/t/thread_taint.t +++ /dev/null @@ -1,5 +0,0 @@ -#!/usr/bin/perl -w - -use Test::More tests => 1; - -ok( !$INC{'threads.pm'}, 'Loading Test::More does not load threads.pm' ); diff --git a/lib/Test/Simple/t/threads.t b/lib/Test/Simple/t/threads.t deleted file mode 100644 index 42ba8c269c..0000000000 --- a/lib/Test/Simple/t/threads.t +++ /dev/null @@ -1,33 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Config; -BEGIN { - unless ( $] >= 5.008001 && $Config{'useithreads'} && - eval { require threads; 'threads'->import; 1; }) - { - print "1..0 # Skip: no working threads\n"; - exit 0; - } -} - -use strict; -use Test::Builder; - -my $Test = Test::Builder->new; -$Test->exported_to('main'); -$Test->plan(tests => 6); - -for(1..5) { - 'threads'->create(sub { - $Test->ok(1,"Each of these should app the test number") - })->join; -} - -$Test->is_num($Test->current_test(), 5,"Should be five"); diff --git a/lib/Test/Simple/t/todo.t b/lib/Test/Simple/t/todo.t deleted file mode 100644 index 91861be3cb..0000000000 --- a/lib/Test/Simple/t/todo.t +++ /dev/null @@ -1,157 +0,0 @@ -#!perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::More; - -plan tests => 36; - - -$Why = 'Just testing the todo interface.'; - -my $is_todo; -TODO: { - local $TODO = $Why; - - fail("Expected failure"); - fail("Another expected failure"); - - $is_todo = Test::More->builder->todo; -} - -pass("This is not todo"); -ok( $is_todo, 'TB->todo' ); - - -TODO: { - local $TODO = $Why; - - fail("Yet another failure"); -} - -pass("This is still not todo"); - - -TODO: { - local $TODO = "testing that error messages don't leak out of todo"; - - ok( 'this' eq 'that', 'ok' ); - - like( 'this', qr/that/, 'like' ); - is( 'this', 'that', 'is' ); - isnt( 'this', 'this', 'isnt' ); - - can_ok('Fooble', 'yarble'); - isa_ok('Fooble', 'yarble'); - use_ok('Fooble'); - require_ok('Fooble'); -} - - -TODO: { - todo_skip "Just testing todo_skip", 2; - - fail("Just testing todo"); - die "todo_skip should prevent this"; - pass("Again"); -} - - -{ - my $warning; - local $SIG{__WARN__} = sub { $warning = join "", @_ }; - TODO: { - # perl gets the line number a little wrong on the first - # statement inside a block. - 1 == 1; -#line 74 - todo_skip "Just testing todo_skip"; - fail("So very failed"); - } - is( $warning, "todo_skip() needs to know \$how_many tests are in the ". - "block at $0 line 74\n", - 'todo_skip without $how_many warning' ); -} - -my $builder = Test::More->builder; -my $exported_to = $builder->exported_to; -TODO: { - $builder->exported_to("Wibble"); - - local $TODO = "testing \$TODO with an incorrect exported_to()"; - - fail("Just testing todo"); -} - -$builder->exported_to($exported_to); - -$builder->todo_start('Expected failures'); -fail('Testing todo_start()'); -ok 0, 'Testing todo_start() with more than one failure'; -$is_todo = $builder->todo; -$builder->todo_end; -is $is_todo, 'Expected failures', - 'todo_start should have the correct TODO message'; -ok 1, 'todo_end() should not leak TODO behavior'; - -my @nested_todo; -my ( $level1, $level2 ) = ( 'failure level 1', 'failure_level 2' ); -TODO: { - local $TODO = 'Nesting TODO'; - fail('fail 1'); - - $builder->todo_start($level1); - fail('fail 2'); - - push @nested_todo => $builder->todo; - $builder->todo_start($level2); - fail('fail 3'); - - push @nested_todo => $builder->todo; - $builder->todo_end; - fail('fail 4'); - - push @nested_todo => $builder->todo; - $builder->todo_end; - $is_todo = $builder->todo; - fail('fail 4'); -} -is_deeply \@nested_todo, [ $level1, $level2, $level1 ], - 'Nested TODO message should be correct'; -is $is_todo, 'Nesting TODO', - '... and original TODO message should be correct'; - -{ - $builder->todo_start; - fail("testing todo_start() with no message"); - my $reason = $builder->todo; - my $in_todo = $builder->in_todo; - $builder->todo_end; - - is $reason, '', " todo() reports no reason"; - ok $in_todo, " but we're in_todo()"; -} - -eval { - $builder->todo_end; -}; -is $@, sprintf "todo_end() called without todo_start() at %s line %d.\n", $0, __LINE__ - 2; - - -{ - my($reason, $in_todo); - - TODO: { - local $TODO = ''; - $reason = $builder->todo; - $in_todo = $builder->in_todo; - } - - is $reason, ''; - ok !$in_todo, '$TODO = "" is not considered TODO'; -} diff --git a/lib/Test/Simple/t/undef.t b/lib/Test/Simple/t/undef.t deleted file mode 100644 index 2e9201c3b4..0000000000 --- a/lib/Test/Simple/t/undef.t +++ /dev/null @@ -1,98 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Test::More tests => 21; - -BEGIN { $^W = 1; } - -my $warnings = ''; -local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; - -my $TB = Test::Builder->new; -sub no_warnings { - $TB->is_eq($warnings, '', ' no warnings'); - $warnings = ''; -} - -sub warnings_is { - $TB->is_eq($warnings, $_[0]); - $warnings = ''; -} - -sub warnings_like { - $TB->like($warnings, $_[0]); - $warnings = ''; -} - - -my $Filename = quotemeta $0; - - -is( undef, undef, 'undef is undef'); -no_warnings; - -isnt( undef, 'foo', 'undef isnt foo'); -no_warnings; - -isnt( undef, '', 'undef isnt an empty string' ); -isnt( undef, 0, 'undef isnt zero' ); - -Test::More->builder->is_num(undef, undef, 'is_num()'); -Test::More->builder->isnt_num(23, undef, 'isnt_num()'); - -#line 45 -like( undef, qr/.*/, 'undef is like anything' ); -warnings_like(qr/Use of uninitialized value.* at $Filename line 45\.\n/); - -eq_array( [undef, undef], [undef, 23] ); -no_warnings; - -eq_hash ( { foo => undef, bar => undef }, - { foo => undef, bar => 23 } ); -no_warnings; - -eq_set ( [undef, undef, 12], [29, undef, undef] ); -no_warnings; - - -eq_hash ( { foo => undef, bar => { baz => undef, moo => 23 } }, - { foo => undef, bar => { baz => undef, moo => 23 } } ); -no_warnings; - - -#line 64 -cmp_ok( undef, '<=', 2, ' undef <= 2' ); -warnings_like(qr/Use of uninitialized value.* at cmp_ok \[from $Filename line 64\] line 1\.\n/); - - - -my $tb = Test::More->builder; - -my $err; -$tb->failure_output(\$err); -diag(undef); -$tb->reset_outputs; - -is( $err, "# undef\n" ); -no_warnings; - - -$tb->maybe_regex(undef); -no_warnings; - - -# test-more.googlecode.com #42 -{ - is_deeply([ undef ], [ undef ]); - no_warnings; -} diff --git a/lib/Test/Simple/t/use_ok.t b/lib/Test/Simple/t/use_ok.t deleted file mode 100644 index 4a62f3557e..0000000000 --- a/lib/Test/Simple/t/use_ok.t +++ /dev/null @@ -1,67 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = qw(../lib ../lib/Test/Simple/t/lib); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::More tests => 15; - -# Using Symbol because it's core and exports lots of stuff. -{ - package Foo::one; - ::use_ok("Symbol"); - ::ok( defined &gensym, 'use_ok() no args exports defaults' ); -} - -{ - package Foo::two; - ::use_ok("Symbol", qw(qualify)); - ::ok( !defined &gensym, ' one arg, defaults overriden' ); - ::ok( defined &qualify, ' right function exported' ); -} - -{ - package Foo::three; - ::use_ok("Symbol", qw(gensym ungensym)); - ::ok( defined &gensym && defined &ungensym, ' multiple args' ); -} - -{ - package Foo::four; - my $warn; local $SIG{__WARN__} = sub { $warn .= shift; }; - ::use_ok("constant", qw(foo bar)); - ::ok( defined &foo, 'constant' ); - ::is( $warn, undef, 'no warning'); -} - -{ - package Foo::five; - ::use_ok("Symbol", 1.02); -} - -{ - package Foo::six; - ::use_ok("NoExporter", 1.02); -} - -{ - package Foo::seven; - local $SIG{__WARN__} = sub { - # Old perls will warn on X.YY_ZZ style versions. Not our problem - warn @_ unless $_[0] =~ /^Argument "\d+\.\d+_\d+" isn't numeric/; - }; - ::use_ok("Test::More", 0.47); -} - -{ - package Foo::eight; - local $SIG{__DIE__}; - ::use_ok("SigDie"); - ::ok(defined $SIG{__DIE__}, ' SIG{__DIE__} preserved'); -} diff --git a/lib/Test/Simple/t/useing.t b/lib/Test/Simple/t/useing.t deleted file mode 100644 index c4ce507127..0000000000 --- a/lib/Test/Simple/t/useing.t +++ /dev/null @@ -1,19 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use Test::More tests => 5; - -require_ok('Test::Builder'); -require_ok("Test::More"); -require_ok("Test::Simple"); - -{ - package Foo; - use Test::More import => [qw(ok is can_ok)]; - can_ok('Foo', qw(ok is can_ok)); - ok( !Foo->can('like'), 'import working properly' ); -} diff --git a/lib/Test/Simple/t/utf8.t b/lib/Test/Simple/t/utf8.t deleted file mode 100644 index c7e93c3ac2..0000000000 --- a/lib/Test/Simple/t/utf8.t +++ /dev/null @@ -1,69 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } -} - -use strict; -use warnings; - -use Test::More skip_all => 'Not yet implemented'; - -my $have_perlio; -BEGIN { - # All together so Test::More sees the open discipline - $have_perlio = eval q[ - use PerlIO; - use open ':std', ':locale'; - use Test::More; - 1; - ]; -} - -use Test::More; - -if( !$have_perlio ) { - plan skip_all => "Don't have PerlIO"; -} -else { - plan tests => 5; -} - -SKIP: { - skip( "Need PerlIO for this feature", 3 ) - unless $have_perlio; - - my %handles = ( - output => \*STDOUT, - failure_output => \*STDERR, - todo_output => \*STDOUT - ); - - for my $method (keys %handles) { - my $src = $handles{$method}; - - my $dest = Test::More->builder->$method; - - is_deeply { map { $_ => 1 } PerlIO::get_layers($dest) }, - { map { $_ => 1 } PerlIO::get_layers($src) }, - "layers copied to $method"; - } -} - -SKIP: { - skip( "Can't test in general because their locale is unknown", 2 ) - unless $ENV{AUTHOR_TESTING}; - - my $uni = "\x{11e}"; - - my @warnings; - local $SIG{__WARN__} = sub { - push @warnings, @_; - }; - - is( $uni, $uni, "Testing $uni" ); - is_deeply( \@warnings, [] ); -} diff --git a/lib/Test/Simple/t/versions.t b/lib/Test/Simple/t/versions.t deleted file mode 100644 index e41e7ce3e0..0000000000 --- a/lib/Test/Simple/t/versions.t +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/perl -w - -# Make sure all the modules have the same version -# -# TBT has its own version system. - -use strict; -use Test::More; - -require Test::Builder; -require Test::Builder::Module; -require Test::Simple; - -my $dist_version = $Test::More::VERSION; - -like( $dist_version, qr/^ \d+ \. \d+ $/x ); -is( $dist_version, $Test::Builder::VERSION, 'Test::Builder' ); -is( $dist_version, $Test::Builder::Module::VERSION, 'TB::Module' ); -is( $dist_version, $Test::Simple::VERSION, 'Test::Simple' ); - -done_testing(4); diff --git a/lib/Test/Tutorial.pod b/lib/Test/Tutorial.pod deleted file mode 100644 index b730918c75..0000000000 --- a/lib/Test/Tutorial.pod +++ /dev/null @@ -1,603 +0,0 @@ -=head1 NAME - -Test::Tutorial - A tutorial about writing really basic tests - -=head1 DESCRIPTION - - -I<AHHHHHHH!!!! NOT TESTING! Anything but testing! -Beat me, whip me, send me to Detroit, but don't make -me write tests!> - -I<*sob*> - -I<Besides, I don't know how to write the damned things.> - - -Is this you? Is writing tests right up there with writing -documentation and having your fingernails pulled out? Did you open up -a test and read - - ######## We start with some black magic - -and decide that's quite enough for you? - -It's ok. That's all gone now. We've done all the black magic for -you. And here are the tricks... - - -=head2 Nuts and bolts of testing. - -Here's the most basic test program. - - #!/usr/bin/perl -w - - print "1..1\n"; - - print 1 + 1 == 2 ? "ok 1\n" : "not ok 1\n"; - -since 1 + 1 is 2, it prints: - - 1..1 - ok 1 - -What this says is: C<1..1> "I'm going to run one test." [1] C<ok 1> -"The first test passed". And that's about all magic there is to -testing. Your basic unit of testing is the I<ok>. For each thing you -test, an C<ok> is printed. Simple. B<Test::Harness> interprets your test -results to determine if you succeeded or failed (more on that later). - -Writing all these print statements rapidly gets tedious. Fortunately, -there's B<Test::Simple>. It has one function, C<ok()>. - - #!/usr/bin/perl -w - - use Test::Simple tests => 1; - - ok( 1 + 1 == 2 ); - -and that does the same thing as the code above. C<ok()> is the backbone -of Perl testing, and we'll be using it instead of roll-your-own from -here on. If C<ok()> gets a true value, the test passes. False, it -fails. - - #!/usr/bin/perl -w - - use Test::Simple tests => 2; - ok( 1 + 1 == 2 ); - ok( 2 + 2 == 5 ); - -from that comes - - 1..2 - ok 1 - not ok 2 - # Failed test (test.pl at line 5) - # Looks like you failed 1 tests of 2. - -C<1..2> "I'm going to run two tests." This number is used to ensure -your test program ran all the way through and didn't die or skip some -tests. C<ok 1> "The first test passed." C<not ok 2> "The second test -failed". Test::Simple helpfully prints out some extra commentary about -your tests. - -It's not scary. Come, hold my hand. We're going to give an example -of testing a module. For our example, we'll be testing a date -library, B<Date::ICal>. It's on CPAN, so download a copy and follow -along. [2] - - -=head2 Where to start? - -This is the hardest part of testing, where do you start? People often -get overwhelmed at the apparent enormity of the task of testing a -whole module. Best place to start is at the beginning. Date::ICal is -an object-oriented module, and that means you start by making an -object. So we test C<new()>. - - #!/usr/bin/perl -w - - use Test::Simple tests => 2; - - use Date::ICal; - - my $ical = Date::ICal->new; # create an object - ok( defined $ical ); # check that we got something - ok( $ical->isa('Date::ICal') ); # and it's the right class - -run that and you should get: - - 1..2 - ok 1 - ok 2 - -congratulations, you've written your first useful test. - - -=head2 Names - -That output isn't terribly descriptive, is it? When you have two -tests you can figure out which one is #2, but what if you have 102? - -Each test can be given a little descriptive name as the second -argument to C<ok()>. - - use Test::Simple tests => 2; - - ok( defined $ical, 'new() returned something' ); - ok( $ical->isa('Date::ICal'), " and it's the right class" ); - -So now you'd see... - - 1..2 - ok 1 - new() returned something - ok 2 - and it's the right class - - -=head2 Test the manual - -Simplest way to build up a decent testing suite is to just test what -the manual says it does. [3] Let's pull something out of the -L<Date::ICal/SYNOPSIS> and test that all its bits work. - - #!/usr/bin/perl -w - - use Test::Simple tests => 8; - - use Date::ICal; - - $ical = Date::ICal->new( year => 1964, month => 10, day => 16, - hour => 16, min => 12, sec => 47, - tz => '0530' ); - - ok( defined $ical, 'new() returned something' ); - ok( $ical->isa('Date::ICal'), " and it's the right class" ); - ok( $ical->sec == 47, ' sec()' ); - ok( $ical->min == 12, ' min()' ); - ok( $ical->hour == 16, ' hour()' ); - ok( $ical->day == 17, ' day()' ); - ok( $ical->month == 10, ' month()' ); - ok( $ical->year == 1964, ' year()' ); - -run that and you get: - - 1..8 - ok 1 - new() returned something - ok 2 - and it's the right class - ok 3 - sec() - ok 4 - min() - ok 5 - hour() - not ok 6 - day() - # Failed test (- at line 16) - ok 7 - month() - ok 8 - year() - # Looks like you failed 1 tests of 8. - -Whoops, a failure! [4] Test::Simple helpfully lets us know on what line -the failure occurred, but not much else. We were supposed to get 17, -but we didn't. What did we get?? Dunno. We'll have to re-run the -test in the debugger or throw in some print statements to find out. - -Instead, we'll switch from B<Test::Simple> to B<Test::More>. B<Test::More> -does everything B<Test::Simple> does, and more! In fact, Test::More does -things I<exactly> the way Test::Simple does. You can literally swap -Test::Simple out and put Test::More in its place. That's just what -we're going to do. - -Test::More does more than Test::Simple. The most important difference -at this point is it provides more informative ways to say "ok". -Although you can write almost any test with a generic C<ok()>, it -can't tell you what went wrong. Instead, we'll use the C<is()> -function, which lets us declare that something is supposed to be the -same as something else: - - #!/usr/bin/perl -w - - use Test::More tests => 8; - - use Date::ICal; - - $ical = Date::ICal->new( year => 1964, month => 10, day => 16, - hour => 16, min => 12, sec => 47, - tz => '0530' ); - - ok( defined $ical, 'new() returned something' ); - ok( $ical->isa('Date::ICal'), " and it's the right class" ); - is( $ical->sec, 47, ' sec()' ); - is( $ical->min, 12, ' min()' ); - is( $ical->hour, 16, ' hour()' ); - is( $ical->day, 17, ' day()' ); - is( $ical->month, 10, ' month()' ); - is( $ical->year, 1964, ' year()' ); - -"Is C<$ical-E<gt>sec> 47?" "Is C<$ical-E<gt>min> 12?" With C<is()> in place, -you get some more information - - 1..8 - ok 1 - new() returned something - ok 2 - and it's the right class - ok 3 - sec() - ok 4 - min() - ok 5 - hour() - not ok 6 - day() - # Failed test (- at line 16) - # got: '16' - # expected: '17' - ok 7 - month() - ok 8 - year() - # Looks like you failed 1 tests of 8. - -letting us know that C<$ical-E<gt>day> returned 16, but we expected 17. A -quick check shows that the code is working fine, we made a mistake -when writing up the tests. Just change it to: - - is( $ical->day, 16, ' day()' ); - -and everything works. - -So any time you're doing a "this equals that" sort of test, use C<is()>. -It even works on arrays. The test is always in scalar context, so you -can test how many elements are in a list this way. [5] - - is( @foo, 5, 'foo has 5 elements' ); - - -=head2 Sometimes the tests are wrong - -Which brings us to a very important lesson. Code has bugs. Tests are -code. Ergo, tests have bugs. A failing test could mean a bug in the -code, but don't discount the possibility that the test is wrong. - -On the flip side, don't be tempted to prematurely declare a test -incorrect just because you're having trouble finding the bug. -Invalidating a test isn't something to be taken lightly, and don't use -it as a cop out to avoid work. - - -=head2 Testing lots of values - -We're going to be wanting to test a lot of dates here, trying to trick -the code with lots of different edge cases. Does it work before 1970? -After 2038? Before 1904? Do years after 10,000 give it trouble? -Does it get leap years right? We could keep repeating the code above, -or we could set up a little try/expect loop. - - use Test::More tests => 32; - use Date::ICal; - - my %ICal_Dates = ( - # An ICal string And the year, month, date - # hour, minute and second we expect. - '19971024T120000' => # from the docs. - [ 1997, 10, 24, 12, 0, 0 ], - '20390123T232832' => # after the Unix epoch - [ 2039, 1, 23, 23, 28, 32 ], - '19671225T000000' => # before the Unix epoch - [ 1967, 12, 25, 0, 0, 0 ], - '18990505T232323' => # before the MacOS epoch - [ 1899, 5, 5, 23, 23, 23 ], - ); - - - while( my($ical_str, $expect) = each %ICal_Dates ) { - my $ical = Date::ICal->new( ical => $ical_str ); - - ok( defined $ical, "new(ical => '$ical_str')" ); - ok( $ical->isa('Date::ICal'), " and it's the right class" ); - - is( $ical->year, $expect->[0], ' year()' ); - is( $ical->month, $expect->[1], ' month()' ); - is( $ical->day, $expect->[2], ' day()' ); - is( $ical->hour, $expect->[3], ' hour()' ); - is( $ical->min, $expect->[4], ' min()' ); - is( $ical->sec, $expect->[5], ' sec()' ); - } - -So now we can test bunches of dates by just adding them to -C<%ICal_Dates>. Now that it's less work to test with more dates, you'll -be inclined to just throw more in as you think of them. -Only problem is, every time we add to that we have to keep adjusting -the C<use Test::More tests =E<gt> ##> line. That can rapidly get -annoying. There's two ways to make this work better. - -First, we can calculate the plan dynamically using the C<plan()> -function. - - use Test::More; - use Date::ICal; - - my %ICal_Dates = ( - ...same as before... - ); - - # For each key in the hash we're running 8 tests. - plan tests => keys %ICal_Dates * 8; - -Or to be even more flexible, we use C<no_plan>. This means we're just -running some tests, don't know how many. [6] - - use Test::More 'no_plan'; # instead of tests => 32 - -now we can just add tests and not have to do all sorts of math to -figure out how many we're running. - - -=head2 Informative names - -Take a look at this line here - - ok( defined $ical, "new(ical => '$ical_str')" ); - -we've added more detail about what we're testing and the ICal string -itself we're trying out to the name. So you get results like: - - ok 25 - new(ical => '19971024T120000') - ok 26 - and it's the right class - ok 27 - year() - ok 28 - month() - ok 29 - day() - ok 30 - hour() - ok 31 - min() - ok 32 - sec() - -if something in there fails, you'll know which one it was and that -will make tracking down the problem easier. So try to put a bit of -debugging information into the test names. - -Describe what the tests test, to make debugging a failed test easier -for you or for the next person who runs your test. - - -=head2 Skipping tests - -Poking around in the existing Date::ICal tests, I found this in -F<t/01sanity.t> [7] - - #!/usr/bin/perl -w - - use Test::More tests => 7; - use Date::ICal; - - # Make sure epoch time is being handled sanely. - my $t1 = Date::ICal->new( epoch => 0 ); - is( $t1->epoch, 0, "Epoch time of 0" ); - - # XXX This will only work on unix systems. - is( $t1->ical, '19700101Z', " epoch to ical" ); - - is( $t1->year, 1970, " year()" ); - is( $t1->month, 1, " month()" ); - is( $t1->day, 1, " day()" ); - - # like the tests above, but starting with ical instead of epoch - my $t2 = Date::ICal->new( ical => '19700101Z' ); - is( $t2->ical, '19700101Z', "Start of epoch in ICal notation" ); - - is( $t2->epoch, 0, " and back to ICal" ); - -The beginning of the epoch is different on most non-Unix operating -systems [8]. Even though Perl smooths out the differences for the most -part, certain ports do it differently. MacPerl is one off the top of -my head. [9] We I<know> this will never work on MacOS. So rather than -just putting a comment in the test, we can explicitly say it's never -going to work and skip the test. - - use Test::More tests => 7; - use Date::ICal; - - # Make sure epoch time is being handled sanely. - my $t1 = Date::ICal->new( epoch => 0 ); - is( $t1->epoch, 0, "Epoch time of 0" ); - - SKIP: { - skip('epoch to ICal not working on MacOS', 6) - if $^O eq 'MacOS'; - - is( $t1->ical, '19700101Z', " epoch to ical" ); - - is( $t1->year, 1970, " year()" ); - is( $t1->month, 1, " month()" ); - is( $t1->day, 1, " day()" ); - - # like the tests above, but starting with ical instead of epoch - my $t2 = Date::ICal->new( ical => '19700101Z' ); - is( $t2->ical, '19700101Z', "Start of epoch in ICal notation" ); - - is( $t2->epoch, 0, " and back to ICal" ); - } - -A little bit of magic happens here. When running on anything but -MacOS, all the tests run normally. But when on MacOS, C<skip()> causes -the entire contents of the SKIP block to be jumped over. It's never -run. Instead, it prints special output that tells Test::Harness that -the tests have been skipped. - - 1..7 - ok 1 - Epoch time of 0 - ok 2 # skip epoch to ICal not working on MacOS - ok 3 # skip epoch to ICal not working on MacOS - ok 4 # skip epoch to ICal not working on MacOS - ok 5 # skip epoch to ICal not working on MacOS - ok 6 # skip epoch to ICal not working on MacOS - ok 7 # skip epoch to ICal not working on MacOS - -This means your tests won't fail on MacOS. This means less emails -from MacPerl users telling you about failing tests that you know will -never work. You've got to be careful with skip tests. These are for -tests which don't work and I<never will>. It is not for skipping -genuine bugs (we'll get to that in a moment). - -The tests are wholly and completely skipped. [10] This will work. - - SKIP: { - skip("I don't wanna die!"); - - die, die, die, die, die; - } - - -=head2 Todo tests - -Thumbing through the Date::ICal man page, I came across this: - - ical - - $ical_string = $ical->ical; - - Retrieves, or sets, the date on the object, using any - valid ICal date/time string. - -"Retrieves or sets". Hmmm, didn't see a test for using C<ical()> to set -the date in the Date::ICal test suite. So I'll write one. - - use Test::More tests => 1; - use Date::ICal; - - my $ical = Date::ICal->new; - $ical->ical('20201231Z'); - is( $ical->ical, '20201231Z', 'Setting via ical()' ); - -run that and I get - - 1..1 - not ok 1 - Setting via ical() - # Failed test (- at line 6) - # got: '20010814T233649Z' - # expected: '20201231Z' - # Looks like you failed 1 tests of 1. - -Whoops! Looks like it's unimplemented. Let's assume we don't have -the time to fix this. [11] Normally, you'd just comment out the test -and put a note in a todo list somewhere. Instead, we're going to -explicitly state "this test will fail" by wrapping it in a C<TODO> block. - - use Test::More tests => 1; - - TODO: { - local $TODO = 'ical($ical) not yet implemented'; - - my $ical = Date::ICal->new; - $ical->ical('20201231Z'); - - is( $ical->ical, '20201231Z', 'Setting via ical()' ); - } - -Now when you run, it's a little different: - - 1..1 - not ok 1 - Setting via ical() # TODO ical($ical) not yet implemented - # got: '20010822T201551Z' - # expected: '20201231Z' - -Test::More doesn't say "Looks like you failed 1 tests of 1". That '# -TODO' tells Test::Harness "this is supposed to fail" and it treats a -failure as a successful test. So you can write tests even before -you've fixed the underlying code. - -If a TODO test passes, Test::Harness will report it "UNEXPECTEDLY -SUCCEEDED". When that happens, you simply remove the TODO block with -C<local $TODO> and turn it into a real test. - - -=head2 Testing with taint mode. - -Taint mode is a funny thing. It's the globalest of all global -features. Once you turn it on, it affects I<all> code in your program -and I<all> modules used (and all the modules they use). If a single -piece of code isn't taint clean, the whole thing explodes. With that -in mind, it's very important to ensure your module works under taint -mode. - -It's very simple to have your tests run under taint mode. Just throw -a C<-T> into the C<#!> line. Test::Harness will read the switches -in C<#!> and use them to run your tests. - - #!/usr/bin/perl -Tw - - ...test normally here... - -So when you say C<make test> it will be run with taint mode and -warnings on. - - -=head1 FOOTNOTES - -=over 4 - -=item 1 - -The first number doesn't really mean anything, but it has to be 1. -It's the second number that's important. - -=item 2 - -For those following along at home, I'm using version 1.31. It has -some bugs, which is good -- we'll uncover them with our tests. - -=item 3 - -You can actually take this one step further and test the manual -itself. Have a look at B<Test::Inline> (formerly B<Pod::Tests>). - -=item 4 - -Yes, there's a mistake in the test suite. What! Me, contrived? - -=item 5 - -We'll get to testing the contents of lists later. - -=item 6 - -But what happens if your test program dies halfway through?! Since we -didn't say how many tests we're going to run, how can we know it -failed? No problem, Test::More employs some magic to catch that death -and turn the test into a failure, even if every test passed up to that -point. - -=item 7 - -I cleaned it up a little. - -=item 8 - -Most Operating Systems record time as the number of seconds since a -certain date. This date is the beginning of the epoch. Unix's starts -at midnight January 1st, 1970 GMT. - -=item 9 - -MacOS's epoch is midnight January 1st, 1904. VMS's is midnight, -November 17th, 1858, but vmsperl emulates the Unix epoch so it's not a -problem. - -=item 10 - -As long as the code inside the SKIP block at least compiles. Please -don't ask how. No, it's not a filter. - -=item 11 - -Do NOT be tempted to use TODO tests as a way to avoid fixing simple -bugs! - -=back - -=head1 AUTHORS - -Michael G Schwern E<lt>schwern@pobox.comE<gt> and the perl-qa dancers! - -=head1 COPYRIGHT - -Copyright 2001 by Michael G Schwern E<lt>schwern@pobox.comE<gt>. - -This documentation is free; you can redistribute it and/or modify it -under the same terms as Perl itself. - -Irrespective of its distribution, all code examples in these files -are hereby placed into the public domain. You are permitted and -encouraged to use this code in your own programs for fun -or for profit as you see fit. A simple comment in the code giving -credit would be courteous but is not required. - -=cut |