Test-Simple-1.001014/0000755000175000017500000000000012450030545014024 5ustar exodistexodistTest-Simple-1.001014/lib/0000755000175000017500000000000012450030545014572 5ustar exodistexodistTest-Simple-1.001014/lib/Test/0000755000175000017500000000000012450030545015511 5ustar exodistexodistTest-Simple-1.001014/lib/Test/Simple.pm0000644000175000017500000001466312450027564017321 0ustar exodistexodistpackage Test::Simple; use 5.006; use strict; our $VERSION = '1.001014'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) use Test::Builder::Module 0.99; 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 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 C 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( $foo eq $bar, $name ); ok( $foo eq $bar ); C 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. C 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 L 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. =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 tested all the way back to perl 5.6.0. Test::Simple is thread-safe in perl 5.8.1 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. 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 More testing functions! Once you outgrow Test::Simple, look at L. Test::Simple is 100% forward compatible with L (i.e. you can just use L instead of Test::Simple in your programs and things will still work). =back Look in L's SEE ALSO for more testing modules. =head1 AUTHORS Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern Eschwern@pobox.comE, wardrobe by Calvin Klein. =head1 MAINTAINERS =over 4 =item Chad Granum Eexodist@cpan.orgE =back =head1 COPYRIGHT Copyright 2001-2008 by Michael G Schwern Eschwern@pobox.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut 1; Test-Simple-1.001014/lib/Test/Tutorial.pod0000644000175000017500000004561712424541472020044 0ustar exodistexodist=head1 NAME Test::Tutorial - A tutorial about writing really basic tests =head1 DESCRIPTION I I<*sob*> I 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"; Because 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 "The first test passed". And that's about all magic there is to testing. Your basic unit of testing is the I. For each thing you test, an C is printed. Simple. L 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 L. It has one function, C. #!/usr/bin/perl -w use Test::Simple tests => 1; ok( 1 + 1 == 2 ); That does the same thing as the previous code. C is the backbone of Perl testing, and we'll be using it instead of roll-your-own from here on. If C 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 a I. It helps to ensure your test program ran all the way through and didn't die or skip some tests. C "The first test passed." C "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, L. 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. The best place to start is at the beginning. L is an object-oriented module, and that means you start by making an object. Test C. #!/usr/bin/perl -w # assume these two lines are in all subsequent examples use strict; use warnings; 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 tests? Each test can be given a little descriptive name as the second argument to C. use Test::Simple tests => 2; ok( defined $ical, 'new() returned something' ); ok( $ical->isa('Date::ICal'), " and it's the right class" ); Now you'll see: 1..2 ok 1 - new() returned something ok 2 - and it's the right class =head2 Test the manual The 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 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] L 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. You could re-run the test in the debugger or throw in some print statements to find out. Instead, switch from L to L. L does everything L does, and more! In fact, L does things I the way L does. You can literally swap L out and put L in its place. That's just what we're going to do. L does more than L. 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, it can't tell you what went wrong. The C function lets us declare that something is supposed to be the same as something else: 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->sec >> 47?" "Is C<< $ical->min >> 12?" With C in place, you get 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. Aha. C<< $ical->day >> returned 16, but we expected 17. A quick check shows that the code is working fine, we made a mistake when writing the tests. Change it to: is( $ical->day, 16, ' day()' ); ... and everything works. Any time you're doing a "this equals that" sort of test, use C. It even works on arrays. The test is always in scalar context, so you can test how many elements are in an array this way. [5] is( @foo, 5, 'foo has 5 elements' ); =head2 Sometimes the tests are wrong This brings up 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, day # 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()' ); } 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 L<< use Test::More tests => ## >> line. That can rapidly get annoying. There are ways to make this work better. First, we can calculate the plan dynamically using the C 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; ...and then your tests... To be even more flexible, use C. This means we're just running some tests, don't know how many. [6] use Test::More; # instead of tests => 32 ... # tests here done_testing(); # reached the end safely If you don't specify a plan, L expects to see C before your program exits. It will warn you if you forget it. You can give C an optional number of tests you expected to run, and if the number ran differs, L will give you another kind of warning. =head2 Informative names Take a look at the line: 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. 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 [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] Rather than putting a comment in the test and hoping someone will read the test while debugging the failure, 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 Mac OS', 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 causes the entire contents of the SKIP block to be jumped over. It never runs. Instead, C prints special output that tells L 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 fewer 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. 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 While thumbing through the L 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. I didn't see a test for using C to set the date in the Date::ICal test suite. So I wrote 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. I saw: 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. Assume you 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, explicitly state "this test will fail" by wrapping it in a C 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' L doesn't say "Looks like you failed 1 tests of 1". That '# TODO' tells L "this is supposed to fail" and it treats a failure as a successful test. You can write tests even before you've fixed the underlying code. If a TODO test passes, L will report it "UNEXPECTEDLY SUCCEEDED". When that happens, remove the TODO block with C 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 code in your program and I 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. L will read the switches in C<#!> and use them to run your tests. #!/usr/bin/perl -Tw ...test normally here... When you say C it will run with taint mode 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 L (formerly L). =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, L 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 Eschwern@pobox.comE and the perl-qa dancers! =head1 MAINTAINERS =over 4 =item Chad Granum Eexodist@cpan.orgE =back =head1 COPYRIGHT Copyright 2001 by Michael G Schwern Eschwern@pobox.comE. 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 Test-Simple-1.001014/lib/Test/use/0000755000175000017500000000000012450030544016304 5ustar exodistexodistTest-Simple-1.001014/lib/Test/use/ok.pm0000644000175000017500000000252512450027572017266 0ustar exodistexodistpackage Test::use::ok; use 5.005; $Test::use::ok::VERSION = '0.16'; __END__ =head1 NAME Test::use::ok - Alternative to Test::More::use_ok =head1 SYNOPSIS use ok 'Some::Module'; =head1 DESCRIPTION According to the B documentation, it is recommended to run C inside a C block, so functions are exported at compile-time and prototypes are properly honored. That is, instead of writing this: use_ok( 'Some::Module' ); use_ok( 'Other::Module' ); One should write this: BEGIN { use_ok( 'Some::Module' ); } BEGIN { use_ok( 'Other::Module' ); } However, people often either forget to add C, or mistakenly group C with other tests in a single C block, which can create subtle differences in execution order. With this module, simply change all C in test scripts to C, and they will be executed at C time. The explicit space after C makes it clear that this is a single compile-time action. =head1 SEE ALSO L =head1 MAINTAINER =over 4 =item Chad Granum Eexodist@cpan.orgE =back =encoding utf8 =head1 CC0 1.0 Universal To the extent possible under law, 唐鳳 has waived all copyright and related or neighboring rights to L. This work is published from Taiwan. L =cut Test-Simple-1.001014/lib/Test/Tester.pm0000644000175000017500000004162012450027600017316 0ustar exodistexodistuse strict; package Test::Tester; BEGIN { if (*Test::Builder::new{CODE}) { warn "You should load Test::Tester before Test::Builder (or anything that loads Test::Builder)" } } use Test::Builder; use Test::Tester::CaptureRunner; use Test::Tester::Delegate; require Exporter; use vars qw( @ISA @EXPORT $VERSION ); $VERSION = "0.114"; @EXPORT = qw( run_tests check_tests check_test cmp_results show_space ); @ISA = qw( Exporter ); my $Test = Test::Builder->new; my $Capture = Test::Tester::Capture->new; my $Delegator = Test::Tester::Delegate->new; $Delegator->{Object} = $Test; my $runner = Test::Tester::CaptureRunner->new; my $want_space = $ENV{TESTTESTERSPACE}; sub show_space { $want_space = 1; } my $colour = ''; my $reset = ''; if (my $want_colour = $ENV{TESTTESTERCOLOUR} || $ENV{TESTTESTERCOLOUR}) { if (eval "require Term::ANSIColor") { my ($f, $b) = split(",", $want_colour); $colour = Term::ANSIColor::color($f).Term::ANSIColor::color("on_$b"); $reset = Term::ANSIColor::color("reset"); } } sub new_new { return $Delegator; } sub capture { return Test::Tester::Capture->new; } sub fh { # experiment with capturing output, I don't like it $runner = Test::Tester::FHRunner->new; return $Test; } sub find_run_tests { my $d = 1; my $found = 0; while ((not $found) and (my ($sub) = (caller($d))[3]) ) { # print "$d: $sub\n"; $found = ($sub eq "Test::Tester::run_tests"); $d++; } # die "Didn't find 'run_tests' in caller stack" unless $found; return $d; } sub run_tests { local($Delegator->{Object}) = $Capture; $runner->run_tests(@_); return ($runner->get_premature, $runner->get_results); } sub check_test { my $test = shift; my $expect = shift; my $name = shift; $name = "" unless defined($name); @_ = ($test, [$expect], $name); goto &check_tests; } sub check_tests { my $test = shift; my $expects = shift; my $name = shift; $name = "" unless defined($name); my ($prem, @results) = eval { run_tests($test, $name) }; $Test->ok(! $@, "Test '$name' completed") || $Test->diag($@); $Test->ok(! length($prem), "Test '$name' no premature diagnostication") || $Test->diag("Before any testing anything, your tests said\n$prem"); local $Test::Builder::Level = $Test::Builder::Level + 1; cmp_results(\@results, $expects, $name); return ($prem, @results); } sub cmp_field { my ($result, $expect, $field, $desc) = @_; if (defined $expect->{$field}) { $Test->is_eq($result->{$field}, $expect->{$field}, "$desc compare $field"); } } sub cmp_result { my ($result, $expect, $name) = @_; my $sub_name = $result->{name}; $sub_name = "" unless defined($name); my $desc = "subtest '$sub_name' of '$name'"; { local $Test::Builder::Level = $Test::Builder::Level + 1; cmp_field($result, $expect, "ok", $desc); cmp_field($result, $expect, "actual_ok", $desc); cmp_field($result, $expect, "type", $desc); cmp_field($result, $expect, "reason", $desc); cmp_field($result, $expect, "name", $desc); } # if we got no depth then default to 1 my $depth = 1; if (exists $expect->{depth}) { $depth = $expect->{depth}; } # if depth was explicitly undef then don't test it if (defined $depth) { $Test->is_eq($result->{depth}, $depth, "checking depth") || $Test->diag('You need to change $Test::Builder::Level'); } if (defined(my $exp = $expect->{diag})) { # if there actually is some diag then put a \n on the end if it's not # there already $exp .= "\n" if (length($exp) and $exp !~ /\n$/); if (not $Test->ok($result->{diag} eq $exp, "subtest '$sub_name' of '$name' compare diag") ) { my $got = $result->{diag}; my $glen = length($got); my $elen = length($exp); for ($got, $exp) { my @lines = split("\n", $_); $_ = join("\n", map { if ($want_space) { $_ = $colour.escape($_).$reset; } else { "'$colour$_$reset'" } } @lines); } $Test->diag(<32 and $c<125) or $c == 10) { $res .= $char; } else { $res .= sprintf('\x{%x}', $c) } } return $res; } sub cmp_results { my ($results, $expects, $name) = @_; $Test->is_num(scalar @$results, scalar @$expects, "Test '$name' result count"); for (my $i = 0; $i < @$expects; $i++) { my $expect = $expects->[$i]; my $result = $results->[$i]; local $Test::Builder::Level = $Test::Builder::Level + 1; cmp_result($result, $expect, $name); } } ######## nicked from Test::More sub plan { my(@plan) = @_; my $caller = caller; $Test->exported_to($caller); my @imports = (); foreach my $idx (0..$#plan) { if( $plan[$idx] eq 'import' ) { my($tag, $imports) = splice @plan, $idx, 2; @imports = @$imports; last; } } $Test->plan(@plan); __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports); } sub import { my($class) = shift; { no warnings 'redefine'; *Test::Builder::new = \&new_new; } goto &plan; } sub _export_to_level { my $pkg = shift; my $level = shift; (undef) = shift; # redundant arg my $callpkg = caller($level); $pkg->export($callpkg, @_); } ############ 1; __END__ =head1 NAME Test::Tester - Ease testing test modules built with Test::Builder =head1 SYNOPSIS use Test::Tester tests => 6; use Test::MyStyle; check_test( sub { is_mystyle_eq("this", "that", "not eq"); }, { ok => 0, # expect this to fail name => "not eq", diag => "Expected: 'this'\nGot: 'that'", } ); or use Test::Tester; use Test::More tests => 3; use Test::MyStyle; my ($premature, @results) = run_tests( sub { is_database_alive("dbname"); } ); # now use Test::More::like to check the diagnostic output like($results[0]->{diag}, "/^Database ping took \\d+ seconds$"/, "diag"); =head1 DESCRIPTION If you have written a test module based on Test::Builder then Test::Tester allows you to test it with the minimum of effort. =head1 HOW TO USE (THE EASY WAY) From version 0.08 Test::Tester no longer requires you to included anything special in your test modules. All you need to do is use Test::Tester; in your test script B any other Test::Builder based modules and away you go. Other modules based on Test::Builder can be used to help with the testing. In fact you can even use functions from your module to test other functions from the same module (while this is possible it is probably not a good idea, if your module has bugs, then using it to test itself may give the wrong answers). The easiest way to test is to do something like check_test( sub { is_mystyle_eq("this", "that", "not eq") }, { ok => 0, # we expect the test to fail name => "not eq", diag => "Expected: 'this'\nGot: 'that'", } ); this will execute the is_mystyle_eq test, capturing it's results and checking that they are what was expected. You may need to examine the test results in a more flexible way, for example, the diagnostic output may be quite long or complex or it may involve something that you cannot predict in advance like a timestamp. In this case you can get direct access to the test results: my ($premature, @results) = run_tests( sub { is_database_alive("dbname"); } ); like($result[0]->{diag}, "/^Database ping took \\d+ seconds$"/, "diag"); We cannot predict how long the database ping will take so we use Test::More's like() test to check that the diagnostic string is of the right form. =head1 HOW TO USE (THE HARD WAY) I Make your module use the Test::Tester::Capture object instead of the Test::Builder one. How to do this depends on your module but assuming that your module holds the Test::Builder object in $Test and that all your test routines access it through $Test then providing a function something like this sub set_builder { $Test = shift; } should allow your test scripts to do Test::YourModule::set_builder(Test::Tester->capture); and after that any tests inside your module will captured. =head1 TEST RESULTS The result of each test is captured in a hash. These hashes are the same as the hashes returned by Test::Builder->details but with a couple of extra fields. These fields are documented in L in the details() function =over 2 =item ok Did the test pass? =item actual_ok Did the test really pass? That is, did the pass come from Test::Builder->ok() or did it pass because it was a TODO test? =item name The name supplied for the test. =item type What kind of test? Possibilities include, skip, todo etc. See L for more details. =item reason The reason for the skip, todo etc. See L for more details. =back These fields are exclusive to Test::Tester. =over 2 =item diag Any diagnostics that were output for the test. This only includes diagnostics output B the test result is declared. Note that Test::Builder ensures that any diagnostics end in a \n and it in earlier versions of Test::Tester it was essential that you have the final \n in your expected diagnostics. From version 0.10 onwards, Test::Tester will add the \n if you forgot it. It will not add a \n if you are expecting no diagnostics. See below for help tracking down hard to find space and tab related problems. =item depth This allows you to check that your test module is setting the correct value for $Test::Builder::Level and thus giving the correct file and line number when a test fails. It is calculated by looking at caller() and $Test::Builder::Level. It should count how many subroutines there are before jumping into the function you are testing. So for example in run_tests( sub { my_test_function("a", "b") } ); the depth should be 1 and in sub deeper { my_test_function("a", "b") } run_tests(sub { deeper() }); depth should be 2, that is 1 for the sub {} and one for deeper(). This might seem a little complex but if your tests look like the simple examples in this doc then you don't need to worry as the depth will always be 1 and that's what Test::Tester expects by default. B: if you do not specify a value for depth in check_test() then it automatically compares it against 1, if you really want to skip the depth test then pass in undef. B: depth will not be correctly calculated for tests that run from a signal handler or an END block or anywhere else that hides the call stack. =back Some of Test::Tester's functions return arrays of these hashes, just like Test::Builder->details. That is, the hash for the first test will be array element 1 (not 0). Element 0 will not be a hash it will be a string which contains any diagnostic output that came before the first test. This should usually be empty, if it's not, it means something output diagnostics before any test results showed up. =head1 SPACES AND TABS Appearances can be deceptive, especially when it comes to emptiness. If you are scratching your head trying to work out why Test::Tester is saying that your diagnostics are wrong when they look perfectly right then the answer is probably whitespace. From version 0.10 on, Test::Tester surrounds the expected and got diag values with single quotes to make it easier to spot trailing whitesapce. So in this example # Got diag (5 bytes): # 'abcd ' # Expected diag (4 bytes): # 'abcd' it is quite clear that there is a space at the end of the first string. Another way to solve this problem is to use colour and inverse video on an ANSI terminal, see below COLOUR below if you want this. Unfortunately this is sometimes not enough, neither colour nor quotes will help you with problems involving tabs, other non-printing characters and certain kinds of problems inherent in Unicode. To deal with this, you can switch Test::Tester into a mode whereby all "tricky" characters are shown as \{xx}. Tricky characters are those with ASCII code less than 33 or higher than 126. This makes the output more difficult to read but much easier to find subtle differences between strings. To turn on this mode either call show_space() in your test script or set the TESTTESTERSPACE environment variable to be a true value. The example above would then look like # Got diag (5 bytes): # abcd\x{20} # Expected diag (4 bytes): # abcd =head1 COLOUR If you prefer to use colour as a means of finding tricky whitespace characters then you can set the TESTTESTCOLOUR environment variable to a comma separated pair of colours, the first for the foreground, the second for the background. For example "white,red" will print white text on a red background. This requires the Term::ANSIColor module. You can specify any colour that would be acceptable to the Term::ANSIColor::color function. If you spell colour differently, that's no problem. The TESTTESTERCOLOR variable also works (if both are set then the British spelling wins out). =head1 EXPORTED FUNCTIONS =head3 ($premature, @results) = run_tests(\&test_sub) \&test_sub is a reference to a subroutine. run_tests runs the subroutine in $test_sub and captures the results of any tests inside it. You can run more than 1 test inside this subroutine if you like. $premature is a string containing any diagnostic output from before the first test. @results is an array of test result hashes. =head3 cmp_result(\%result, \%expect, $name) \%result is a ref to a test result hash. \%expect is a ref to a hash of expected values for the test result. cmp_result compares the result with the expected values. If any differences are found it outputs diagnostics. You may leave out any field from the expected result and cmp_result will not do the comparison of that field. =head3 cmp_results(\@results, \@expects, $name) \@results is a ref to an array of test results. \@expects is a ref to an array of hash refs. cmp_results checks that the results match the expected results and if any differences are found it outputs diagnostics. It first checks that the number of elements in \@results and \@expects is the same. Then it goes through each result checking it against the expected result as in cmp_result() above. =head3 ($premature, @results) = check_tests(\&test_sub, \@expects, $name) \&test_sub is a reference to a subroutine. \@expect is a ref to an array of hash refs which are expected test results. check_tests combines run_tests and cmp_tests into a single call. It also checks if the tests died at any stage. It returns the same values as run_tests, so you can further examine the test results if you need to. =head3 ($premature, @results) = check_test(\&test_sub, \%expect, $name) \&test_sub is a reference to a subroutine. \%expect is a ref to an hash of expected values for the test result. check_test is a wrapper around check_tests. It combines run_tests and cmp_tests into a single call, checking if the test died. It assumes that only a single test is run inside \&test_sub and include a test to make sure this is true. It returns the same values as run_tests, so you can further examine the test results if you need to. =head3 show_space() Turn on the escaping of characters as described in the SPACES AND TABS section. =head1 HOW IT WORKS Normally, a test module (let's call it Test:MyStyle) calls Test::Builder->new to get the Test::Builder object. Test::MyStyle calls methods on this object to record information about test results. When Test::Tester is loaded, it replaces Test::Builder's new() method with one which returns a Test::Tester::Delegate object. Most of the time this object behaves as the real Test::Builder object. Any methods that are called are delegated to the real Test::Builder object so everything works perfectly. However once we go into test mode, the method calls are no longer passed to the real Test::Builder object, instead they go to the Test::Tester::Capture object. This object seems exactly like the real Test::Builder object, except, instead of outputting test results and diagnostics, it just records all the information for later analysis. =head1 CAVEATS Support for calling Test::Builder->note is minimal. It's implemented as an empty stub, so modules that use it will not crash but the calls are not recorded for testing purposes like the others. Patches welcome. =head1 SEE ALSO L the source of testing goodness. L for an alternative approach to the problem tackled by Test::Tester - captures the strings output by Test::Builder. This means you cannot get separate access to the individual pieces of information and you must predict B what your test will output. =head1 AUTHOR This module is copyright 2005 Fergal Daly , some parts are based on other people's work. Plan handling lifted from Test::More. written by Michael G Schwern . Test::Tester::Capture is a cut down and hacked up version of Test::Builder. Test::Builder was written by chromatic and Michael G Schwern . =head1 LICENSE Under the same license as Perl itself See http://www.perl.com/perl/misc/Artistic.html =cut Test-Simple-1.001014/lib/Test/Builder.pm0000644000175000017500000017274012450027606017454 0ustar exodistexodistpackage Test::Builder; use 5.006; use strict; use warnings; our $VERSION = '1.001014'; $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 # occasionally 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 L and L have proven to be popular testing modules, but they're not always flexible enough. Test::Builder provides a building block upon which to write your own test libraries I. =head2 Construction =over 4 =item B 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 always returns the same Test::Builder object. No matter how many times you call C, 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. =cut our $Test = Test::Builder->new; sub new { my($class) = shift; $Test ||= $class->create; return $Test; } =item B 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 if you're testing a Test::Builder based module, but otherwise you probably want C. B: the implementation is not complete. C, for example, is still shared amongst B 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; } # Copy an object, currently a shallow. # This does *not* bless the destination. This keeps the destructor from # firing when we're just storing a copy of the object to restore later. sub _copy { my($src, $dest) = @_; %$dest = %$src; _share_keys($dest); return; } =item B my $child = $builder->child($name_of_child); $child->plan( tests => 4 ); $child->ok(some_code()); ... $child->finalize; Returns a new instance of C. Any output from this child will be indented four spaces more than the parent's indentation. When done, the C method I be called explicitly. Trying to create a new child with a previous child still active (i.e., C not called) will C. Trying to run a test when you have an open child will also C and cause the test suite to fail. =cut sub child { my( $self, $name ) = @_; if( $self->{Child_Name} ) { $self->croak("You already have a child named ($self->{Child_Name}) running"); } my $parent_in_todo = $self->in_todo; # Clear $TODO for the child. my $orig_TODO = $self->find_TODO(undef, 1, undef); my $class = ref $self; my $child = $class->create; # Add to our indentation $child->_indent( $self->_indent . ' ' ); # Make the child use the same outputs as the parent for my $method (qw(output failure_output todo_output)) { $child->$method( $self->$method ); } # Ensure the child understands if they're inside a TODO if( $parent_in_todo ) { $child->failure_output( $self->todo_output ); } # This will be reset in finalize. We do this here lest one child failure # cause all children to fail. $child->{Child_Error} = $?; $? = 0; $child->{Parent} = $self; $child->{Parent_TODO} = $orig_TODO; $child->{Name} = $name || "Child of " . $self->name; $self->{Child_Name} = $child->name; return $child; } =item B $builder->subtest($name, \&subtests, @args); See documentation of C in Test::More. C also, and optionally, accepts arguments which will be passed to the subtests reference. =cut sub subtest { my $self = shift; my($name, $subtests, @args) = @_; if ('CODE' ne ref $subtests) { $self->croak("subtest()'s second argument must be a code ref"); } # Turn the child into the parent so anyone who has stored a copy of # the Test::Builder singleton will get the child. my $error; my $child; my $parent = {}; { # child() calls reset() which sets $Level to 1, so we localize # $Level first to limit the scope of the reset to the subtest. local $Test::Builder::Level = $Test::Builder::Level + 1; # Store the guts of $self as $parent and turn $child into $self. $child = $self->child($name); _copy($self, $parent); _copy($child, $self); my $run_the_subtests = sub { # Add subtest name for clarification of starting point $self->note("Subtest: $name"); $subtests->(@args); $self->done_testing unless $self->_plan_handled; 1; }; if( !eval { $run_the_subtests->() } ) { $error = $@; } } # Restore the parent and the copied child. _copy($self, $child); _copy($parent, $self); # Restore the parent's $TODO $self->find_TODO(undef, 1, $child->{Parent_TODO}); # Die *after* we restore the parent. die $error if $error and !eval { $error->isa('Test::Builder::Exception') }; local $Test::Builder::Level = $Test::Builder::Level + 1; my $finalize = $child->finalize; $self->BAIL_OUT($child->{Bailed_Out_Reason}) if $child->{Bailed_Out}; return $finalize; } =begin _private =item B<_plan_handled> if ( $Test->_plan_handled ) { ... } Returns true if the developer has explicitly handled the plan via: =over 4 =item * Explicitly setting the number of tests =item * Setting 'no_plan' =item * Set 'skip_all'. =back This is currently used in subtests when we implicitly call C<< $Test->done_testing >> if the developer has not set a plan. =end _private =cut sub _plan_handled { my $self = shift; return $self->{Have_Plan} || $self->{No_Plan} || $self->{Skip_All}; } =item B my $ok = $child->finalize; When your child is done running tests, you must call C to clean up and tell the parent your pass/fail status. Calling C on a child with open children will C. If the child falls out of scope before C is called, a failure diagnostic will be issued and the child is considered to have failed. No attempt to call methods on a child after C is called is guaranteed to succeed. Calling this on the root builder is a no-op. =cut sub finalize { my $self = shift; return unless $self->parent; if( $self->{Child_Name} ) { $self->croak("Can't call finalize() with child ($self->{Child_Name}) active"); } local $? = 0; # don't fail if $subtests happened to set $? nonzero $self->_ending; # XXX This will only be necessary for TAP envelopes (we think) #$self->_print( $self->is_passing ? "PASS\n" : "FAIL\n" ); local $Test::Builder::Level = $Test::Builder::Level + 1; my $ok = 1; $self->parent->{Child_Name} = undef; unless ($self->{Bailed_Out}) { if ( $self->{Skip_All} ) { $self->parent->skip($self->{Skip_All}, $self->name); } elsif ( not @{ $self->{Test_Results} } ) { $self->parent->ok( 0, sprintf q[No tests run for subtest "%s"], $self->name ); } else { $self->parent->ok( $self->is_passing, $self->name ); } } $? = $self->{Child_Error}; delete $self->{Parent}; return $self->is_passing; } sub _indent { my $self = shift; if( @_ ) { $self->{Indent} = shift; } return $self->{Indent}; } =item B if ( my $parent = $builder->parent ) { ... } Returns the parent C instance, if any. Only used with child builders for nested TAP. =cut sub parent { shift->{Parent} } =item B diag $builder->name; Returns the name of the current builder. Top level builders default to C<$0> (the name of the executable). Child builders are named via the C method. If no name is supplied, will be named "Child of $parent->name". =cut sub name { shift->{Name} } sub DESTROY { my $self = shift; if ( $self->parent and $$ == $self->{Original_Pid} ) { my $name = $self->name; $self->diag(<<"FAIL"); Child ($name) exited without calling finalize() FAIL $self->parent->{In_Destroy} = 1; $self->parent->ok(0, $name); } } =item B $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->{Name} = $0; $self->is_passing(1); $self->{Ending} = 0; $self->{Have_Plan} = 0; $self->{No_Plan} = 0; $self->{Have_Output_Plan} = 0; $self->{Done_Testing} = 0; $self->{Original_Pid} = $$; $self->{Child_Name} = undef; $self->{Indent} ||= ''; $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->_share_keys; $self->_dup_stdhandles; return; } # Shared scalar values are lost when a hash is copied, so we have # a separate method to restore them. # Shared references are retained across copies. sub _share_keys { my $self = shift; share( $self->{Curr_Test} ); 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 $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, don't call any of the other methods below. If a child calls "skip_all" in the plan, a C is thrown. Trap this error, call C and don't run any more tests on the child. my $child = $Test->child('some child'); eval { $child->plan( $condition ? ( skip_all => $reason ) : ( tests => 3 ) ) }; if ( eval { $@->isa('Test::Builder::Exception') } ) { $child->finalize; return; } # run your tests =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 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 $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 $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 was declared, this will override. If C 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 is, in effect, used when you'd want to use C, 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(scalar @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; # The wrong number of tests were run $self->is_passing(0) if $self->{Expected_Tests} != $self->{Curr_Test}; # No tests were run $self->is_passing(0) if $self->{Curr_Test} == 0; return 1; } =item B $plan = $Test->has_plan Find out whether a plan has been defined. C<$plan> is either C (no plan has been set), C (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 $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} = $self->parent ? $reason : 1; $self->_output_plan(0, "SKIP", $reason) unless $self->no_header; if ( $self->parent ) { die bless {} => 'Test::Builder::Exception'; } exit(0); } =item B 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 $Test->ok($test, $name); Your basic test. Pass if C<$test> is true, fail if $test is false. Just like Test::Simple's C. =cut sub ok { my( $self, $test, $name ) = @_; if ( $self->{Child_Name} and not $self->{In_Destroy} ) { $name = 'unnamed test' unless defined $name; $self->is_passing(0); $self->croak("Cannot run test ($name) with active children"); } # $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]); } } $self->is_passing(0) unless $test || $self->in_todo; # Check that we haven't violated the plan $self->_check_is_passing_plan(); return $test ? 1 : 0; } # Check that we haven't yet violated the plan and set # is_passing() accordingly sub _check_is_passing_plan { my $self = shift; my $plan = $self->has_plan; return unless defined $plan; # no plan yet defined return unless $plan !~ /\D/; # no numeric plan $self->is_passing(0) if $plan < $self->{Curr_Test}; } 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 $Test->is_eq($got, $expected, $name); Like Test::More's C. Checks if C<$got eq $expected>. This is the string version. C only ever matches another C. =item B $Test->is_num($got, $expected, $name); Like Test::More's C. Checks if C<$got == $expected>. This is the numeric version. C only ever matches another C. =cut sub is_eq { my( $self, $got, $expect, $name ) = @_; local $Level = $Level + 1; 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; 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 $Test->isnt_eq($got, $dont_expect, $name); Like L's C. Checks if C<$got ne $dont_expect>. This is the string version. =item B $Test->isnt_num($got, $dont_expect, $name); Like L's C. 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 $Test->like($thing, qr/$regex/, $name); $Test->like($thing, '/$regex/', $name); Like L's C. Checks if $thing matches the given C<$regex>. =item B $Test->unlike($thing, qr/$regex/, $name); $Test->unlike($thing, '/$regex/', $name); Like L's C. Checks if $thing B the given C<$regex>. =cut sub like { my( $self, $thing, $regex, $name ) = @_; local $Level = $Level + 1; return $self->_regex_ok( $thing, $regex, '=~', $name ); } sub unlike { my( $self, $thing, $regex, $name ) = @_; local $Level = $Level + 1; return $self->_regex_ok( $thing, $regex, '!~', $name ); } =item B $Test->cmp_ok($thing, $type, $that, $name); Works just like L's C. $Test->cmp_ok($big_num, '!=', $other_big_num); =cut my %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" ); # Bad, these are not comparison operators. Should we include more? my %cmp_ok_bl = map { ( $_, 1 ) } ( "=", "+=", ".=", "x=", "^=", "|=", "||=", "&&=", "..."); sub cmp_ok { my( $self, $got, $type, $expect, $name ) = @_; if ($cmp_ok_bl{$type}) { $self->croak("$type is not a valid comparison operator in cmp_ok()"); } my ($test, $succ); my $error; { ## no critic (BuiltinFunctions::ProhibitStringyEval) local( $@, $!, $SIG{__DIE__} ); # isolate eval my($pack, $file, $line) = $self->caller(); # This is so that warnings come out at the caller's level $succ = eval qq[ #line $line "(eval in cmp_ok) $file" \$test = (\$got $type \$expect); 1; ]; $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") unless $succ; 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 $Test->BAIL_OUT($reason); Indicates to the L 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; if ($self->parent) { $self->{Bailed_Out_Reason} = $reason; $self->no_ending(1); die bless {} => 'Test::Builder::Exception'; } $self->_print("Bail out! $reason"); exit 255; } =for deprecated BAIL_OUT() used to be BAILOUT() =cut { no warnings 'once'; *BAILOUT = \&BAIL_OUT; } =item B $Test->skip; $Test->skip($why); Skips the current test, reporting C<$why>. =cut sub skip { my( $self, $why, $name ) = @_; $why ||= ''; $name = '' unless defined $name; $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 => $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 $Test->todo_skip; $Test->todo_skip($why); Like C, 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 $Test->skip_rest; $Test->skip_rest($reason); Like C, only it skips all the rest of the tests you plan to run and terminates the test. If you're running under C, 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 $Test->maybe_regex(qr/$regex/); $Test->maybe_regex('/$regex/'); This method used to be useful back when Test::Builder worked on Perls before 5.6 which didn't have qr//. Now its pretty useless. Convenience method for building testing functions that take regular expressions as arguments. Takes a quoted regular expression produced by C, or a string representing a regular expression. Returns a Perl value which may be used instead of the corresponding regular expression, or C if its argument is not recognised. For example, a version of C, sans the useful diagnostic messages, could be written as: sub laconic_like { my ($self, $thing, $regex, $name) = @_; my $usable_regex = $self->maybe_regex($regex); die "expecting regex, found '$regex'\n" unless $usable_regex; $self->ok($thing =~ 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, $thing, $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; } { my $test; my $context = $self->_caller_context; { ## no critic (BuiltinFunctions::ProhibitStringyEval) local( $@, $!, $SIG{__DIE__} ); # isolate eval # No point in issuing an uninit warning, they'll see it in the diagnostics no warnings 'uninitialized'; $test = eval $context . q{$test = $thing =~ /$usable_regex/ ? 1 : 0}; } $test = !$test if $cmp eq '!~'; local $Level = $Level + 1; $ok = $self->ok( $test, $name ); } unless($ok) { $thing = defined $thing ? "'$thing'" : 'undef'; my $match = $cmp eq '=~' ? "doesn't match" : "matches"; local $Level = $Level + 1; $self->diag( sprintf <<'DIAGNOSTIC', $thing, $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 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") } || eval { tied($maybe_fh)->can('TIEHANDLE') }; } =back =head2 Test style =over 4 =item B $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 $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 $Test->no_diag($no_diag); If set true no diagnostics will be printed. This includes calls to C. =item B $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 $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 $Test->diag(@msgs); Prints out the given C<@msgs>. Like C, arguments are simply appended together. Normally, it uses the C handle, but if this is for a TODO test, the C 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 is often used in conjunction with a failing test (C) it "passes through" the failure. return ok(...) || diag(...); =for blame transfer Mark Fowler =cut sub diag { my $self = shift; $self->_print_comment( $self->_diag_fh, @_ ); } =item B $Test->note(@msgs); Like C, but it prints to the C 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 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 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; my $indent = $self->_indent; local( $\, $", $, ) = ( undef, ' ', '' ); # Escape each line after the first with a # so we don't # confuse Test::Harness. $msg =~ s{\n(?!\z)}{\n$indent# }sg; # Stick a newline on the end if it needs it. $msg .= "\n" unless $msg =~ /\n\z/; return print $fh $indent, $msg; } =item B =item B =item B 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 is where normal "ok/not ok" test output goes. Defaults to STDOUT. B is where diagnostic output on test failures and C goes. It is normally not read by Test::Harness and instead is displayed to the user. Defaults to STDERR. C is used instead of C 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); _apply_layers($dst, @src_layers) if @src_layers; } ); return; } sub _apply_layers { my ($fh, @layers) = @_; my %seen; my @unique = grep { $_ ne 'unix' and !$seen{$_}++ } @layers; binmode($fh, join(":", "", "raw", @unique)); } =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 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 my $ok = $builder->is_passing; Indicates if the test suite is currently passing. More formally, it will be false if anything has happened which makes it impossible for the test suite to pass. True otherwise. For example, if no tests have run C will be true because even though a suite with no tests is a failure you can add a passing test to it and start passing. Don't think about it too much. =cut sub is_passing { my $self = shift; if( @_ ) { $self->{Is_Passing} = shift; } return $self->{Is_Passing}; } =item B 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
my @tests = $Test->details; Like C, 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 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. 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 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. 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 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 is usually called inside a test function. As a last resort it will use C. Sometimes there is some confusion about where C 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 my $todo_reason = $Test->find_TODO(); my $todo_reason = $Test->find_TODO($pack); Like C but only returns the value of C<$TODO> ignoring C. Can also be used to set C<$TODO> to a new value while returning the old value: my $old_reason = $Test->find_TODO($pack, 1, $new_reason); =cut sub find_TODO { my( $self, $pack, $set, $new_value ) = @_; $pack = $pack || $self->caller(1) || $self->exported_to; return unless $pack; no strict 'refs'; ## no critic my $old_value = ${ $pack . '::TODO' }; $set and ${ $pack . '::TODO' } = $new_value; return $old_value; } =item B 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 $Test->todo_start(); $Test->todo_start($message); This method allows you declare all subsequent tests as TODO tests, up until the C method has been called. The C 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 $Test->todo_end; Stops running tests as "TODO" tests. This method is fatal if called without a preceding C 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 my $package = $Test->caller; my($pack, $file, $line) = $Test->caller; my($pack, $file, $line) = $Test->caller($height); Like the normal C, except it reports according to your C. C<$height> will be added to the C. If C 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. 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 block. 5.6.1 does some odd things. Instead, this function edits C<$?> directly. It should B be called from inside an C 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; return if $self->no_ending; return if $self->{Ending}++; 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->is_passing(0); $self->diag("Tests were run but no plan was declared and done_testing() was not seen."); if($real_exit_code) { $self->diag(<<"FAIL"); Looks like your test exited with $real_exit_code just after $self->{Curr_Test}. FAIL $self->is_passing(0); _my_exit($real_exit_code) && return; } # But if the tests ran, handle exit code. my $test_results = $self->{Test_Results}; if(@$test_results) { my $num_failed = grep !$_->{'ok'}, @{$test_results}[ 0 .. $self->{Curr_Test} - 1 ]; if ($num_failed > 0) { my $exit_code = $num_failed <= 254 ? $num_failed : 254; _my_exit($exit_code) && return; } } _my_exit(254) && return; } # 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} ) { $self->is_passing(0); 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 $self->is_passing(0); } 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 $self->is_passing(0); } if($real_exit_code) { $self->diag(<<"FAIL"); Looks like your test exited with $real_exit_code just after $self->{Curr_Test}. FAIL $self->is_passing(0); _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 $self->is_passing(0); _my_exit($real_exit_code) && return; } else { $self->diag("No tests run!\n"); $self->is_passing(0); _my_exit(255) && return; } $self->is_passing(0); $self->_whoa( 1, "We fell off the end of _ending()" ); } END { $Test->_ending if defined $Test; } =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 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 Test::Builder. =head1 MEMORY An informative hash, accessible via C, 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 C 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. L, L, L and L all use Test::Builder. =head1 SEE ALSO L, L, L =head1 AUTHORS Original code by chromatic, maintained by Michael G Schwern Eschwern@pobox.comE =head1 MAINTAINERS =over 4 =item Chad Granum Eexodist@cpan.orgE =back =head1 COPYRIGHT Copyright 2002-2008 by chromatic Echromatic@wgz.orgE and Michael G Schwern Eschwern@pobox.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut 1; Test-Simple-1.001014/lib/Test/Tester/0000755000175000017500000000000012450030545016757 5ustar exodistexodistTest-Simple-1.001014/lib/Test/Tester/CaptureRunner.pm0000644000175000017500000000237112450026765022126 0ustar exodistexodist# $Header: /home/fergal/my/cvs/Test-Tester/lib/Test/Tester/CaptureRunner.pm,v 1.3 2003/03/05 01:07:55 fergal Exp $ use strict; package Test::Tester::CaptureRunner; use Test::Tester::Capture; require Exporter; sub new { my $pkg = shift; my $self = bless {}, $pkg; return $self; } sub run_tests { my $self = shift; my $test = shift; capture()->reset; $self->{StartLevel} = $Test::Builder::Level; &$test(); } sub get_results { my $self = shift; my @results = capture()->details; my $start = $self->{StartLevel}; foreach my $res (@results) { next if defined $res->{depth}; my $depth = $res->{_depth} - $res->{_level} - $start - 3; # print "my $depth = $res->{_depth} - $res->{_level} - $start - 1\n"; $res->{depth} = $depth; } return @results; } sub get_premature { return capture()->premature; } sub capture { return Test::Tester::Capture->new; } __END__ =head1 NAME Test::Tester::CaptureRunner - Help testing test modules built with Test::Builder =head1 DESCRIPTION This stuff if needed to allow me to play with other ways of monitoring the test results. =head1 AUTHOR Copyright 2003 by Fergal Daly . =head1 LICENSE Under the same license as Perl itself See http://www.perl.com/perl/misc/Artistic.html =cut Test-Simple-1.001014/lib/Test/Tester/Capture.pm0000644000175000017500000001040412450026765020730 0ustar exodistexodistuse strict; package Test::Tester::Capture; use Test::Builder; use vars qw( @ISA ); @ISA = qw( Test::Builder ); # Make Test::Tester::Capture thread-safe for ithreads. BEGIN { use Config; if( $] >= 5.008 && $Config{useithreads} ) { require threads::shared; threads::shared->import; } else { *share = sub { 0 }; *lock = sub { 0 }; } } my $Curr_Test = 0; share($Curr_Test); my @Test_Results = (); share(@Test_Results); my $Prem_Diag = {diag => ""}; share($Curr_Test); sub new { # Test::Tester::Capgture::new used to just return __PACKAGE__ # because Test::Builder::new enforced it's singleton nature by # return __PACKAGE__. That has since changed, Test::Builder::new now # returns a blessed has and around version 0.78, Test::Builder::todo # started wanting to modify $self. To cope with this, we now return # a blessed hash. This is a short-term hack, the correct thing to do # is to detect which style of Test::Builder we're dealing with and # act appropriately. my $class = shift; return bless {}, $class; } 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 $Curr_Test; $Curr_Test++; my($pack, $file, $line) = $self->caller; my $todo = $self->todo($pack); my $result = {}; share($result); unless( $test ) { @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 ); } else { @$result{ 'ok', 'actual_ok' } = ( 1, $test ); } if( defined $name ) { $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness. $result->{name} = $name; } else { $result->{name} = ''; } if( $todo ) { my $what_todo = $todo; $result->{reason} = $what_todo; $result->{type} = 'todo'; } else { $result->{reason} = ''; $result->{type} = ''; } $Test_Results[$Curr_Test-1] = $result; unless( $test ) { my $msg = $todo ? "Failed (TODO)" : "Failed"; $result->{fail_diag} = (" $msg test ($file at line $line)\n"); } $result->{diag} = ""; $result->{_level} = $Test::Builder::Level; $result->{_depth} = Test::Tester::find_run_tests(); return $test ? 1 : 0; } sub skip { my($self, $why) = @_; $why ||= ''; lock($Curr_Test); $Curr_Test++; my %result; share(%result); %result = ( 'ok' => 1, actual_ok => 1, name => '', type => 'skip', reason => $why, diag => "", _level => $Test::Builder::Level, _depth => Test::Tester::find_run_tests(), ); $Test_Results[$Curr_Test-1] = \%result; return 1; } sub todo_skip { my($self, $why) = @_; $why ||= ''; lock($Curr_Test); $Curr_Test++; my %result; share(%result); %result = ( 'ok' => 1, actual_ok => 0, name => '', type => 'todo_skip', reason => $why, diag => "", _level => $Test::Builder::Level, _depth => Test::Tester::find_run_tests(), ); $Test_Results[$Curr_Test-1] = \%result; return 1; } sub diag { my($self, @msgs) = @_; return unless @msgs; # Prevent printing headers when compiling (i.e. -c) return if $^C; # Escape each line with a #. foreach (@msgs) { $_ = 'undef' unless defined; } push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/; my $result = $Curr_Test ? $Test_Results[$Curr_Test - 1] : $Prem_Diag; $result->{diag} .= join("", @msgs); return 0; } sub details { return @Test_Results; } # Stub. Feel free to send me a patch to implement this. sub note { } sub explain { return Test::Builder::explain(@_); } sub premature { return $Prem_Diag->{diag}; } sub current_test { if (@_ > 1) { die "Don't try to change the test number!"; } else { return $Curr_Test; } } sub reset { $Curr_Test = 0; @Test_Results = (); $Prem_Diag = {diag => ""}; } 1; __END__ =head1 NAME Test::Tester::Capture - Help testing test modules built with Test::Builder =head1 DESCRIPTION This is a subclass of Test::Builder that overrides many of the methods so that they don't output anything. It also keeps track of it's own set of test results so that you can use Test::Builder based modules to perform tests on other Test::Builder based modules. =head1 AUTHOR Most of the code here was lifted straight from Test::Builder and then had chunks removed by Fergal Daly . =head1 LICENSE Under the same license as Perl itself See http://www.perl.com/perl/misc/Artistic.html =cut Test-Simple-1.001014/lib/Test/Tester/Delegate.pm0000644000175000017500000000056412450026765021045 0ustar exodistexodistuse strict; use warnings; package Test::Tester::Delegate; use vars '$AUTOLOAD'; sub new { my $pkg = shift; my $obj = shift; my $self = bless {}, $pkg; return $self; } sub AUTOLOAD { my ($sub) = $AUTOLOAD =~ /.*::(.*?)$/; return if $sub eq "DESTROY"; my $obj = $_[0]->{Object}; my $ref = $obj->can($sub); shift(@_); unshift(@_, $obj); goto &$ref; } 1; Test-Simple-1.001014/lib/Test/More.pm0000644000175000017500000014334312450030211016747 0ustar exodistexodistpackage 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 C 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 = '1.001014'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) use Test::Builder::Module 0.99; 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 subtest 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() 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 If you're just getting started writing tests, have a look at L 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 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 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 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 C 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($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 C, 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($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), 'all items defined' ); (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 strongly encourage its use. Should an C 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 L's C routine. =cut sub ok ($;$) { my( $test, $name ) = @_; my $tb = Test::More->builder; return $tb->ok( $test, $name ); } =item B =item B is ( $got, $expected, $test_name ); isnt( $got, $expected, $test_name ); Similar to C, C and C compare their two arguments with C and C 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" ); C will only ever match C. So you can test a value against C like this: is($not_defined, undef, "undefined as expected"); (Mnemonic: "This is that." "This isn't that.") So why use these? They produce better diagnostics on failure. C cannot know what you are testing for (beyond the name), but C and C 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 C and C over C 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 is true, it checks if it returns 1. Very different. Similar caveats exist for false and 0. In these cases, use C. ok( exists $brooklyn{tree}, 'A tree grows in Brooklyn' ); A simple call to C 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 function which is an alias of C. =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; # ' to unconfuse syntax higlighters =item B like( $got, qr/expected/, $test_name ); Similar to C, C matches $got against the regex C. So this: like($got, qr/expected/, 'this is like that'); is similar to: ok( $got =~ m/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) 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 C are similar to that of C and C. Better diagnostics on failure. =cut sub like ($$;$) { my $tb = Test::More->builder; return $tb->like(@_); } =item B unlike( $got, qr/expected/, $test_name ); Works exactly as C, only it checks if $got B match the given pattern. =cut sub unlike ($$;$) { my $tb = Test::More->builder; return $tb->unlike(@_); } =item B cmp_ok( $got, $op, $expected, $test_name ); Halfway between C and C lies C. This allows you to compare two arguments using any binary perl operator. The test passes if the comparison is true and fails otherwise. # 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 C 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 C's use of C 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($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 C 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($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( $thing, $class, $thing_name ) = @_; my $tb = Test::More->builder; my $whatami; if( !defined $thing ) { $whatami = 'undef'; } elsif( ref $thing ) { $whatami = 'reference'; local($@,$!); require Scalar::Util; if( Scalar::Util::blessed($thing) ) { $whatami = 'object'; } } else { $whatami = 'class'; } # We can't use UNIVERSAL::isa because we want to honor isa() overrides my( $rslt, $error ) = $tb->_try( sub { $thing->isa($class) } ); if($error) { die <isa on your $whatami and got some weird error. Here's the error. $error WHOA } # Special case for isa_ok( [], "ARRAY" ) and like if( $whatami eq 'reference' ) { $rslt = UNIVERSAL::isa($thing, $class); } my($diag, $name); if( defined $thing_name ) { $name = "'$thing_name' isa '$class'"; $diag = defined $thing ? "'$thing_name' isn't a '$class'" : "'$thing_name' isn't defined"; } elsif( $whatami eq 'object' ) { my $my_class = ref $thing; $thing_name = qq[An object of class '$my_class']; $name = "$thing_name isa '$class'"; $diag = "The object of class '$my_class' isn't a '$class'"; } elsif( $whatami eq 'reference' ) { my $type = ref $thing; $thing_name = qq[A reference of type '$type']; $name = "$thing_name isa '$class'"; $diag = "The reference of type '$type' isn't a '$class'"; } elsif( $whatami eq 'undef' ) { $thing_name = 'undef'; $name = "$thing_name isa '$class'"; $diag = "$thing_name isn't defined"; } elsif( $whatami eq 'class' ) { $thing_name = qq[The class (or class-like) '$thing']; $name = "$thing_name isa '$class'"; $diag = "$thing_name isn't a '$class'"; } else { die; } my $ok; if($rslt) { $ok = $tb->ok( 1, $name ); } else { $ok = $tb->ok( 0, $name ); $tb->diag(" $diag\n"); } return $ok; } =item B 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 C 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 C and it assumes C 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 ||= []; 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 { $class = 'undef' if !defined $class; $tb->ok( 0, "$class->new() died" ); $tb->diag(" Error was: $error"); } return $obj; } =item B subtest $name => \&code; C runs the &code as its own little test with its own plan and its own result. The main test counts this as a single test using the result of the whole subtest to determine if its ok or not ok. For example... use Test::More tests => 3; pass("First test"); subtest 'An example subtest' => sub { plan tests => 2; pass("This is a subtest"); pass("So is this"); }; pass("Third test"); This would produce. 1..3 ok 1 - First test # Subtest: An example subtest 1..2 ok 1 - This is a subtest ok 2 - So is this ok 2 - An example subtest ok 3 - Third test A subtest may call C. No tests will be run, but the subtest is considered a skip. subtest 'skippy' => sub { plan skip_all => 'cuz I said so'; pass('this test will never be run'); }; Returns true if the subtest passed, false otherwise. Due to how subtests work, you may omit a plan if you desire. This adds an implicit C to the end of your subtest. The following two subtests are equivalent: subtest 'subtest with implicit done_testing()', sub { ok 1, 'subtests with an implicit done testing should work'; ok 1, '... and support more than one test'; ok 1, '... no matter how many tests are run'; }; subtest 'subtest with explicit done_testing()', sub { ok 1, 'subtests with an explicit done testing should work'; ok 1, '... and support more than one test'; ok 1, '... no matter how many tests are run'; done_testing(); }; =cut sub subtest { my ($name, $subtests) = @_; my $tb = Test::More->builder; return $tb->subtest(@_); } =item B =item B 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 C. In this case, you can simply use C (to declare the test ok) or fail (for not ok). They are synonyms for C and C. 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 Sometimes you want to test if a module, or a list of modules, can successfully load. For example, you'll often want a first test which simply loads all the modules in the distribution to make sure they work before going on to do more complicated testing. For such purposes we have C and C. =over 4 =item B require_ok($module); require_ok($file); Tries to C the given $module or $file. If it loads successfully, the test will pass. Otherwise it fails and displays the load error. C will guess whether the input is a module name or a filename. No exception will be thrown if the load fails. # require Some::Module require_ok "Some::Module"; # require "Some/File.pl"; require_ok "Some/File.pl"; # stop testing if any of your modules will not load for my $module (@module) { require_ok $module or BAIL_OUT "Can't load $module"; } =cut sub require_ok ($) { my($module) = shift; my $tb = Test::More->builder; my $pack = caller; # Try to determine 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 = <ok( $eval_result, "require $module;" ); unless($ok) { chomp $eval_error; $tb->diag(< BEGIN { use_ok($module); } BEGIN { use_ok($module, @imports); } Like C, but it will C the $module in question and only loads modules, not files. If you just want to test a module can be loaded, use C. If you just want to load a module in a test, we recommend simply using C directly. It will cause the test to stop. It's recommended that you run C 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... } If you want the equivalent of C, use a module but not import anything, use C. BEGIN { require_ok "Foo" } =cut sub use_ok ($;@) { my( $module, @imports ) = @_; @imports = () unless @imports; my $tb = Test::More->builder; my( $pack, $filename, $line ) = caller; $filename =~ y/\n\r/_/; # so it doesn't run off the "#line $line $f" line 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 = <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(< I'm not quite sure what will happen with filehandles. =over 4 =item B is_deeply( $got, $expected, $test_name ); Similar to C, 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. C 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". C 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 and L 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(Regexp ARRAY HASH REF SCALAR GLOB CODE)) { 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. =over 4 =item B diag(@diagnostic_message); Prints a diagnostic message which is guaranteed not to interfere with test output. Like C @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 with the mnemonic C. B The exact formatting of the diagnostic output is still changing, but it is guaranteed that whatever you throw at it won't interfere with the test. =item B note(@diagnostic_message); Like C, 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 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 or C. 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 C 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. 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: { 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. 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 $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, 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: { 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". L 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. =item B 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 with and using C. 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 except the tests will be marked as failing but todo. L 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, use SKIP. This includes optional modules that aren't installed, running under an OS that doesn't have some feature (like C or symlinks), or maybe you need an Internet connection and one isn't available. B, 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($reason); Indicates to the harness that things are going so badly all testing should terminate. This includes the running of 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. =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 C 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 C. ok( eq_array(\@got, \@expected) ); C can do that better and with diagnostics. is_deeply( \@got, \@expected ); They may be deprecated in future versions. =over 4 =item B 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->[$_]; next if _equal_nonrefs($e1, $e2); 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 _equal_nonrefs { my( $e1, $e2 ) = @_; return if ref $e1 or ref $e2; if ( defined $e1 ) { return 1 if defined $e2 and $e1 eq $e2; } else { return 1 if !defined $e2; } return; } 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; { $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 undefined. $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 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; next if _equal_nonrefs($e1, $e2); 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 my $is_eq = eq_set(\@got, \@expected); Similar to C, except the order of the elements is B 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 By historical accident, this is not a true set comparison. While the order of elements does not matter, duplicate elements do. B C 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 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 L which provides a single, unified backend for any test library to use. This means two test libraries which both use B 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 L object like so: =over 4 =item B my $test_builder = Test::More->builder; Returns the L object underlying Test::More for you to play with. =back =head1 EXIT CODES If all your tests passed, L 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 L 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 This behavior may go away in future versions. =head1 COMPATIBILITY Test::More works with Perls as old as 5.8.1. Thread support is not very reliable before 5.10.1, but that's because threads are not very reliable before 5.10.1. Although Test::More has been a core module in versions of Perl since 5.6.2, Test::More has evolved since then, and not all of the features you're used to will be present in the shipped version of Test::More. If you are writing a module, don't forget to indicate in your package metadata the minimum version of Test::More that you require. For instance, if you want to use C but want your test script to run on Perl 5.10.0, you will need to explicitly require Test::More > 0.88. Key feature milestones include: =over 4 =item subtests Subtests were released in Test::More 0.94, which came with Perl 5.12.0. Subtests did not implicitly call C until 0.96; the first Perl with that fix was Perl 5.14.0 with 0.98. =item C This was released in Test::More 0.88 and first shipped with Perl in 5.10.1 as part of Test::More 0.92. =item C Although C was introduced in 0.40, 0.86 fixed an important bug to make it safe for overloaded objects; the fixed first shipped with Perl in 5.10.1 as part of Test::More 0.92. =item C C and C These were was released in Test::More 0.82, and first shipped with Perl in 5.10.1 as part of Test::More 0.92. =back There is a full version history in the Changes file, and the Test::More versions included as core can be found using L: $ corelist -a Test::More =head1 CAVEATS and NOTES =over 4 =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. L (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. One work around is to apply encodings to STDOUT and STDERR as early as possible and before Test::More (or any other Test module) loads. use open ':std', ':encoding(utf8)'; use Test::More; A more direct work around is to change the filehandles used by L. my $builder = Test::More->builder; binmode $builder->output, ":encoding(utf8)"; binmode $builder->failure_output, ":encoding(utf8)"; binmode $builder->todo_output, ":encoding(utf8)"; =item Overloaded objects String overloaded objects are compared B (or in C'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 C cannot be used to test the internals of string overloaded objects. In this case I would suggest L which contains more flexible testing functions for complex data structures. =item Threads Test::More will only be aware of threads if C has been done I 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. =back =head1 HISTORY This is a case of convergent evolution with Joshua Pritikin's L module. I was largely unaware of its existence when I'd first written my own C 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 =head2 =head2 ALTERNATIVES L 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 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. =head2 TESTING FRAMEWORKS L The Fennec framework is a testers toolbox. It uses L under the hood. It brings enhancements for forking, defining state, and mocking. Fennec enhances several modules to work better together than they would if you loaded them individually on your own. L Provides enhanced (L) syntax for Fennec. =head2 ADDITIONAL LIBRARIES L for more ways to test complex data structures. And it plays well with Test::More. L is like xUnit but more perlish. L gives you more powerful complex data structure testing. L shows the idea of embedded testing. L The ultimate mocking library. Easily spawn objects defined on the fly. Can also override, block, or reimplement packages as needed. L Quickly define fixture data for unit tests. =head2 OTHER COMPONENTS L is the test runner and output interpreter for Perl. It's the thing that powers C and where the C utility comes from. =head2 BUNDLES L installs a whole bunch of useful test modules. L Most commonly needed test functions and features. =head1 AUTHORS Michael G Schwern Eschwern@pobox.comE 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 MAINTAINERS =over 4 =item Chad Granum Eexodist@cpan.orgE =back =head1 BUGS See F to report and view bugs. =head1 SOURCE The source code repository for Test::More can be found at F. =head1 COPYRIGHT Copyright 2001-2008 by Michael G Schwern Eschwern@pobox.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut 1; Test-Simple-1.001014/lib/Test/Builder/0000755000175000017500000000000012450030545017077 5ustar exodistexodistTest-Simple-1.001014/lib/Test/Builder/Module.pm0000644000175000017500000000746612450027622020701 0ustar exodistexodistpackage Test::Builder::Module; use strict; use Test::Builder 1.00; require Exporter; our @ISA = qw(Exporter); our $VERSION = '1.001014'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) =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 L-based modules. It provides a handful of common functionality and a method of getting at the underlying L object. =head2 Importing Test::Builder::Module is a subclass of L 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 C method which acts in the same basic way as L's, setting the plan and controlling exporting of functions and variables. This allows your module to set the plan independent of L. All arguments passed to C 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 C and C as well as set the plan to be 23 tests. C also sets the C attribute of your builder to be the caller of the C function. Additional behaviors can be added to your C method by overriding C. =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); C is called by C. 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 C should be stripped off by this method. See L for an example of its use. B This mechanism is I 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 L 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 L object. You should I get it via C<< Test::Builder->new >> as was previously recommended. The object returned by C may change at runtime so you should call C 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; Test-Simple-1.001014/lib/Test/Builder/Tester.pm0000644000175000017500000003712212450027633020714 0ustar exodistexodistpackage Test::Builder::Tester; use strict; our $VERSION = "1.28"; use Test::Builder 0.99; 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 L. 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 and C in advance to declare what the testsuite you are testing will output with L to stdout and stderr. You then can run the test(s) from your test suite that call L. At this point the output of L is safely captured by L rather than being interpreted as real test output. The final stage is to call C that will simply compare what you predeclared to what L 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); 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; my $original_is_passing; # remembering where the file handles were originally connected my $original_output_handle; my $original_failure_handle; my $original_todo_handle; 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($output_handle); # clear the expected list $out->reset(); $err->reset(); # remember that we're testing $testing = 1; $testing_num = $t->current_test; $t->current_test(0); $original_is_passing = $t->is_passing; $t->is_passing(1); # look, we shouldn't do the ending stuff $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 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 or C (or C or C) have been called, all further output from L will be captured by L. This means that you will not be able perform further tests to the normal output in the normal way until you call C (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 L produces whenever a test fails will be a common occurrence in your test error output, and because it has changed between Test::Builder versions, rather than forcing you to call C with the string all the time like so test_err("# Failed test ($0 at line ".line_num(+1).")"); C 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 ($filename at line $line)"); } =item test_diag As most of the remaining expected output to the error stream will be created by L's C function, L provides a convenience function C that you can use instead of C. The C 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 L'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) that we have captured from L against what was declared with C and C. 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 or C. =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. =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. =back As a convenience, 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 has been run test output will be redirected back to the original filehandles that L was connected to (probably STDOUT and STDERR,) meaning any further tests you run will function normally and cause success/errors for L. =cut sub test_test { # decode the arguments 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; $t->is_passing($original_is_passing); # re-enable the original setting of the harness $ENV{HARNESS_ACTIVE} = $original_harness_env; # check the output we've stashed unless( $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 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 exists one function that can only be accessed with a fully qualified function call. =over 4 =item color When C is called and the output that your tests generate does not match that which you declared, C 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 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 C can colour the background of the debug information to disambiguate the different types of output. The debug output will have its 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 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 L module like so: perl -Mlib=Text::Builder::Tester::Color test.t Or by including the L 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 L is compatible with your terminal. Bugs (and requests for new features) can be reported to the author though the CPAN RT system: L =head1 AUTHOR Copyright Mark Fowler Emark@twoshortplanks.comE 2002, 2004. Some code taken from L and L, written by Michael G Schwern Eschwern@pobox.comE. 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 MAINTAINERS =over 4 =item Chad Granum Eexodist@cpan.orgE =back =head1 NOTES Thanks to Richard Clamp Erichardc@unixbeard.netE for letting me use his testing system to try this module out on. =head1 SEE ALSO L, L, L. =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->_account_for_subtest($check); $check = $self->_translate_Failed_check($check); push @{ $self->{wanted} }, ref $check ? $check : "$check\n"; } } sub _account_for_subtest { my( $self, $check ) = @_; # Since we ship with Test::Builder, calling a private method is safe...ish. return ref($check) ? $check : $t->_indent . $check; } 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 '', @{ $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; Test-Simple-1.001014/lib/Test/Builder/IO/0000755000175000017500000000000012450030544017405 5ustar exodistexodistTest-Simple-1.001014/lib/Test/Builder/IO/Scalar.pm0000644000175000017500000003246312450027645021170 0ustar exodistexodistpackage Test::Builder::IO::Scalar; =head1 NAME Test::Builder::IO::Scalar - A copy of IO::Scalar for Test::Builder =head1 DESCRIPTION This is a copy of L which ships with L to support scalar references as filehandles on Perl 5.6. Newer versions of Perl simply use C's built in support. L can not have dependencies on other modules without careful consideration, so its simply been copied into the distribution. =head1 COPYRIGHT and LICENSE This file came from the "IO-stringy" Perl5 toolkit. Copyright (c) 1996 by Eryq. All rights reserved. Copyright (c) 1999,2001 by ZeeGee Software Inc. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut # This is copied code, I don't care. ##no critic use Carp; use strict; use vars qw($VERSION @ISA); use IO::Handle; use 5.005; ### The package version, both in 1.23 style *and* usable by MakeMaker: $VERSION = "2.113"; ### Inheritance: @ISA = qw(IO::Handle); #============================== =head2 Construction =over 4 =cut #------------------------------ =item new [ARGS...] I Return a new, unattached scalar handle. If any arguments are given, they're sent to open(). =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = bless \do { local *FH }, $class; tie *$self, $class, $self; $self->open(@_); ### open on anonymous by default $self; } sub DESTROY { shift->close; } #------------------------------ =item open [SCALARREF] I Open the scalar handle on a new scalar, pointed to by SCALARREF. If no SCALARREF is given, a "private" scalar is created to hold the file data. Returns the self object on success, undefined on error. =cut sub open { my ($self, $sref) = @_; ### Sanity: defined($sref) or do {my $s = ''; $sref = \$s}; (ref($sref) eq "SCALAR") or croak "open() needs a ref to a scalar"; ### Setup: *$self->{Pos} = 0; ### seek position *$self->{SR} = $sref; ### scalar reference $self; } #------------------------------ =item opened I Is the scalar handle opened on something? =cut sub opened { *{shift()}->{SR}; } #------------------------------ =item close I Disassociate the scalar handle from its underlying scalar. Done automatically on destroy. =cut sub close { my $self = shift; %{*$self} = (); 1; } =back =cut #============================== =head2 Input and output =over 4 =cut #------------------------------ =item flush I No-op, provided for OO compatibility. =cut sub flush { "0 but true" } #------------------------------ =item getc I Return the next character, or undef if none remain. =cut sub getc { my $self = shift; ### Return undef right away if at EOF; else, move pos forward: return undef if $self->eof; substr(${*$self->{SR}}, *$self->{Pos}++, 1); } #------------------------------ =item getline I Return the next line, or undef on end of string. Can safely be called in an array context. Currently, lines are delimited by "\n". =cut sub getline { my $self = shift; ### Return undef right away if at EOF: return undef if $self->eof; ### Get next line: my $sr = *$self->{SR}; my $i = *$self->{Pos}; ### Start matching at this point. ### Minimal impact implementation! ### We do the fast fast thing (no regexps) if using the ### classic input record separator. ### Case 1: $/ is undef: slurp all... if (!defined($/)) { *$self->{Pos} = length $$sr; return substr($$sr, $i); } ### Case 2: $/ is "\n": zoom zoom zoom... elsif ($/ eq "\012") { ### Seek ahead for "\n"... yes, this really is faster than regexps. my $len = length($$sr); for (; $i < $len; ++$i) { last if ord (substr ($$sr, $i, 1)) == 10; } ### Extract the line: my $line; if ($i < $len) { ### We found a "\n": $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos} + 1); *$self->{Pos} = $i+1; ### Remember where we finished up. } else { ### No "\n"; slurp the remainder: $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos}); *$self->{Pos} = $len; } return $line; } ### Case 3: $/ is ref to int. Do fixed-size records. ### (Thanks to Dominique Quatravaux.) elsif (ref($/)) { my $len = length($$sr); my $i = ${$/} + 0; my $line = substr ($$sr, *$self->{Pos}, $i); *$self->{Pos} += $i; *$self->{Pos} = $len if (*$self->{Pos} > $len); return $line; } ### Case 4: $/ is either "" (paragraphs) or something weird... ### This is Graham's general-purpose stuff, which might be ### a tad slower than Case 2 for typical data, because ### of the regexps. else { pos($$sr) = $i; ### If in paragraph mode, skip leading lines (and update i!): length($/) or (($$sr =~ m/\G\n*/g) and ($i = pos($$sr))); ### If we see the separator in the buffer ahead... if (length($/) ? $$sr =~ m,\Q$/\E,g ### (ordinary sep) TBD: precomp! : $$sr =~ m,\n\n,g ### (a paragraph) ) { *$self->{Pos} = pos $$sr; return substr($$sr, $i, *$self->{Pos}-$i); } ### Else if no separator remains, just slurp the rest: else { *$self->{Pos} = length $$sr; return substr($$sr, $i); } } } #------------------------------ =item getlines I Get all remaining lines. It will croak() if accidentally called in a scalar context. =cut sub getlines { my $self = shift; wantarray or croak("can't call getlines in scalar context!"); my ($line, @lines); push @lines, $line while (defined($line = $self->getline)); @lines; } #------------------------------ =item print ARGS... I Print ARGS to the underlying scalar. B this continues to always cause a seek to the end of the string, but if you perform seek()s and tell()s, it is still safer to explicitly seek-to-end before subsequent print()s. =cut sub print { my $self = shift; *$self->{Pos} = length(${*$self->{SR}} .= join('', @_) . (defined($\) ? $\ : "")); 1; } sub _unsafe_print { my $self = shift; my $append = join('', @_) . $\; ${*$self->{SR}} .= $append; *$self->{Pos} += length($append); 1; } sub _old_print { my $self = shift; ${*$self->{SR}} .= join('', @_) . $\; *$self->{Pos} = length(${*$self->{SR}}); 1; } #------------------------------ =item read BUF, NBYTES, [OFFSET] I Read some bytes from the scalar. Returns the number of bytes actually read, 0 on end-of-file, undef on error. =cut sub read { my $self = $_[0]; my $n = $_[2]; my $off = $_[3] || 0; my $read = substr(${*$self->{SR}}, *$self->{Pos}, $n); $n = length($read); *$self->{Pos} += $n; ($off ? substr($_[1], $off) : $_[1]) = $read; return $n; } #------------------------------ =item write BUF, NBYTES, [OFFSET] I Write some bytes to the scalar. =cut sub write { my $self = $_[0]; my $n = $_[2]; my $off = $_[3] || 0; my $data = substr($_[1], $off, $n); $n = length($data); $self->print($data); return $n; } #------------------------------ =item sysread BUF, LEN, [OFFSET] I Read some bytes from the scalar. Returns the number of bytes actually read, 0 on end-of-file, undef on error. =cut sub sysread { my $self = shift; $self->read(@_); } #------------------------------ =item syswrite BUF, NBYTES, [OFFSET] I Write some bytes to the scalar. =cut sub syswrite { my $self = shift; $self->write(@_); } =back =cut #============================== =head2 Seeking/telling and other attributes =over 4 =cut #------------------------------ =item autoflush I No-op, provided for OO compatibility. =cut sub autoflush {} #------------------------------ =item binmode I No-op, provided for OO compatibility. =cut sub binmode {} #------------------------------ =item clearerr I Clear the error and EOF flags. A no-op. =cut sub clearerr { 1 } #------------------------------ =item eof I Are we at end of file? =cut sub eof { my $self = shift; (*$self->{Pos} >= length(${*$self->{SR}})); } #------------------------------ =item seek OFFSET, WHENCE I Seek to a given position in the stream. =cut sub seek { my ($self, $pos, $whence) = @_; my $eofpos = length(${*$self->{SR}}); ### Seek: if ($whence == 0) { *$self->{Pos} = $pos } ### SEEK_SET elsif ($whence == 1) { *$self->{Pos} += $pos } ### SEEK_CUR elsif ($whence == 2) { *$self->{Pos} = $eofpos + $pos} ### SEEK_END else { croak "bad seek whence ($whence)" } ### Fixup: if (*$self->{Pos} < 0) { *$self->{Pos} = 0 } if (*$self->{Pos} > $eofpos) { *$self->{Pos} = $eofpos } return 1; } #------------------------------ =item sysseek OFFSET, WHENCE I Identical to C, I =cut sub sysseek { my $self = shift; $self->seek (@_); } #------------------------------ =item tell I Return the current position in the stream, as a numeric offset. =cut sub tell { *{shift()}->{Pos} } #------------------------------ =item use_RS [YESNO] I B Obey the current setting of $/, like IO::Handle does? Default is false in 1.x, but cold-welded true in 2.x and later. =cut sub use_RS { my ($self, $yesno) = @_; carp "use_RS is deprecated and ignored; \$/ is always consulted\n"; } #------------------------------ =item setpos POS I Set the current position, using the opaque value returned by C. =cut sub setpos { shift->seek($_[0],0) } #------------------------------ =item getpos I Return the current position in the string, as an opaque object. =cut *getpos = \&tell; #------------------------------ =item sref I Return a reference to the underlying scalar. =cut sub sref { *{shift()}->{SR} } #------------------------------ # Tied handle methods... #------------------------------ # Conventional tiehandle interface: sub TIEHANDLE { ((defined($_[1]) && UNIVERSAL::isa($_[1], __PACKAGE__)) ? $_[1] : shift->new(@_)); } sub GETC { shift->getc(@_) } sub PRINT { shift->print(@_) } sub PRINTF { shift->print(sprintf(shift, @_)) } sub READ { shift->read(@_) } sub READLINE { wantarray ? shift->getlines(@_) : shift->getline(@_) } sub WRITE { shift->write(@_); } sub CLOSE { shift->close(@_); } sub SEEK { shift->seek(@_); } sub TELL { shift->tell(@_); } sub EOF { shift->eof(@_); } #------------------------------------------------------------ 1; __END__ =back =cut =head1 WARNINGS Perl's TIEHANDLE spec was incomplete prior to 5.005_57; it was missing support for C, C, and C. Attempting to use these functions with an IO::Scalar will not work prior to 5.005_57. IO::Scalar will not have the relevant methods invoked; and even worse, this kind of bug can lie dormant for a while. If you turn warnings on (via C<$^W> or C), and you see something like this... attempt to seek on unopened filehandle ...then you are probably trying to use one of these functions on an IO::Scalar with an old Perl. The remedy is to simply use the OO version; e.g.: $SH->seek(0,0); ### GOOD: will work on any 5.005 seek($SH,0,0); ### WARNING: will only work on 5.005_57 and beyond =head1 VERSION $Id: Scalar.pm,v 1.6 2005/02/10 21:21:53 dfs Exp $ =head1 AUTHORS =head2 Primary Maintainer David F. Skoll (F). =head2 Principal author Eryq (F). President, ZeeGee Software Inc (F). =head2 Other contributors The full set of contributors always includes the folks mentioned in L. But just the same, special thanks to the following individuals for their invaluable contributions (if I've forgotten or misspelled your name, please email me!): I for contributing C. I for suggesting C. I for finding and fixing the bug in C. I for his offset-using read() and write() implementations. I for his patches to massively improve the performance of C and add C and C. I for stringification and inheritance improvements, and sundry good ideas. I for the IO::Handle inheritance and automatic tie-ing. =head1 SEE ALSO L, which is quite similar but which was designed more-recently and with an IO::Handle-like interface in mind, so you could mix OO- and native-filehandle usage without using tied(). I as of version 2.x, these classes all work like their IO::Handle counterparts, so we have comparable functionality to IO::String. =cut Test-Simple-1.001014/lib/Test/Builder/Tester/0000755000175000017500000000000012450030545020345 5ustar exodistexodistTest-Simple-1.001014/lib/Test/Builder/Tester/Color.pm0000644000175000017500000000171512450030011021751 0ustar exodistexodistpackage Test::Builder::Tester::Color; use strict; our $VERSION = "1.290001"; 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 Emark@twoshortplanks.comE 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, L =cut 1; Test-Simple-1.001014/lib/ok.pm0000644000175000017500000000166212450027712015550 0ustar exodistexodistpackage ok; $ok::VERSION = '0.16'; use strict; use Test::More (); sub import { shift; if (@_) { goto &Test::More::pass if $_[0] eq 'ok'; goto &Test::More::use_ok; } # No argument list - croak as if we are prototyped like use_ok() my (undef, $file, $line) = caller(); ($file =~ /^\(eval/) or die "Not enough arguments for 'use ok' at $file line $line\n"; } __END__ =head1 NAME ok - Alternative to Test::More::use_ok =head1 SYNOPSIS use ok 'Some::Module'; =head1 DESCRIPTION With this module, simply change all C in test scripts to C, and they will be executed at C time. Please see L for the full description. =head1 CC0 1.0 Universal To the extent possible under law, 唐鳳 has waived all copyright and related or neighboring rights to L. This work is published from Taiwan. L =cut Test-Simple-1.001014/META.json0000664000175000017500000000253412450030545015453 0ustar exodistexodist{ "abstract" : "Basic utilities for writing tests.", "author" : [ "Michael G Schwern " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142060", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Test-Simple", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Scalar::Util" : "1.13", "Test::Harness" : "2.03", "perl" : "5.006" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "http://github.com/Test-More/test-more/issues/" }, "homepage" : "http://github.com/Test-More/test-more/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "url" : "http://github.com/Test-More/test-more/" }, "x_MailingList" : "http://lists.perl.org/list/perl-qa.html" }, "version" : "1.001014" } Test-Simple-1.001014/.perltidyrc0000644000175000017500000000130412422226065016207 0ustar exodistexodist--maximum-line-length=100 # we have widescreen now --indent-columns=4 --continuation-indentation=2 --no-opening-sub-brace-on-new-line --paren-tightness=1 --square-bracket-tightness=1 --brace-tightness=1 --no-space-for-semicolon --no-outdent-long-quotes --output-line-ending=unix --no-outdent-labels --no-blanks-before-comments --blanks-before-subs --blanks-before-blocks --maximum-consecutive-blank-lines=2 # Allow two blanks between subroutines --nospace-after-keyword="my local our and or eq ne if else elsif until unless while for foreach return switch case given when" --want-break-before="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x=" Test-Simple-1.001014/META.yml0000664000175000017500000000147412450030545015305 0ustar exodistexodist--- abstract: 'Basic utilities for writing tests.' author: - 'Michael G Schwern ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142060' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Test-Simple no_index: directory: - t - inc requires: Scalar::Util: '1.13' Test::Harness: '2.03' perl: '5.006' resources: MailingList: http://lists.perl.org/list/perl-qa.html bugtracker: http://github.com/Test-More/test-more/issues/ homepage: http://github.com/Test-More/test-more/ license: http://dev.perl.org/licenses/ repository: http://github.com/Test-More/test-more/ version: '1.001014' Test-Simple-1.001014/README0000644000175000017500000000112212450026765014711 0ustar exodistexodistThis is the README file for Test::Simple, basic utilities for writing tests, by Michael G Schwern . Maintained by Chad Granum . 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/ Test-Simple-1.001014/Changes0000644000175000017500000011270312450030204015313 0ustar exodistexodist1.001014 Tue Dec 28 08:31:00:00 PST 2015 * Write a test to ensure this changes file gets updated * Update changes file for 1.001013 1.001013 Sun Dec 28 08:00:00:00 PST 2015 * Fix a unit test that broke on some platforms with spaces in the $^X path 1.001012 Tue Dec 23 07:39:00:00 PST 2015 * Move test that was dropped in the wrong directory 1.001011 Sat Dec 20 09:08:00:00 PST 2015 * Remove POD Coverage test 1.001010 Fri Dec 19 20:16:00:00 PST 2015 * Fix windows test bug #491 * Integrate Test::Tester and Test::use::ok for easier downgrade from trial 1.001009 Sun Nov 2 22:31:08:00 PST 2014 * Fix bug in cmp_ok 1.001008 Wed Oct 15 20:10:22:00 PST 2014 * Updated Changes file 1.001007 Wed Oct 15 16:37:11:00 PST 2014 * Fix subtest name when skip_all is used 1.001006 Tue Sep 2 14:39:05:00 PST 2014 * Reverted change that is now part of alpha branch 1.001005 Tue Sep 2 19:47:19:00 JST 2014 * Changed install path for perl 5.12 or higher. 1.001004_003 Sat May 17 13:43:00 PST 2014 * Another Minor doc fix to solve test bug * Fix #399, conflict with strawberry-portable 1.001004_002 Sat May 17 13:43:00 PST 2014 * Minor doc fix to solve test bug 1.001004_001 Sat May 10 08:39:00 PST 2014 * Doc updates * Subtests accept args * Outdent subtest diag 1.001003 Fri Mar 21 21:12:32 PST 2014 * Doc updates for maintainer change 1.001002 Mon Nov 4 15:13:58 EST 2013 * no changes since 0.99 1.001001_001 Wed Oct 30 20:47:23 EDT 2013 * no code changes, just a new version number with more room to grow 0.99 Tue Oct 29 13:21:03 2013 EDT 2013 * restore ability to use regex with test_err and test_out (Zefram) [rt.cpan.org #89655] [github #389] [github #387] 0.99 Sat Oct 12 15:05:41 EDT 2013 * no changes since 0.98_06 0.98_06 Fri Sep 27 10:11:05 EDT 2013 Bug Fixes * Fix precedence error with (return ... and ...) (nthykier) [github #385] 0.98_05 Tue Apr 23 17:33:51 PDT 2013 Doc Changes * Add a shorter work around for the UTF-8 output problem. (Michael G Schwern) Bug Fixes * Test::Builder::Tester now works with subtests. (Michael G Schwern) [github 350] * Fix test_fail() inside a do statement. (nnutter) [github #369] New Features * A subtest will put its name at the front of its results to make subtests easier to read. [github #290] [github #364] (Brendan Byrd) Feature Changes * like() and unlike() no longer warn about undef. [github #335] (Michael G Schwern) 0.98_04 Sun Apr 14 10:54:13 BST 2013 Distribution Changes * Scalar::Util 1.13 (ships with Perl 5.8.1) is now required. (Michael G Schwern) Feature Changes * The default name and diagnostics for isa_ok() and new_ok() have changed. (Michael G Schwern) Docs Fixes * Added a COMPATIBILITY section so users know what major features were added with what version of Test::More or perl. [github 343] [github 344] (pdl) * Fix the ok() example with grep(). (derek.mead@gmail.com) Bug Fixes * A test with no plan and missing done_testing() now exits with non-zero. [github #341] (tokuhirom) * isa_ok() tests were broken in 5.17 because of a change in method resolution. [github #353] (Michael G Schwern) 0.98_03 Thu Jun 21 13:04:19 PDT 2012 New Features * cmp_ok() will error when used with something which is not a comparison operator, including =, += and the like. [github 141] (Matthew Horsfall) Bug Fixes * use_ok() was calling class->import without quoting which could cause problems if "class" is also a function. Doc Fixes * use_ok() has been discouraged and de-emphasized as a general replacement for `use` in tests. [github #288] * $thing is now $this in the docs to avoid confusing users of other languages. [Karen Etheridge] Incompatible Changes With Previous Alphas (0.98_01) * use_ok() will no longer apply lexical pragams. The incompatibilities and extra complexity is not worth the marginal use. [github #287] 0.98_02 Thu Nov 24 01:13:53 PST 2011 Bug Fixes * use_ok() in 0.98_01 was leaking pragmas from inside Test::More. This looked like Test::More was forcing strict. [rt.cpan.org 67538] (Father Chrysostomos) 0.98_01 Tue Nov 8 17:07:58 PST 2011 Bug Fixes * BAIL_OUT works inside a subtest. (Larry Leszczynski) [github #138] * subtests now work with threads turned on. [github #145] Feature Changes * use_ok() will now apply lexical effects. [rt.cpan.org 67538] (Father Chrysostomos) Misc * Test::More, Test::Simple and Test::Builder::Module now require a minimum version of Test::Builder. This avoids Test::More and Test::Builder from getting out of sync. [github #89] 0.98 Wed, 23 Feb 2011 14:38:02 +1100 Bug Fixes * subtest() should not fail if $? is non-zero. (Aaron Crane) Docs * The behavior of is() and undef has been documented. (Pedro Melo) 0.97_01 Fri Aug 27 22:50:30 PDT 2010 Test Fixes * Adapted the tests for the new Perl 5.14 regex stringification. (Karl Williamson) [github 44] Doc Fixes * Document how to test "use Foo ()". (Todd Rinaldo) [github 41] Feature Changes * subtest() no longer has a prototype. It was just getting in the way. [rt.cpan.org 54239] * The filehandles used by default will now inherit any filehandle disciplines from STDOUT and STDERR IF AND ONLY IF they were applied before Test::Builder is loaded. More later. [rt.cpan.org 46542] 0.96 Tue Aug 10 21:13:04 PDT 2010 Bug Fixes * You can call done_testing() again after reset() [googlecode 59] Other * Bug tracker moved to github 0.95_02 Wed May 19 15:46:52 PDT 2010 Bug Fixes * Correct various typos and spelling errors (Nick Cleaton) * Fix alignment of indented multi-line diagnostics from subtests (Nick Cleaton) * Fix incorrect operation when subtest called from within a todo block (Nick Cleaton) * Avoid spurious output after a fork within a subtest (Nick Cleaton) 0.95_01 Wed Mar 3 15:36:59 PST 2010 Bug Fixes * is_deeply() didn't see a difference in regexes [rt.cpan.org 53469] * Test::Builder::Tester now sets $tb->todo_output to the output handle and not the error handle (to be in accordance with the default behaviour of Test::Builder and allow for testing TODO test behaviour). * Fixed file/line in failing subtest() diagnostics. (Nick Cleaton) * Protect against subtests setting $Level (Nick Cleaton) New Features * subtests without a 'plan' or 'no_plan' have an implicit 'done_testing()' added to them. * is_deeply() performance boost for large structures consisting of mostly non-refs (Nick Cleaton) Feature Changes * is() and others will no longer stringify its arguments before comparing. Overloaded objects will make use of their eq overload rather than their "" overload. This can break tests of impolitely string overloaded objects. DateTime prior to 0.54 is the biggest example. 0.94 Wed Sep 2 11:17:47 PDT 2009 Releasing 0.93_01 as stable. 0.93_01 Mon Jul 20 09:51:08 PDT 2009 Bug Fixes * Make sure that subtest works with Test:: modules which call Test::Builder->new at the top of their code. (Ovid) Other * subtest() returns! 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 * Note the IO::Stringy license in our copy of it. [test-more.googlecode.com 47] Other * This is a stable release for 5.10.1. It does not include the subtest() work in 0.89_01. 0.89_01 Tue Jun 23 15:13:16 EDT 2009 New Features * subtest() allows you to run more tests in their own plan. (Thanks Ovid!) * Test::Builder->is_passing() will let you check if the test is currently passing. Docs * Finally added a note about the "Wide character in print" warning and how to work around it. 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] 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. Feature Changes - 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] Feature Changes * 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" Implemented by "Richard Foley" [rt.cpan.org 15654] * Added test_pass() to Test::Builder::Tester rather than having to call test_out("ok 1 - foo"). [rt.cpan.org 11317] * test_fail() now accepts a test diagnostic rather than having to call test_out() separately. [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(). - Fixed a minor typo in the BAIL_OUT() docs. - 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 suppressed. [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 interpreting 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 comparison. - 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 separate 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 sensible 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 Test-Simple-1.001014/Makefile.PL0000644000175000017500000000707112450026765016014 0ustar exodistexodist#!/usr/bin/perl -w use 5.006; use Config; use ExtUtils::MakeMaker; my $PACKAGE = 'Test::Simple'; ($PACKAGE_FILE = $PACKAGE) =~ s|::|/|g; my $LAST_API_CHANGE = 0.48; my $LAST_THREAD_CHANGE = 0.48; eval "require $PACKAGE"; my $PACKAGE_VERSION = ${$PACKAGE.'::VERSION'}; unless ($@) { # Make sure we did find the module. if( $PACKAGE_VERSION < $LAST_API_CHANGE ) { printf <<"CHANGE_WARN", $LAST_API_CHANGE; NOTE: There have been API changes between this version and any older than version %s! Please see the Changes file for details. CHANGE_WARN sleep 5; } if( $] >= 5.008001 && $Config{useithreads} && $PACKAGE_VERSION < $LAST_THREAD_CHANGE ) { printf <<"THREAD_WARN", $LAST_THREAD_CHANGE; NOTE: The behavior of Test::More and threads has changed between this version and any older than version %s! Please see the Changes file for details. THREAD_WARN sleep 5; } } my $mm_ver = $ExtUtils::MakeMaker::VERSION; if ($mm_ver =~ /_/) { # dev version $mm_ver = eval $mm_ver; die $@ if $@; } # Windows does not expand *.t and MakeMaker only started working around # that for TESTS in 6.27. This does not introduce a circular dep # because MakeMaker ships with its own Test::More. my %Prereqs; $Prereqs{'ExtUtils::MakeMaker'} = 6.27 if $^O eq 'MSWin32'; my $install_dir = $] >= 5.006002 && $] < 5.012000 ? 'perl' : 'site'; WriteMakefile( NAME => $PACKAGE, VERSION_FROM => "lib/$PACKAGE_FILE.pm", ABSTRACT_FROM => "lib/$PACKAGE_FILE.pm", AUTHOR => 'Michael G Schwern ', ($mm_ver >= 6.31 ? (LICENSE => 'perl') : ()), PREREQ_PM => { 'Test::Harness' => 2.03, 'Scalar::Util' => 1.13, %Prereqs }, INSTALLDIRS => $install_dir, test => { TESTS => 't/*.t t/*/*.t', }, ($mm_ver < 6.48 ? () : (MIN_PERL_VERSION => 5.006)), ($mm_ver < 6.46 ? () : (META_MERGE => { resources => { license => 'http://dev.perl.org/licenses/', homepage => 'http://github.com/Test-More/test-more/', bugtracker => 'http://github.com/Test-More/test-more/issues/', repository => 'http://github.com/Test-More/test-more/', MailingList => 'http://lists.perl.org/list/perl-qa.html', }, })) ); { package MY; sub postamble { return <<'MAKE'; perltidy: find . -name '*.pm' | xargs perltidy -b find . -name '*.pm.bak' | xargs rm MAKE } # Test with multiple versions of perl before releasing sub dist_test { my $self = shift; my $make = $self->SUPER::dist_test(@_); return $make unless $ENV{AUTHOR_TESTING} and $ENV{AUTHOR_TESTING} eq 'MSCHWERN'; # Strip off all the whitespace at the end, we'll put our own in. $make =~ s{\s+\z}{\n}; my @perls = qw( perl5.14.1 perl5.12.4 perl5.12.3 perl5.10.1 perl5.10.0 perl5.8.9 perl5.6.2 ); for my $perl (@perls) { if( !`which $perl` ) { print STDERR "Missing $perl"; next; } $make .= sprintf <<'END', $perl; cd $(DISTVNAME) && $(MAKE) clean && %s Makefile.PL && PERL_RELEASING=0 $(MAKE) test $(PASTHRU) END } # Rebuild so subsequent make commands work $make .= <<'END'; $(MAKE) realclean $(FULLPERLRUN) Makefile.PL $(MAKE) END $make .= "\n"; return $make; } } Test-Simple-1.001014/MANIFEST0000644000175000017500000000736512450030545015170 0ustar exodistexodist.perlcriticrc .perltidyrc Changes examples/indent.pl examples/subtest.t lib/ok.pm lib/Test/Builder.pm lib/Test/Builder/IO/Scalar.pm lib/Test/Builder/Module.pm lib/Test/Builder/Tester.pm lib/Test/Builder/Tester/Color.pm lib/Test/More.pm lib/Test/Simple.pm lib/Test/Tester.pm lib/Test/Tester/Capture.pm lib/Test/Tester/CaptureRunner.pm lib/Test/Tester/Delegate.pm lib/Test/Tutorial.pod lib/Test/use/ok.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP README t/00compile.t t/00test_harness_check.t t/01-basic.t t/478-cmp_ok_hash.t t/auto.t t/bad_plan.t t/bail_out.t t/BEGIN_require_ok.t t/BEGIN_use_ok.t t/buffer.t t/Builder/Builder.t t/Builder/carp.t t/Builder/create.t t/Builder/current_test.t t/Builder/current_test_without_plan.t t/Builder/details.t t/Builder/done_testing.t t/Builder/done_testing_double.t t/Builder/done_testing_plan_mismatch.t t/Builder/done_testing_with_no_plan.t t/Builder/done_testing_with_number.t t/Builder/done_testing_with_plan.t t/Builder/fork_with_new_stdout.t t/Builder/has_plan.t t/Builder/has_plan2.t t/Builder/is_fh.t t/Builder/is_passing.t t/Builder/maybe_regex.t t/Builder/no_diag.t t/Builder/no_ending.t t/Builder/no_header.t t/Builder/no_plan_at_all.t t/Builder/ok_obj.t t/Builder/output.t t/Builder/reset.t t/Builder/reset_outputs.t t/Builder/try.t t/c_flag.t t/capture.t t/check_tests.t t/circular_data.t t/cmp_ok.t t/dependents.t t/depth.t t/diag.t t/died.t t/dont_overwrite_die_handler.t t/eq_set.t t/exit.t t/explain.t t/extra.t t/extra_one.t t/fail-like.t t/fail-more.t t/fail.t t/fail_one.t t/filehandles.t t/fork.t t/harness_active.t t/import.t t/is_deeply_dne_bug.t t/is_deeply_fail.t t/is_deeply_with_threads.t t/lib/Dev/Null.pm t/lib/Dummy.pm t/lib/MyOverload.pm t/lib/NoExporter.pm t/lib/SigDie.pm t/lib/Test/Builder/NoOutput.pm t/lib/Test/Simple/Catch.pm t/lib/Test/Simple/sample_tests/death.plx t/lib/Test/Simple/sample_tests/death_in_eval.plx t/lib/Test/Simple/sample_tests/death_with_handler.plx t/lib/Test/Simple/sample_tests/exit.plx t/lib/Test/Simple/sample_tests/extras.plx t/lib/Test/Simple/sample_tests/five_fail.plx t/lib/Test/Simple/sample_tests/last_minute_death.plx t/lib/Test/Simple/sample_tests/missing_done_testing.plx t/lib/Test/Simple/sample_tests/one_fail.plx t/lib/Test/Simple/sample_tests/one_fail_without_plan.plx t/lib/Test/Simple/sample_tests/pre_plan_death.plx t/lib/Test/Simple/sample_tests/require.plx t/lib/Test/Simple/sample_tests/success.plx t/lib/Test/Simple/sample_tests/too_few.plx t/lib/Test/Simple/sample_tests/too_few_fail.plx t/lib/Test/Simple/sample_tests/two_fail.plx t/lib/TieOut.pm t/missing.t t/More.t t/MyTest.pm t/new_ok.t t/no_plan.t t/no_tests.t t/note.t t/overload.t t/overload_threads.t t/plan.t t/plan_bad.t t/plan_is_noplan.t t/plan_no_plan.t t/plan_shouldnt_import.t t/plan_skip_all.t t/require_ok.t t/run_test.t t/simple.t t/Simple/load.t t/skip.t t/skipall.t t/SmallTest.pm t/subtest/args.t t/subtest/bail_out.t t/subtest/basic.t t/subtest/die.t t/subtest/do.t t/subtest/exceptions.t t/subtest/for_do_t.test t/subtest/fork.t t/subtest/implicit_done.t t/subtest/line_numbers.t t/subtest/plan.t t/subtest/predicate.t t/subtest/singleton.t t/subtest/threads.t t/subtest/todo.t t/subtest/wstat.t t/tbm_doesnt_set_exported_to.t t/Tester/tbt_01basic.t t/Tester/tbt_02fhrestore.t t/Tester/tbt_03die.t t/Tester/tbt_04line_num.t t/Tester/tbt_05faildiag.t t/Tester/tbt_06errormess.t t/Tester/tbt_07args.t t/Tester/tbt_08subtest.t t/Tester/tbt_09do.t t/Tester/tbt_09do_script.pl t/thread_taint.t t/threads.t t/todo.t t/undef.t t/use_ok.t t/useing.t t/utf8.t t/versions.t t/xt/dependents.t t/xxx-changes_updated.t TODO xt/downstream.t xt/downstream_dists.list META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Test-Simple-1.001014/xt/0000755000175000017500000000000012450030545014457 5ustar exodistexodistTest-Simple-1.001014/xt/downstream_dists.list0000644000175000017500000000252012450026765020755 0ustar exodistexodistTest::Class App::Dest Business::ISBN Carp::Assert Catalyst Crypt::Rijndael Cwd DBIx::Query Dancer Devel::Confess Devel::Cover Dist::Zilla Dist::Zilla::Plugin::EnsurePrereqsInstalled ExtUtils::CBuilder ExtUtils::Command ExtUtils::Install ExtUtils::MakeMaker ExtUtils::Manifest ExtUtils::ParseXS Fennec Fennec::Declare File::Spec Filter::CommaEquals JE JSON JSON::PP Lexical::Types Lingua::ManagementSpeak Math::GSL Math::Prime::Util Module::Build Module::Signature Mojolicious::Plugin::ToolkitRenderer Moose Params::Classify Parse::CPAN::Meta Plack SQL::Abstract::Complete Scalar::Util Sub::Install Test::Base Test::Class::Moose Test::Differences Test::Fatal Test::FixtureBuilder Test::Harness Test::Kwalitee Test::LWP::UserAgent Test::Most Test::SharedFork Test::Warn Test::Warnings Type::Tiny UNIVERSAL::isa URI::Find YAML YAML::LibYAML YAML::Syck version Test::Trap Test::BDD::Cucumber Dist::Zilla::Plugin::Test::Compile Dist::Zilla::Plugin::Test::CheckDeps Dist::Zilla::Plugin::Test::CheckBreaks Dist::Zilla::Plugin::Test::CleanNamespaces MooseX::UndefTolerant CPAN::Reporter Bible::OBML Business::CPI Catalyst::Action::REST Catalyst::ControllerRole::CatchErrors Dancer2::Plugin::DBIC Dist::Zilla::LocaleTextDomain HTML::Selector::XPath Math::Business::BlackScholes::Binaries Net::SMS::CDYNE OAuth::Cmdline Test::Exception Test::Mocha CHI Test::Moose::More Test-Simple-1.001014/xt/downstream.t0000644000175000017500000000267712450026765017054 0ustar exodistexodist#!/usr/bin/perl use strict; use warnings; BEGIN { unless ( $ENV{DOWNSTREAM_TESTS} ) { print "1..0 # Skip many perls have broken threads. Enable with AUTHOR_TESTING.\n"; exit 0; } } use Test::More; ok(run_string(<<"EOT"), "Installed a fresh perlbrew") || exit 1; perlbrew uninstall TestMore$$ 1>/dev/null 2>/dev/null || true perlbrew install --thread --notest -j9 --as TestMore$$ perl-5.20.1 EOT ok(run_string(<<"EOT"), "Installed Test::More") || exit 1; perlbrew exec --with TestMore$$ cpan . EOT ok(run_string(<<"EOT"), "Installed cpanm") || exit 1; perlbrew exec --with TestMore$$ cpan App::cpanminus EOT ok(run_string(<<"EOT"), "Installed downstream modules with no issues") || exit 1; perlbrew exec --with TestMore$$ cpanm `cat xt/downstream_dists.list` EOT if (-e 'xt/downstream_dists.list.known_broken') { local $TODO = "These are known to be broken"; ok(run_string(<<" EOT"), "Known broken dists"); perlbrew exec --with TestMore$$ cpanm `cat xt/downstream_dists.list.known_broken` EOT } ok(run_string(<<"EOT"), "Cleanup up the perlbrew"); perlbrew uninstall TestMore$$ EOT sub run_string { my $exec = shift; local %ENV = %ENV; delete $ENV{$_} for ( 'DOWNSTREAM_TESTS', 'HARNESS_ACTIVE', 'HARNESS_IS_VERBOSE', 'HARNESS_VERSION', 'OLDPWD', 'PERL5LIB', 'TAP_VERSION', 'TEST_VERBOSE', ); return !system($exec); } done_testing; Test-Simple-1.001014/.perlcriticrc0000644000175000017500000000354312422226065016522 0ustar exodistexodist### ### Configure perlcritic display behavior. ### # Change the default message to show the policy name so we can shut it up if necessary verbose = %m [%p] at %f line %l, near '%r'\n # Force perlcritic to use color, even when run through a pager. color = 1 # Use a pager. pager = $PAGER ### ### Turn off policies. ### # Nuthin wrong with the expression form of map and grep. [-BuiltinFunctions::RequireBlockMap] [-BuiltinFunctions::RequireBlockGrep] # Can't use Carp [-ErrorHandling::RequireCarping] # We realize that localizing a variable does not retain it's original value, # thanks. [-Variables::RequireInitializationForLocalVars] # I'd rather use a few unnecessary "" then forget to interpolate. [-ValuesAndExpressions::ProhibitInterpolationOfLiterals] # Inline POD is more worthwhile than the dubious optimization of putting it # after the __END__ block [-Documentation::RequirePodAtEnd] # No, we're not going to use English. [-Variables::ProhibitPunctuationVars] # That's just rediculous [-ControlStructures::ProhibitPostfixControls] [-ValuesAndExpressions::ProhibitEmptyQuotes] [-ValuesAndExpressions::ProhibitNoisyQuotes] # Test::Builder makes heavy use of local() [-Variables::ProhibitLocalVars] # Nuthin wrong with @$foo [-References::ProhibitDoubleSigils] ### ### Configure policies ### # Extend the ability to play with @_ to 3 line subroutines. [Subroutines::RequireArgUnpacking] short_subroutine_statements = 3 # No tabs ever [CodeLayout::ProhibitHardTabs] allow_leading_tabs = 0 ### ### New policies and options which are not released yet. ### # "no warnings" is fine as long as it's restricted to one or more categories [TestingAndDebugging::ProhibitNoWarnings] allow_with_category_restriction = 1 # Don't need /x on small regexes. [RegularExpressions::RequireExtendedFormatting] minimum_regex_length_to_complain_about = 12 Test-Simple-1.001014/examples/0000755000175000017500000000000012450030544015641 5ustar exodistexodistTest-Simple-1.001014/examples/indent.pl0000644000175000017500000000125112422226065017462 0ustar exodistexodist#!/usr/bin/env perl use strict; use warnings; use lib '../lib'; use Test::Builder; =head1 NOTES Must have explicit finalize Must name nest Trailing summary test Pass chunk o'TAP No builder may have more than one child active What happens if you call ->finalize with open children =cut my $builder = Test::Builder->new; $builder->plan(tests => 7); for( 1 .. 3 ) { $builder->ok( $_, "We're on $_" ); $builder->note("We ran $_"); } { my $indented = $builder->child; $indented->plan('no_plan'); for( 1 .. 1+int(rand(5)) ) { $indented->ok( 1, "We're on $_" ); } $indented->finalize; } for( 7, 8, 9 ) { $builder->ok( $_, "We're on $_" ); } Test-Simple-1.001014/examples/subtest.t0000644000175000017500000000053412422226065017525 0ustar exodistexodist#!/usr/bin/env perl use strict; use warnings; use lib '../lib'; use Test::More tests => 3; ok 1; subtest 'some name' => sub { my $num_tests = 2 + int( rand(3) ); plan tests => $num_tests; ok 1 for 1 .. $num_tests - 1; subtest 'some name' => sub { plan 'no_plan'; ok 1 for 1 .. 2 + int( rand(3) ); }; }; ok 1; Test-Simple-1.001014/TODO0000644000175000017500000000066712450026765014536 0ustar exodistexodistSee 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. Test-Simple-1.001014/t/0000755000175000017500000000000012450030545014267 5ustar exodistexodistTest-Simple-1.001014/t/todo.t0000644000175000017500000000644012450026765015436 0ustar exodistexodist#!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'; } Test-Simple-1.001014/t/extra_one.t0000644000175000017500000000154512450026765016456 0ustar exodistexodist#!/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, <import(tests => 5); require Dev::Null; tie *STDERR, 'Dev::Null'; ok(1); ok(1); ok(1); ok(1); ok(1); $! = 0; die "This is a test"; Test-Simple-1.001014/t/lib/Test/Simple/sample_tests/too_few_fail.plx0000644000175000017500000000026212434254376025106 0ustar exodistexodistrequire Test::Simple; push @INC, 't/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); ok(0); ok(1); ok(0); Test-Simple-1.001014/t/lib/Test/Simple/sample_tests/missing_done_testing.plx0000644000175000017500000000023012434254376026657 0ustar exodistexodistrequire Test::Simple; push @INC, 't/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(); ok(1); Test-Simple-1.001014/t/lib/Test/Simple/sample_tests/one_fail_without_plan.plx0000644000175000017500000000023012434254376027015 0ustar exodistexodistrequire Test::Simple; push @INC, 't/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(); ok(0); Test-Simple-1.001014/t/lib/Test/Simple/sample_tests/one_fail.plx0000644000175000017500000000030012434254376024216 0ustar exodistexodistrequire Test::Simple; push @INC, 't/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); ok(1); ok(2); ok(0); ok(1); ok(2); Test-Simple-1.001014/t/lib/Test/Simple/sample_tests/require.plx0000644000175000017500000000002612434254376024123 0ustar exodistexodistrequire Test::Simple; Test-Simple-1.001014/t/lib/Test/Simple/sample_tests/success.plx0000644000175000017500000000033712434254376024124 0ustar exodistexodistrequire Test::Simple; push @INC, 't/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); ok(1); ok(5, 'yep'); ok(3, 'beer'); ok("wibble", "wibble"); ok(1); Test-Simple-1.001014/t/lib/Test/Simple/sample_tests/death_in_eval.plx0000644000175000017500000000043012434254376025230 0ustar exodistexodistrequire Test::Simple; use Carp; push @INC, 't/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); ok(1); ok(1); ok(1); eval { die "Foo"; }; ok(1); eval "die 'Bar'"; ok(1); eval { croak "Moo"; }; Test-Simple-1.001014/t/lib/Test/Simple/sample_tests/death.plx0000644000175000017500000000037512434254376023543 0ustar exodistexodistrequire Test::Simple; push @INC, 't/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); require Dev::Null; Test::Simple->import(tests => 5); tie *STDERR, 'Dev::Null'; ok(1); ok(1); ok(1); $! = 0; die "This is a test"; Test-Simple-1.001014/t/lib/Test/Simple/sample_tests/five_fail.plx0000644000175000017500000000027512434254376024401 0ustar exodistexodistrequire Test::Simple; use lib 't/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); ok(0); ok(0); ok(''); ok(0); ok(0); Test-Simple-1.001014/t/lib/Test/Simple/sample_tests/extras.plx0000644000175000017500000000031612434254376023757 0ustar exodistexodistrequire Test::Simple; push @INC, 't/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); ok(1); ok(1); ok(1); ok(1); ok(0); ok(1); ok(0); Test-Simple-1.001014/t/lib/Test/Simple/sample_tests/too_few.plx0000644000175000017500000000025312434254376024113 0ustar exodistexodistrequire Test::Simple; push @INC, 't/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); ok(1); ok(1); Test-Simple-1.001014/t/lib/Test/Simple/sample_tests/exit.plx0000644000175000017500000000004012434254376023414 0ustar exodistexodistrequire Test::Builder; exit 1; Test-Simple-1.001014/t/lib/Test/Simple/sample_tests/two_fail.plx0000644000175000017500000000030012434254376024246 0ustar exodistexodistrequire Test::Simple; push @INC, 't/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 5); ok(0); ok(1); ok(1); ok(0); ok(1); Test-Simple-1.001014/t/lib/Test/Simple/sample_tests/pre_plan_death.plx0000644000175000017500000000044112434254376025415 0ustar exodistexodist# ID 20020716.013, the exit code would become 0 if the test died # before a plan. require Test::Simple; push @INC, 't/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); close STDERR; die "Knife?"; Test::Simple->import(tests => 3); ok(1); ok(1); ok(1); Test-Simple-1.001014/t/lib/Test/Simple/sample_tests/death_with_handler.plx0000644000175000017500000000053012434254376026264 0ustar exodistexodistrequire Test::Simple; push @INC, 't/lib'; require Test::Simple::Catch; my($out, $err) = Test::Simple::Catch::caught(); Test::Simple->import(tests => 2); # Test we still get the right exit code despite having a die # handler. $SIG{__DIE__} = sub {}; require Dev::Null; tie *STDERR, 'Dev::Null'; ok(1); ok(1); $! = 0; die "This is a test"; Test-Simple-1.001014/t/lib/Test/Simple/Catch.pm0000644000175000017500000000056512434254376020607 0ustar exodistexodist# For testing Test::Simple; package Test::Simple::Catch; use strict; use Symbol; use TieOut; my( $out_fh, $err_fh ) = ( gensym, gensym ); my $out = tie *$out_fh, 'TieOut'; my $err = tie *$err_fh, 'TieOut'; use Test::Builder; my $t = Test::Builder->new; $t->output($out_fh); $t->failure_output($err_fh); $t->todo_output($err_fh); sub caught { return( $out, $err ) } 1; Test-Simple-1.001014/t/lib/Test/Builder/0000755000175000017500000000000012450030544017341 5ustar exodistexodistTest-Simple-1.001014/t/lib/Test/Builder/NoOutput.pm0000644000175000017500000000455012450026765021512 0ustar exodistexodistpackage Test::Builder::NoOutput; use strict; use warnings; use Symbol qw(gensym); use base qw(Test::Builder); =head1 NAME Test::Builder::NoOutput - A subclass of Test::Builder which prints nothing =head1 SYNOPSIS use Test::Builder::NoOutput; my $tb = Test::Builder::NoOutput->new; ...test as normal... my $output = $tb->read; =head1 DESCRIPTION This is a subclass of Test::Builder which traps all its output. It is mostly useful for testing Test::Builder. =head3 read my $all_output = $tb->read; my $output = $tb->read($stream); Returns all the output (including failure and todo output) collected so far. It is destructive, each call to read clears the output buffer. If $stream is given it will return just the output from that stream. $stream's are... out output() err failure_output() todo todo_output() all all outputs Defaults to 'all'. =cut my $Test = __PACKAGE__->new; sub create { my $class = shift; my $self = $class->SUPER::create(@_); my %outputs = ( all => '', out => '', err => '', todo => '', ); $self->{_outputs} = \%outputs; my($out, $err, $todo) = map { gensym() } 1..3; tie *$out, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{out}; tie *$err, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{err}; tie *$todo, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{todo}; $self->output($out); $self->failure_output($err); $self->todo_output($todo); return $self; } sub read { my $self = shift; my $stream = @_ ? shift : 'all'; my $out = $self->{_outputs}{$stream}; $self->{_outputs}{$stream} = ''; # Clear all the streams if 'all' is read. if( $stream eq 'all' ) { my @keys = keys %{$self->{_outputs}}; $self->{_outputs}{$_} = '' for @keys; } return $out; } package Test::Builder::NoOutput::Tee; # A cheap implementation of IO::Tee. sub TIEHANDLE { my($class, @refs) = @_; my @fhs; for my $ref (@refs) { my $fh = Test::Builder->_new_fh($ref); push @fhs, $fh; } my $self = [@fhs]; return bless $self, $class; } sub PRINT { my $self = shift; print $_ @_ for @$self; } sub PRINTF { my $self = shift; my $format = shift; printf $_ @_ for @$self; } 1; Test-Simple-1.001014/t/lib/MyOverload.pm0000644000175000017500000000113712434254376017472 0ustar exodistexodistpackage 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; Test-Simple-1.001014/t/lib/Dev/0000755000175000017500000000000012450030544015552 5ustar exodistexodistTest-Simple-1.001014/t/lib/Dev/Null.pm0000644000175000017500000000012712434254376017037 0ustar exodistexodistpackage Dev::Null; use strict; sub TIEHANDLE { bless {}, shift } sub PRINT { 1 } 1; Test-Simple-1.001014/t/lib/Dummy.pm0000644000175000017500000000006712434254376016505 0ustar exodistexodistpackage Dummy; use strict; our $VERSION = '0.01'; 1; Test-Simple-1.001014/t/lib/NoExporter.pm0000644000175000017500000000022612434254376017514 0ustar exodistexodistpackage NoExporter; use strict; our $VERSION = 1.02; sub import { shift; die "NoExporter exports nothing. You asked for: @_" if @_; } 1; Test-Simple-1.001014/t/lib/SigDie.pm0000644000175000017500000000011712434254376016552 0ustar exodistexodistpackage SigDie; use strict; our $DIE; $SIG{__DIE__} = sub { $DIE = $@ }; 1; Test-Simple-1.001014/t/lib/TieOut.pm0000644000175000017500000000056412434254376016625 0ustar exodistexodistpackage TieOut; use strict; sub TIEHANDLE { my $scalar = ''; bless( \$scalar, $_[0] ); } sub PRINT { my $self = shift; $$self .= join( '', @_ ); } sub PRINTF { my $self = shift; my $fmt = shift; $$self .= sprintf $fmt, @_; } sub FILENO { } sub read { my $self = shift; my $data = $$self; $$self = ''; return $data; } 1; Test-Simple-1.001014/t/More.t0000644000175000017500000001214212450026765015367 0ustar exodistexodist#!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 => 54; # 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] } ); # rt.cpan.org 53469 is_deeply with regexes is_deeply( qr/a/, qr/a/, "same regex" ); # These two tests must remain at the end. is( $@, $Err, '$@ untouched' ); cmp_ok( $!, '==', $Errno, '$! untouched' ); Test-Simple-1.001014/t/skipall.t0000644000175000017500000000074112450026765016126 0ustar exodistexodist#!/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, ""); } Test-Simple-1.001014/t/utf8.t0000644000175000017500000000240112450026765015350 0ustar exodistexodist#!/usr/bin/perl -w BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = '../lib'; } } use strict; use warnings; my $have_perlio; BEGIN { # All together so Test::More sees the open discipline $have_perlio = eval q[ require PerlIO; binmode *STDOUT, ":encoding(utf8)"; binmode *STDERR, ":encoding(utf8)"; require 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"; } } # Test utf8 is ok. { my $uni = "\x{11e}"; my @warnings; local $SIG{__WARN__} = sub { push @warnings, @_; }; is( $uni, $uni, "Testing $uni" ); is_deeply( \@warnings, [] ); } Test-Simple-1.001014/t/simple.t0000644000175000017500000000031012450026765015750 0ustar exodistexodistBEGIN { 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'); Test-Simple-1.001014/t/versions.t0000644000175000017500000000074212450026765016340 0ustar exodistexodist#!/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 ); my @modules = qw( Test::Simple Test::Builder Test::Builder::Module ); for my $module (@modules) { is( $dist_version, $module->VERSION, $module ); } done_testing(4); Test-Simple-1.001014/t/diag.t0000644000175000017500000000263512450026765015377 0ustar exodistexodist#!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 } Test-Simple-1.001014/t/cmp_ok.t0000644000175000017500000000340212450026765015734 0ustar exodistexodist#!/usr/bin/perl -w use strict; use warnings; use lib 't/lib'; 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, $error) = @_; my %expect; if( $error ) { $expect{ok} = 0; $expect{error} = $error; } else { $expect{ok} = eval "\$left $cmp \$right"; $expect{error} = $@; $expect{error} =~ s/ at .*\n?//; } local $Test::Builder::Level = $Test::Builder::Level + 1; my $ok; eval { $ok = cmp_ok($left, $cmp, $right, "cmp_ok"); }; $TB->is_num(!!$ok, !!$expect{ok}, " right return"); my $diag = $err->read; if ($@) { $diag = $@; $diag =~ s/ at .*\n?//; } 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], [1, "=", 0, "= is not a valid comparison operator in cmp_ok()"], [1, "+=", 0, "+= is not a valid comparison operator in cmp_ok()"], ); plan tests => scalar @Tests; $TB->plan(tests => @Tests * 2); for my $test (@Tests) { try_cmp_ok(@$test); } Test-Simple-1.001014/t/import.t0000644000175000017500000000036412450026765016002 0ustar exodistexodistBEGIN { 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' ); Test-Simple-1.001014/t/auto.t0000644000175000017500000000072012450026765015434 0ustar exodistexodistuse strict; use warnings; use lib 't'; use Test::Tester tests => 5; use SmallTest; use MyTest; { my ($prem, @results) = run_tests( sub { MyTest::ok(1, "run pass")} ); is_eq($results[0]->{name}, "run pass"); is_num($results[0]->{ok}, 1); } { my ($prem, @results) = run_tests( sub { MyTest::ok(0, "run fail")} ); is_eq($results[0]->{name}, "run fail"); is_num($results[0]->{ok}, 0); } is_eq(ref(SmallTest::getTest()), "Test::Tester::Delegate"); Test-Simple-1.001014/t/overload.t0000644000175000017500000000420512450026765016301 0ustar exodistexodist#!/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'; } Test-Simple-1.001014/t/Tester/0000755000175000017500000000000012450030545015535 5ustar exodistexodistTest-Simple-1.001014/t/Tester/tbt_08subtest.t0000644000175000017500000000037012450026765020445 0ustar exodistexodist#!/usr/bin/env perl use strict; use warnings; use Test::Builder::Tester tests => 1; use Test::More; subtest 'foo' => sub { plan tests => 1; test_out("not ok 1 - foo"); test_fail(+1); fail("foo"); test_test("fail works"); }; Test-Simple-1.001014/t/Tester/tbt_09do_script.pl0000644000175000017500000000032712450026765021115 0ustar exodistexodist#!/usr/bin/perl use strict; use warnings; isnt($0, __FILE__, 'code is not executing directly'); test_out("not ok 1 - one"); test_fail(+1); ok(0,"one"); test_test('test_fail caught fail message inside a do'); 1; Test-Simple-1.001014/t/Tester/tbt_05faildiag.t0000644000175000017500000000147012450026765020513 0ustar exodistexodist#!/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"); Test-Simple-1.001014/t/Tester/tbt_04line_num.t0000644000175000017500000000030412450026765020553 0ustar exodistexodist#!/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"); Test-Simple-1.001014/t/Tester/tbt_09do.t0000644000175000017500000000073012450026765017357 0ustar exodistexodist#!/usr/bin/perl use strict; use warnings; use Test::Builder::Tester tests => 3; use Test::More; use File::Basename qw(dirname); use File::Spec qw(); my $file = File::Spec->join(dirname(__FILE__), 'tbt_09do_script.pl'); my $done = do $file; ok(defined($done), 'do succeeded') or do { if ($@) { diag qq( \$@ is '$@'\n); } elsif ($!) { diag qq( \$! is '$!'\n); } else { diag qq( file's last statement returned undef: $file) } }; Test-Simple-1.001014/t/Tester/tbt_07args.t0000644000175000017500000001223512450026765017712 0ustar exodistexodist#!/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(); # remember 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"); #################################################################### Test-Simple-1.001014/t/Tester/tbt_02fhrestore.t0000644000175000017500000000226112450026765020750 0ustar exodistexodist#!/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 {} Test-Simple-1.001014/t/Tester/tbt_03die.t0000644000175000017500000000034112450026765017506 0ustar exodistexodist#!/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"); Test-Simple-1.001014/t/Tester/tbt_06errormess.t0000644000175000017500000000603212450026765020774 0ustar exodistexodist#!/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(); # remember 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 "); #################################################################### Test-Simple-1.001014/t/Tester/tbt_01basic.t0000644000175000017500000000237212450026765020032 0ustar exodistexodist#!/usr/bin/perl use Test::Builder::Tester tests => 10; 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(qr/ok 1 - tested\n/); ok(1,"tested"); test_test("regexp matching"); test_out("not ok 1 - should fail"); test_err("# Failed test ($0 at line 32)"); 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_out("# Failed (TODO) test ($0 at line 56)"); TODO: { local $TODO = "Something"; fail("name"); } test_test("testing failing with todo"); Test-Simple-1.001014/t/extra.t0000644000175000017500000000167612450026765015622 0ustar exodistexodist#!perl -w BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = '../lib'; } else { unshift @INC, 't/lib'; } } use strict; use Test::Builder; use Test::Builder::NoOutput; use Test::Simple; my $TB = Test::Builder->new; my $test = Test::Builder::NoOutput->create; $test->plan( tests => 3 ); local $ENV{HARNESS_ACTIVE} = 0; $test->ok(1, 'Foo'); $TB->is_eq($test->read(), <ok(0, 'Bar'); $TB->is_eq($test->read(), <ok(1, 'Yar'); $test->ok(1, 'Car'); $TB->is_eq($test->read(), <ok(0, 'Sar'); $TB->is_eq($test->read(), <_ending(); $TB->is_eq($test->read(), <done_testing(5); Test-Simple-1.001014/t/01-basic.t0000644000175000017500000000013212450026765015760 0ustar exodistexodistuse strict; use Test::More tests => 3; use ok 'strict'; use ok 'Test::More'; use ok 'ok'; Test-Simple-1.001014/t/check_tests.t0000644000175000017500000000335712450026765016774 0ustar exodistexodistuse strict; use Test::Tester; use Data::Dumper qw(Dumper); my $test = Test::Builder->new; $test->plan(tests => 105); my $cap; $cap = Test::Tester->capture; my @tests = ( [ 'pass', '$cap->ok(1, "pass");', { name => "pass", ok => 1, actual_ok => 1, reason => "", type => "", diag => "", depth => 0, }, ], [ 'pass diag', '$cap->ok(1, "pass diag"); $cap->diag("pass diag1"); $cap->diag("pass diag2");', { name => "pass diag", ok => 1, actual_ok => 1, reason => "", type => "", diag => "pass diag1\npass diag2\n", depth => 0, }, ], [ 'pass diag no \\n', '$cap->ok(1, "pass diag"); $cap->diag("pass diag1"); $cap->diag("pass diag2");', { name => "pass diag", ok => 1, actual_ok => 1, reason => "", type => "", diag => "pass diag1\npass diag2", depth => 0, }, ], [ 'fail', '$cap->ok(0, "fail"); $cap->diag("fail diag");', { name => "fail", ok => 0, actual_ok => 0, reason => "", type => "", diag => "fail diag\n", depth => 0, }, ], [ 'skip', '$cap->skip("just because");', { name => "", ok => 1, actual_ok => 1, reason => "just because", type => "skip", diag => "", depth => 0, }, ], [ 'todo_skip', '$cap->todo_skip("why not");', { name => "", ok => 1, actual_ok => 0, reason => "why not", type => "todo_skip", diag => "", depth => 0, }, ], ); my $big_code = ""; my @big_expect; foreach my $test (@tests) { my ($name, $code, $expect) = @$test; $big_code .= "$code\n"; push(@big_expect, $expect); my $test_sub = eval "sub {$code}"; check_test($test_sub, $expect, $name); } my $big_test_sub = eval "sub {$big_code}"; check_tests($big_test_sub, \@big_expect, "run all"); Test-Simple-1.001014/t/plan_shouldnt_import.t0000644000175000017500000000044612450026765020735 0ustar exodistexodist#!/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' ); Test-Simple-1.001014/t/dont_overwrite_die_handler.t0000644000175000017500000000065212450026765022060 0ustar exodistexodist#!/usr/bin/perl -w use Config; # To prevent conflict with some strawberry-portable versions 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'; Test-Simple-1.001014/t/plan_bad.t0000644000175000017500000000206012450026765016223 0ustar exodistexodist#!/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"; Test-Simple-1.001014/t/no_plan.t0000644000175000017500000000123012450026765016107 0ustar exodistexodist#!/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'; } Test-Simple-1.001014/t/MyTest.pm0000644000175000017500000000017712450026765016070 0ustar exodistexodistuse strict; use warnings; package MyTest; use Test::Builder; my $Test = Test::Builder->new; sub ok { $Test->ok(@_); } 1; Test-Simple-1.001014/t/fail-like.t0000644000175000017500000000302512450026765016322 0ustar exodistexodist#!/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, <like($err->read, qr/^$err_re$/, 'failing errors'); } { # line 62 like("foo", "not a regex"); $TB->is_eq($out->read, <is_eq($err->read, <summary); } Test-Simple-1.001014/t/subtest/0000755000175000017500000000000012450030545015760 5ustar exodistexodistTest-Simple-1.001014/t/subtest/todo.t0000644000175000017500000001246212450026765017130 0ustar exodistexodist#!/usr/bin/perl -w # Test todo subtests. # # A subtest in a todo context should have all of its diagnostic output # redirected to the todo output destination, but individual tests # within the subtest should not become todo tests themselves. BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ( '../lib', 'lib' ); } else { unshift @INC, 't/lib'; } } use strict; use warnings; use Test::More; use Test::Builder; use Test::Builder::Tester; # Formatting may change if we're running under Test::Harness. $ENV{HARNESS_ACTIVE} = 0; our %line; # Repeat each test for various combinations of the todo reason, # the mechanism by which it is set and $Level. our @test_combos; foreach my $level (1, 2, 3) { push @test_combos, ['$TODO', 'Reason', $level], ['todo_start', 'Reason', $level], ['todo_start', '', $level], ['todo_start', 0, $level]; } plan tests => 8 * @test_combos; sub test_subtest_in_todo { my ($name, $code, $want_out, $no_tests_run) = @_; my $xxx = $no_tests_run ? 'No tests run for subtest "xxx"' : 'xxx'; chomp $want_out; my @outlines = split /\n/, $want_out; foreach my $combo (@test_combos) { my ($set_via, $todo_reason, $level) = @$combo; test_out( " # Subtest: xxx", @outlines, "not ok 1 - $xxx # TODO $todo_reason", "# Failed (TODO) test '$xxx'", "# at $0 line $line{xxx}.", "not ok 2 - regular todo test # TODO $todo_reason", "# Failed (TODO) test 'regular todo test'", "# at $0 line $line{reg}.", ); { local $TODO = $set_via eq '$TODO' ? $todo_reason : undef; if ($set_via eq 'todo_start') { Test::Builder->new->todo_start($todo_reason); } subtest_at_level( 'xxx', $code, $level); BEGIN{ $line{xxx} = __LINE__ } ok 0, 'regular todo test'; BEGIN{ $line{reg} = __LINE__ } if ($set_via eq 'todo_start') { Test::Builder->new->todo_end; } } test_test("$name ($level), todo [$todo_reason] set via $set_via"); } } package Foo; # If several stack frames are in package 'main' then $Level # could be wrong and $main::TODO might still be found. Using # another package makes the tests more sensitive. sub main::subtest_at_level { my ($name, $code, $level) = @_; if ($level > 1) { local $Test::Builder::Level = $Test::Builder::Level + 1; main::subtest_at_level($name, $code, $level-1); } else { Test::Builder->new->subtest($name => $code); } } package main; test_subtest_in_todo("plan, no tests run", sub { plan tests => 2; }, < 17; ok 0, 'failme'; BEGIN { $line{fail2} = __LINE__ } }, <new->todo_start('Inner2'); ok 0, 'failing TODO b'; BEGIN{ $line{ftb} = __LINE__ } ok 1, 'unexpected pass b'; Test::Builder->new->todo_end; ok 0, 'inner test 3'; BEGIN{ $line{in3} = __LINE__ } }, < 5; use Test::Builder; use Test::Builder::Tester; # Formatting may change if we're running under Test::Harness. $ENV{HARNESS_ACTIVE} = 0; our %line; # Define a new test predicate with Test::More::subtest(), using # Test::More predicates as building blocks... sub foobar_ok ($;$) { my ($value, $name) = @_; $name ||= "foobar_ok"; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $name => sub { plan tests => 2; ok $value =~ /foo/, "foo"; ok $value =~ /bar/, "bar"; BEGIN{ $line{foobar_ok_bar} = __LINE__ } }; } { test_out(" # Subtest: namehere"); test_out(" 1..2"); test_out(" ok 1 - foo"); test_out(" not ok 2 - bar"); test_err(" # Failed test 'bar'"); test_err(" # at $0 line $line{foobar_ok_bar}."); test_err(" # Looks like you failed 1 test of 2."); test_out("not ok 1 - namehere"); test_err("# Failed test 'namehere'"); test_err("# at $0 line ".(__LINE__+2)."."); foobar_ok "foot", "namehere"; test_test("foobar_ok failing line numbers"); } # Wrap foobar_ok() to make another new predicate... sub foobar_ok_2 ($;$) { my ($value, $name) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; foobar_ok($value, $name); } { test_out(" # Subtest: namehere"); test_out(" 1..2"); test_out(" ok 1 - foo"); test_out(" not ok 2 - bar"); test_err(" # Failed test 'bar'"); test_err(" # at $0 line $line{foobar_ok_bar}."); test_err(" # Looks like you failed 1 test of 2."); test_out("not ok 1 - namehere"); test_err("# Failed test 'namehere'"); test_err("# at $0 line ".(__LINE__+2)."."); foobar_ok_2 "foot", "namehere"; test_test("foobar_ok_2 failing line numbers"); } # Define another new test predicate, this time using # Test::Builder::subtest() rather than Test::More::subtest()... sub barfoo_ok ($;$) { my ($value, $name) = @_; $name ||= "barfoo_ok"; Test::Builder->new->subtest($name => sub { plan tests => 2; ok $value =~ /foo/, "foo"; ok $value =~ /bar/, "bar"; BEGIN{ $line{barfoo_ok_bar} = __LINE__ } }); } { test_out(" # Subtest: namehere"); test_out(" 1..2"); test_out(" ok 1 - foo"); test_out(" not ok 2 - bar"); test_err(" # Failed test 'bar'"); test_err(" # at $0 line $line{barfoo_ok_bar}."); test_err(" # Looks like you failed 1 test of 2."); test_out("not ok 1 - namehere"); test_err("# Failed test 'namehere'"); test_err("# at $0 line ".(__LINE__+2)."."); barfoo_ok "foot", "namehere"; test_test("barfoo_ok failing line numbers"); } # Wrap barfoo_ok() to make another new predicate... sub barfoo_ok_2 ($;$) { my ($value, $name) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; barfoo_ok($value, $name); } { test_out(" # Subtest: namehere"); test_out(" 1..2"); test_out(" ok 1 - foo"); test_out(" not ok 2 - bar"); test_err(" # Failed test 'bar'"); test_err(" # at $0 line $line{barfoo_ok_bar}."); test_err(" # Looks like you failed 1 test of 2."); test_out("not ok 1 - namehere"); test_err("# Failed test 'namehere'"); test_err("# at $0 line ".(__LINE__+2)."."); barfoo_ok_2 "foot", "namehere"; test_test("barfoo_ok_2 failing line numbers"); } # A subtest-based predicate called from within a subtest { test_out(" # Subtest: outergroup"); test_out(" 1..2"); test_out(" ok 1 - this passes"); test_out(" # Subtest: namehere"); test_out(" 1..2"); test_out(" ok 1 - foo"); test_out(" not ok 2 - bar"); test_err(" # Failed test 'bar'"); test_err(" # at $0 line $line{barfoo_ok_bar}."); test_err(" # Looks like you failed 1 test of 2."); test_out(" not ok 2 - namehere"); test_err(" # Failed test 'namehere'"); test_err(" # at $0 line $line{ipredcall}."); test_err(" # Looks like you failed 1 test of 2."); test_out("not ok 1 - outergroup"); test_err("# Failed test 'outergroup'"); test_err("# at $0 line $line{outercall}."); subtest outergroup => sub { plan tests => 2; ok 1, "this passes"; barfoo_ok_2 "foot", "namehere"; BEGIN{ $line{ipredcall} = __LINE__ } }; BEGIN{ $line{outercall} = __LINE__ } test_test("outergroup with internal barfoo_ok_2 failing line numbers"); } Test-Simple-1.001014/t/subtest/do.t0000644000175000017500000000042212450026765016556 0ustar exodistexodist#!/usr/bin/perl -w # Test the idiom of running another test file as a subtest. use strict; use Test::More; pass("First"); my $file = "t/subtest/for_do_t.test"; ok -e $file, "subtest test file exists"; subtest $file => sub { do $file }; pass("Last"); done_testing(4); Test-Simple-1.001014/t/subtest/die.t0000644000175000017500000000102712450026765016717 0ustar exodistexodist#!/usr/bin/perl -w # What happens when a subtest dies? use lib 't/lib'; use strict; use Test::Builder; use Test::Builder::NoOutput; my $Test = Test::Builder->new; { my $tb = Test::Builder::NoOutput->create; $tb->ok(1); $Test->ok( !eval { $tb->subtest("death" => sub { die "Death in the subtest"; }); 1; }); $Test->like( $@, qr/^Death in the subtest at \Q$0\E line /); $Test->ok( !$tb->parent, "the parent object is restored after a die" ); } $Test->done_testing(); Test-Simple-1.001014/t/subtest/fork.t0000644000175000017500000000233512450026765017122 0ustar exodistexodist#!/usr/bin/perl -w use strict; use warnings; use Config; use IO::Pipe; use Test::Builder; use Test::More; 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; } subtest 'fork within subtest' => sub { plan tests => 2; my $pipe = IO::Pipe->new; my $pid = fork; defined $pid or plan skip_all => "Fork not working"; if ($pid) { $pipe->reader; my $child_output = do { local $/ ; <$pipe> }; waitpid $pid, 0; is $?, 0, 'child exit status'; like $child_output, qr/^[\s#]+Child Done\s*\z/, 'child output'; } else { $pipe->writer; # Force all T::B output into the pipe, for the parent # builder as well as the current subtest builder. no warnings 'redefine'; *Test::Builder::output = sub { $pipe }; *Test::Builder::failure_output = sub { $pipe }; *Test::Builder::todo_output = sub { $pipe }; diag 'Child Done'; exit 0; } }; Test-Simple-1.001014/t/subtest/exceptions.t0000644000175000017500000000350112450026765020336 0ustar exodistexodist#!/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 => 7; { my $tb = Test::Builder::NoOutput->create; $tb->child('one'); eval { $tb->child('two') }; my $error = $@; like $error, qr/\QYou already have a child named (one) running/, 'Trying to create a child with another one active should fail'; } { my $tb = Test::Builder::NoOutput->create; my $child = $tb->child('one'); ok my $child2 = $child->child('two'), 'Trying to create nested children should succeed'; eval { $child->finalize }; my $error = $@; like $error, qr/\QCan't call finalize() with child (two) active/, '... but trying to finalize() a child with open children should fail'; } { my $tb = Test::Builder::NoOutput->create; my $child = $tb->child('one'); undef $child; like $tb->read, qr/\QChild (one) exited without calling finalize()/, 'Failing to call finalize should issue an appropriate diagnostic'; ok !$tb->is_passing, '... and should cause the test suite to fail'; } { my $tb = Test::Builder::NoOutput->create; $tb->plan( tests => 7 ); for( 1 .. 3 ) { $tb->ok( $_, "We're on $_" ); $tb->diag("We ran $_"); } { my $indented = $tb->child; $indented->plan('no_plan'); $indented->ok( 1, "We're on 1" ); eval { $tb->ok( 1, 'This should throw an exception' ) }; $indented->finalize; } my $error = $@; like $error, qr/\QCannot run test (This should throw an exception) with active children/, 'Running a test with active children should fail'; ok !$tb->is_passing, '... and should cause the test suite to fail'; } Test-Simple-1.001014/t/subtest/line_numbers.t0000644000175000017500000000744612450026765020653 0ustar exodistexodist#!/usr/bin/perl -w # Test Test::More::subtest(), focusing on correct line numbers in # failed test diagnostics. BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ( '../lib', 'lib' ); } else { unshift @INC, 't/lib'; } } use strict; use warnings; use Test::More tests => 5; use Test::Builder; use Test::Builder::Tester; # Formatting may change if we're running under Test::Harness. $ENV{HARNESS_ACTIVE} = 0; our %line; { test_out(" # Subtest: namehere"); test_out(" 1..3"); test_out(" ok 1"); test_out(" not ok 2"); test_err(" # Failed test at $0 line $line{innerfail1}."); test_out(" ok 3"); test_err(" # Looks like you failed 1 test of 3."); test_out("not ok 1 - namehere"); test_err("# Failed test 'namehere'"); test_err("# at $0 line $line{outerfail1}."); subtest namehere => sub { plan tests => 3; ok 1; ok 0; BEGIN{ $line{innerfail1} = __LINE__ } ok 1; }; BEGIN{ $line{outerfail1} = __LINE__ } test_test("un-named inner tests"); } { test_out(" # Subtest: namehere"); test_out(" 1..3"); test_out(" ok 1 - first is good"); test_out(" not ok 2 - second is bad"); test_err(" # Failed test 'second is bad'"); test_err(" # at $0 line $line{innerfail2}."); test_out(" ok 3 - third is good"); test_err(" # Looks like you failed 1 test of 3."); test_out("not ok 1 - namehere"); test_err("# Failed test 'namehere'"); test_err("# at $0 line $line{outerfail2}."); subtest namehere => sub { plan tests => 3; ok 1, "first is good"; ok 0, "second is bad"; BEGIN{ $line{innerfail2} = __LINE__ } ok 1, "third is good"; }; BEGIN{ $line{outerfail2} = __LINE__ } test_test("named inner tests"); } sub run_the_subtest { subtest namehere => sub { plan tests => 3; ok 1, "first is good"; ok 0, "second is bad"; BEGIN{ $line{innerfail3} = __LINE__ } ok 1, "third is good"; }; BEGIN{ $line{outerfail3} = __LINE__ } } { test_out(" # Subtest: namehere"); test_out(" 1..3"); test_out(" ok 1 - first is good"); test_out(" not ok 2 - second is bad"); test_err(" # Failed test 'second is bad'"); test_err(" # at $0 line $line{innerfail3}."); test_out(" ok 3 - third is good"); test_err(" # Looks like you failed 1 test of 3."); test_out("not ok 1 - namehere"); test_err("# Failed test 'namehere'"); test_err("# at $0 line $line{outerfail3}."); run_the_subtest(); test_test("subtest() called from a sub"); } { test_out( " # Subtest: namehere"); test_out( " 1..0"); test_err( " # No tests run!"); test_out( 'not ok 1 - No tests run for subtest "namehere"'); test_err(q{# Failed test 'No tests run for subtest "namehere"'}); test_err( "# at $0 line $line{outerfail4}."); subtest namehere => sub { done_testing; }; BEGIN{ $line{outerfail4} = __LINE__ } test_test("lineno in 'No tests run' diagnostic"); } { test_out(" # Subtest: namehere"); test_out(" 1..1"); test_out(" not ok 1 - foo is bar"); test_err(" # Failed test 'foo is bar'"); test_err(" # at $0 line $line{is_fail}."); test_err(" # got: 'foo'"); test_err(" # expected: 'bar'"); test_err(" # Looks like you failed 1 test of 1."); test_out('not ok 1 - namehere'); test_err("# Failed test 'namehere'"); test_err("# at $0 line $line{is_outer_fail}."); subtest namehere => sub { plan tests => 1; is 'foo', 'bar', 'foo is bar'; BEGIN{ $line{is_fail} = __LINE__ } }; BEGIN{ $line{is_outer_fail} = __LINE__ } test_test("diag indent for is() in subtest"); } Test-Simple-1.001014/t/subtest/plan.t0000644000175000017500000000254112450026765017112 0ustar exodistexodist#!/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 => 6; # Formatting may change if we're running under Test::Harness. $ENV{HARNESS_ACTIVE} = 0; { ok defined &subtest, 'subtest() should be exported to our namespace'; is prototype('subtest'), undef, '... has no prototype'; subtest 'subtest with plan', sub { plan tests => 2; ok 1, 'planned subtests should work'; ok 1, '... and support more than one test'; }; subtest 'subtest without plan', sub { plan 'no_plan'; ok 1, 'no_plan subtests should work'; ok 1, '... and support more than one test'; ok 1, '... no matter how many tests are run'; }; subtest 'subtest with implicit done_testing()', sub { ok 1, 'subtests with an implicit done testing should work'; ok 1, '... and support more than one test'; ok 1, '... no matter how many tests are run'; }; subtest 'subtest with explicit done_testing()', sub { ok 1, 'subtests with an explicit done testing should work'; ok 1, '... and support more than one test'; ok 1, '... no matter how many tests are run'; done_testing(); }; } Test-Simple-1.001014/t/subtest/args.t0000644000175000017500000000126012450026765017111 0ustar exodistexodist#!/usr/bin/perl -w use strict; use Test::Builder; BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ( '../lib', 'lib' ); } else { unshift @INC, 't/lib'; } } use Test::Builder::NoOutput; my $tb = Test::Builder->new; $tb->ok( !eval { $tb->subtest() } ); $tb->like( $@, qr/^\Qsubtest()'s second argument must be a code ref/ ); $tb->ok( !eval { $tb->subtest("foo") } ); $tb->like( $@, qr/^\Qsubtest()'s second argument must be a code ref/ ); $tb->subtest('Arg passing', sub { my $foo = shift; my $child = Test::Builder->new; $child->is_eq($foo, 'foo'); $child->done_testing; $child->finalize; }, 'foo'); $tb->done_testing(); Test-Simple-1.001014/t/subtest/basic.t0000644000175000017500000001211112450026765017233 0ustar exodistexodist#!/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 => 19; # Formatting may change if we're running under Test::Harness. $ENV{HARNESS_ACTIVE} = 0; { my $tb = Test::Builder::NoOutput->create; $tb->plan( tests => 7 ); for( 1 .. 3 ) { $tb->ok( $_, "We're on $_" ); $tb->diag("We ran $_"); } { my $indented = $tb->child; $indented->plan('no_plan'); $indented->ok( 1, "We're on 1" ); $indented->ok( 1, "We're on 2" ); $indented->ok( 1, "We're on 3" ); $indented->finalize; } for( 7, 8, 9 ) { $tb->ok( $_, "We're on $_" ); } is $tb->read, <<"END", 'Output should nest properly'; 1..7 ok 1 - We're on 1 # We ran 1 ok 2 - We're on 2 # We ran 2 ok 3 - We're on 3 # We ran 3 ok 1 - We're on 1 ok 2 - We're on 2 ok 3 - We're on 3 1..3 ok 4 - Child of $0 ok 5 - We're on 7 ok 6 - We're on 8 ok 7 - We're on 9 END } { my $tb = Test::Builder::NoOutput->create; $tb->plan('no_plan'); for( 1 .. 1 ) { $tb->ok( $_, "We're on $_" ); $tb->diag("We ran $_"); } { my $indented = $tb->child; $indented->plan('no_plan'); $indented->ok( 1, "We're on 1" ); { my $indented2 = $indented->child('with name'); $indented2->plan( tests => 2 ); $indented2->ok( 1, "We're on 2.1" ); $indented2->ok( 1, "We're on 2.1" ); $indented2->finalize; } $indented->ok( 1, 'after child' ); $indented->finalize; } for(7) { $tb->ok( $_, "We're on $_" ); } $tb->_ending; is $tb->read, <<"END", 'We should allow arbitrary nesting'; ok 1 - We're on 1 # We ran 1 ok 1 - We're on 1 1..2 ok 1 - We're on 2.1 ok 2 - We're on 2.1 ok 2 - with name ok 3 - after child 1..3 ok 2 - Child of $0 ok 3 - We're on 7 1..3 END } { #line 108 my $tb = Test::Builder::NoOutput->create; { my $child = $tb->child('expected to fail'); $child->plan( tests => 3 ); $child->ok(1); $child->ok(0); $child->ok(3); $child->finalize; } { my $child = $tb->child('expected to pass'); $child->plan( tests => 3 ); $child->ok(1); $child->ok(2); $child->ok(3); $child->finalize; } is $tb->read, <<"END", 'Previous child failures should not force subsequent failures'; 1..3 ok 1 not ok 2 # Failed test at $0 line 114. ok 3 # Looks like you failed 1 test of 3. not ok 1 - expected to fail # Failed test 'expected to fail' # at $0 line 116. 1..3 ok 1 ok 2 ok 3 ok 2 - expected to pass END } { my $tb = Test::Builder::NoOutput->create; my $child = $tb->child('one'); is $child->{$_}, $tb->{$_}, "The child should copy the ($_) filehandle" foreach qw{Out_FH Todo_FH Fail_FH}; $child->finalize; } { my $tb = Test::Builder::NoOutput->create; my $child = $tb->child('one'); can_ok $child, 'parent'; is $child->parent, $tb, '... and it should return the parent of the child'; ok !defined $tb->parent, '... but top level builders should not have parents'; can_ok $tb, 'name'; is $tb->name, $0, 'The top level name should be $0'; is $child->name, 'one', '... but child names should be whatever we set them to'; $child->finalize; $child = $tb->child; is $child->name, 'Child of '.$tb->name, '... or at least have a sensible default'; $child->finalize; } # Skip all subtests { my $tb = Test::Builder::NoOutput->create; { my $child = $tb->child('skippy says he loves you'); eval { $child->plan( skip_all => 'cuz I said so' ) }; ok my $error = $@, 'A child which does a "skip_all" should throw an exception'; isa_ok $error, 'Test::Builder::Exception', '... and the exception it throws'; } subtest 'skip all', sub { plan skip_all => 'subtest with skip_all'; ok 0, 'This should never be run'; }; is +Test::Builder->new->{Test_Results}[-1]{type}, 'skip', 'Subtests which "skip_all" are reported as skipped tests'; } # to do tests { #line 204 my $tb = Test::Builder::NoOutput->create; $tb->plan( tests => 1 ); my $child = $tb->child; $child->plan( tests => 1 ); $child->todo_start( 'message' ); $child->ok( 0 ); $child->todo_end; $child->finalize; $tb->_ending; is $tb->read, <<"END", 'TODO tests should not make the parent test fail'; 1..1 1..1 not ok 1 # TODO message # Failed (TODO) test at $0 line 209. ok 1 - Child of $0 END } { my $tb = Test::Builder::NoOutput->create; $tb->plan( tests => 1 ); my $child = $tb->child; $child->finalize; $tb->_ending; my $expected = <<"END"; 1..1 not ok 1 - No tests run for subtest "Child of $0" END like $tb->read, qr/\Q$expected/, 'Not running subtests should make the parent test fail'; } Test-Simple-1.001014/t/subtest/implicit_done.t0000644000175000017500000000073712450026765021004 0ustar exodistexodist#!/usr/bin/perl -w # A subtest without a plan implicitly calls "done_testing" use strict; use Test::More; pass "Before"; subtest 'basic' => sub { pass "Inside sub test"; }; subtest 'with done' => sub { pass 'This has done_testing'; done_testing; }; subtest 'with plan' => sub { plan tests => 1; pass 'I have a plan, Batman!'; }; subtest 'skipping' => sub { plan skip_all => 'Skipping'; fail 'Shouldnt see me!'; }; pass "After"; done_testing; Test-Simple-1.001014/t/subtest/threads.t0000644000175000017500000000072512450026765017614 0ustar exodistexodist#!/usr/bin/perl -w use strict; use warnings; 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 Test::More; subtest 'simple test with threads on' => sub { is( 1+1, 2, "simple test" ); is( "a", "a", "another simple test" ); }; pass("Parent retains sharedness"); done_testing(2); Test-Simple-1.001014/t/subtest/singleton.t0000644000175000017500000000131012450026765020153 0ustar exodistexodist#!/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 => 3; { package Test::Singleton; use Test::Builder; my $TB = Test::Builder->new; sub singleton_ok ($;$) { my( $val, $name ) = @_; $TB->ok( $val, $name ); } } ok 1, 'TB top level'; subtest 'doing a subtest' => sub { plan tests => 4; ok 1, 'first test in subtest'; Test::Singleton::singleton_ok(1, 'this should not fail'); ok 1, 'second test in subtest'; Test::Singleton::singleton_ok(1, 'this should not fail'); }; ok 1, 'left subtest'; Test-Simple-1.001014/t/subtest/wstat.t0000644000175000017500000000056112450026765017322 0ustar exodistexodist#!/usr/bin/perl -w # Test that setting $? doesn't affect subtest success use strict; use Test::More; subtest foo => sub { plan tests => 1; $? = 1; pass('bar'); }; is $?, 1, "exit code keeps on from a subtest"; subtest foo2 => sub { plan tests => 1; pass('bar2'); $? = 1; }; is $?, 1, "exit code keeps on from a subtest"; done_testing(4); Test-Simple-1.001014/t/subtest/bail_out.t0000644000175000017500000000166712450026765017766 0ustar exodistexodist#!/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 => 2); plan tests => 4; ok 'foo'; subtest 'bar' => sub { plan tests => 3; ok 'sub_foo'; subtest 'sub_bar' => sub { plan tests => 3; ok 'sub_sub_foo'; ok 'sub_sub_bar'; BAIL_OUT("ROCKS FALL! EVERYONE DIES!"); ok 'sub_sub_baz'; }; ok 'sub_baz'; }; $Test->is_eq( $output, <<'OUT' ); 1..4 ok 1 # Subtest: bar 1..3 ok 1 # Subtest: sub_bar 1..3 ok 1 ok 2 Bail out! ROCKS FALL! EVERYONE DIES! OUT $Test->is_eq( $Exit_Code, 255 ); Test-Simple-1.001014/t/note.t0000644000175000017500000000064012450026765015432 0ustar exodistexodist#!/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'), ''; } Test-Simple-1.001014/t/BEGIN_require_ok.t0000644000175000017500000000071712450026765017543 0ustar exodistexodist#!/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); Test-Simple-1.001014/t/fork.t0000644000175000017500000000107612450026765015432 0ustar exodistexodist#!/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 } Test-Simple-1.001014/t/new_ok.t0000644000175000017500000000130112450026765015742 0ustar exodistexodist#!/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; Test-Simple-1.001014/t/thread_taint.t0000644000175000017500000000017212450026765017133 0ustar exodistexodist#!/usr/bin/perl -w use Test::More tests => 1; ok( !$INC{'threads.pm'}, 'Loading Test::More does not load threads.pm' ); Test-Simple-1.001014/t/00compile.t0000644000175000017500000000172612450026765016263 0ustar exodistexodist#!/usr/bin/perl -w BEGIN { if( $ENV{PERL_CORE} ) { @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib'; } } chdir 't'; use Test::More; my $Has_Test_Pod; BEGIN { $Has_Test_Pod = eval 'use Test::Pod 0.95; 1'; } chdir ".."; my $manifest = "MANIFEST"; open(my $manifest_fh, "<", $manifest) or die "Can't open $manifest: $!"; my @modules = map { m{^lib/(\S+)}; $1 } grep { m{^lib/Test/\S*\.pm} } grep { !m{/t/} } <$manifest_fh>; chomp @modules; close $manifest_fh; chdir 'lib'; plan tests => scalar @modules * 2; foreach my $file (@modules) { # Make sure we look at the local files and do not reload them if # they're already loaded. This avoids recompilation warnings. local @INC = @INC; unshift @INC, "."; ok eval { require($file); 1 } or diag "require $file failed.\n$@"; SKIP: { skip "Test::Pod not installed", 1 unless $Has_Test_Pod; pod_file_ok($file); } } Test-Simple-1.001014/t/skip.t0000644000175000017500000000363112450026765015436 0ustar exodistexodist#!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/; } Test-Simple-1.001014/t/00test_harness_check.t0000644000175000017500000000137412450026765020471 0ustar exodistexodist#!/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 <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 "# $@"; Test-Simple-1.001014/t/is_deeply_with_threads.t0000644000175000017500000000263212450026765021212 0ustar exodistexodist#!/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"); Test-Simple-1.001014/t/SmallTest.pm0000644000175000017500000000052012450026765016543 0ustar exodistexodistuse strict; use warnings; package SmallTest; require Exporter; use vars qw( @ISA @EXPORT ); @ISA = qw( Exporter ); @EXPORT = qw( ok is_eq is_num ); use Test::Builder; my $Test = Test::Builder->new; sub ok { $Test->ok(@_); } sub is_eq { $Test->is_eq(@_); } sub is_num { $Test->is_num(@_); } sub getTest { return $Test; } 1; Test-Simple-1.001014/t/Simple/0000755000175000017500000000000012450030544015517 5ustar exodistexodistTest-Simple-1.001014/t/Simple/load.t0000644000175000017500000000026412450026765016637 0ustar exodistexodist#!/usr/bin/perl # Because I broke "use Test::Simple", here's a test use strict; use warnings; use Test::Simple; print <new; $Test->plan(tests => 3); my $cap; $cap = Test::Tester->capture; { no warnings 'redefine'; sub Test::Tester::find_run_tests { return 0}; } local $Test::Builder::Level = 0; { my $cur = $cap->current_test; $Test->is_num($cur, 0, "current test"); eval {$cap->current_test(2)}; $Test->ok($@, "can't set test_num"); } { $cap->ok(1, "a test"); my @res = $cap->details; $Test->is_num(scalar @res, 1, "res count"); } Test-Simple-1.001014/t/xt/0000755000175000017500000000000012450030544014721 5ustar exodistexodistTest-Simple-1.001014/t/xt/dependents.t0000644000175000017500000000220512450026765017250 0ustar exodistexodist#!/usr/bin/perl # Test important dependant modules so we don't accidentally half of CPAN. use strict; use warnings; use Test::More; BEGIN { plan skip_all => "Dependents only tested when releasing" unless $ENV{PERL_RELEASING}; } require File::Spec; use CPAN; CPAN::HandleConfig->load; $CPAN::Config->{test_report} = 0; # Module which depend on Test::More to test my @Modules = qw( Test::Tester Test::Most Test::Warn Test::Exception Test::Class Test::Deep Test::Differences Test::NoWarnings ); # Modules which are known to be broken my %Broken = map { $_ => 1 } ( 'Test::Most', 'Test::Differences' ); # Have to do it here because CPAN chdirs. my $perl5lib = join ":", File::Spec->rel2abs("blib/lib"), File::Spec->rel2abs("lib"); TODO: for my $name (@ARGV ? @ARGV : @Modules) { local $TODO = "$name known to be broken" if $Broken{$name}; local $ENV{PERL5LIB} = $perl5lib; my $module = CPAN::Shell->expand("Module", $name); $module->make; $module->test; my $test_result = $module->distribution->{make_test}; ok( $test_result && !$test_result->failed, $name ); } done_testing(); Test-Simple-1.001014/t/tbm_doesnt_set_exported_to.t0000644000175000017500000000071112450026765022111 0ustar exodistexodist#!/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()' ); Test-Simple-1.001014/t/depth.t0000644000175000017500000000057312450026765015576 0ustar exodistexodistuse strict; use warnings; use lib 't'; use Test::Tester; use MyTest; my $test = Test::Builder->new; $test->plan(tests => 2); sub deeper { MyTest::ok(1); } { my @results = run_tests( sub { MyTest::ok(1); deeper(); } ); local $Test::Builder::Level = 0; $test->is_num($results[1]->{depth}, 1, "depth 1"); $test->is_num($results[2]->{depth}, 2, "deeper"); } Test-Simple-1.001014/t/undef.t0000644000175000017500000000343312450026765015571 0ustar exodistexodist#!/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' ); no_warnings; 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 74 cmp_ok( undef, '<=', 2, ' undef <= 2' ); warnings_like(qr/Use of uninitialized value.* at \(eval in cmp_ok\) $Filename line 74\.\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; } Test-Simple-1.001014/t/overload_threads.t0000644000175000017500000000204712450026765020015 0ustar exodistexodist#!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; } Test-Simple-1.001014/t/dependents.t0000644000175000017500000000165712450026765016627 0ustar exodistexodist#!/usr/bin/perl # Test important dependant modules so we don't accidentally half of CPAN. use strict; use warnings; use Test::More; BEGIN { plan skip_all => "Dependents only tested when releasing" unless $ENV{PERL_RELEASING}; } require File::Spec; use CPAN; CPAN::HandleConfig->load; $CPAN::Config->{test_report} = 0; # Module which depend on Test::More to test my @Modules = qw( Test::Most Test::Warn Test::Exception Test::Class Test::Deep Test::Differences Test::NoWarnings ); # Modules which are known to be broken my %Broken = map { $_ => 1 } qw( ); TODO: for my $name (@ARGV ? @ARGV : @Modules) { local $TODO = "$name known to be broken" if $Broken{$name}; local $ENV{PERL5LIB} = "$ENV{PERL5LIB}:" . File::Spec->rel2abs("blib/lib"); my $module = CPAN::Shell->expand("Module", $name); $module->test; ok( !$module->distribution->{make_test}->failed, $name ); } done_testing(); Test-Simple-1.001014/t/is_deeply_fail.t0000644000175000017500000002641412450026765017444 0ustar exodistexodist#!/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 => 100); # Utility testing functions. sub ok ($;$) { return $TB->ok(@_); } sub is ($$;$) { my($thing, $that, $name) = @_; my $ok = $TB->is_eq($$thing, $that, $name); $$thing = ''; return $ok; } sub like ($$;$) { my($thing, $regex, $name) = @_; $regex = "/$regex/" if !ref $regex and $regex !~ m{^/.*/$}s; my $ok = $TB->like($$thing, $regex, $name); $$thing = ''; 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, < 42 }, { this => 43 }, 'hashes with different values'); is( $out, "not ok 3 - hashes with different values\n", 'hashes with different values' ); is( $err, <{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, <{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, <[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, <[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, <{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, < \$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, <{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, <[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, <[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, <[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, < 0}, {x => ''}, "{x => 0} != {x => ''}" ); is( $out, "not ok 39 - {x => 0} != {x => ''}\n" ); ok !is_deeply( {x => 0}, {x => undef}, "{x => 0} != {x => undef}" ); is( $out, "not ok 40 - {x => 0} != {x => undef}\n" ); ok !is_deeply( {x => ''}, {x => undef}, "{x => ''} != {x => undef}" ); is( $out, "not ok 41 - {x => ''} != {x => undef}\n" ); } Test-Simple-1.001014/t/useing.t0000644000175000017500000000055512450026765015764 0ustar exodistexodistBEGIN { 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' ); } Test-Simple-1.001014/t/no_tests.t0000644000175000017500000000141612450026765016325 0ustar exodistexodist#!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, <is_eq($err->read, <is_eq($?, 255, "exit code"); exit grep { !$_ } $TB->summary; } Test-Simple-1.001014/t/fail_one.t0000644000175000017500000000127112450026765016242 0ustar exodistexodist#!/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'), <is_eq($tb->read('err'), <done_testing(2); } Test-Simple-1.001014/t/filehandles.t0000644000175000017500000000044212450026765016743 0ustar exodistexodist#!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'; Test-Simple-1.001014/t/died.t0000644000175000017500000000152012450026765015370 0ustar exodistexodist#!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, <is_eq($err->read, <is_eq($?, 250, "exit code"); exit grep { !$_ } $TB->summary; } Test-Simple-1.001014/t/eq_set.t0000644000175000017500000000106212450026765015744 0ustar exodistexodist#!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] ) ); } Test-Simple-1.001014/t/plan.t0000644000175000017500000000073212450026765015421 0ustar exodistexodist#!/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'); Test-Simple-1.001014/t/Builder/0000755000175000017500000000000012450030545015655 5ustar exodistexodistTest-Simple-1.001014/t/Builder/done_testing_with_number.t0000644000175000017500000000035412450026765023142 0ustar exodistexodist#!/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); Test-Simple-1.001014/t/Builder/details.t0000644000175000017500000000575212450026765017511 0ustar exodistexodist#!/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 ); } Test-Simple-1.001014/t/Builder/done_testing_with_plan.t0000644000175000017500000000023112450026765022576 0ustar exodistexodist#!/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); Test-Simple-1.001014/t/Builder/done_testing_plan_mismatch.t0000644000175000017500000000142312450026765023434 0ustar exodistexodist#!/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 Test-Simple-1.001014/t/Builder/has_plan2.t0000644000175000017500000000054312450026765017724 0ustar exodistexodist#!/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'); Test-Simple-1.001014/t/Builder/has_plan.t0000644000175000017500000000055612450026765017646 0ustar exodistexodist#!/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'); Test-Simple-1.001014/t/Builder/no_ending.t0000644000175000017500000000053112450026765020012 0ustar exodistexodistuse 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 # suppressed the ending diagnostics. pass; print "ok 2\n"; print "ok 3\n"; Test-Simple-1.001014/t/Builder/is_fh.t0000644000175000017500000000171712450026765017151 0ustar exodistexodist#!/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")); Test-Simple-1.001014/t/Builder/ok_obj.t0000644000175000017500000000071612450026765017322 0ustar exodistexodist#!/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"; Test-Simple-1.001014/t/Builder/Builder.t0000644000175000017500000000117312450026765017443 0ustar exodistexodist#!/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' ); Test-Simple-1.001014/t/Builder/no_diag.t0000644000175000017500000000022412450026765017451 0ustar exodistexodist#!/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); Test-Simple-1.001014/t/Builder/done_testing_double.t0000644000175000017500000000162012450026765022066 0ustar exodistexodist#!/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 Test-Simple-1.001014/t/Builder/create.t0000644000175000017500000000146212450026765017321 0ustar exodistexodist#!/usr/bin/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"); Test-Simple-1.001014/t/Builder/fork_with_new_stdout.t0000644000175000017500000000161312450026765022323 0ustar exodistexodist#!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 Test-Simple-1.001014/t/Builder/reset_outputs.t0000644000175000017500000000142012450026765020775 0ustar exodistexodist#!perl -w BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib'; } } use Test::Builder; use Test::More 'no_plan'; { my $tb = Test::Builder->create(); # Store the original output filehandles and change them all. my %original_outputs; open my $fh, ">", "dummy_file.tmp"; END { 1 while unlink "dummy_file.tmp"; } for my $method (qw(output failure_output todo_output)) { $original_outputs{$method} = $tb->$method(); $tb->$method($fh); is $tb->$method(), $fh; } $tb->reset_outputs; for my $method (qw(output failure_output todo_output)) { is $tb->$method(), $original_outputs{$method}, "reset_outputs() resets $method"; } } Test-Simple-1.001014/t/Builder/current_test_without_plan.t0000644000175000017500000000035112450026765023370 0ustar exodistexodist#!/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); Test-Simple-1.001014/t/Builder/is_passing.t0000644000175000017500000000431612450026765020216 0ustar exodistexodist#!/usr/bin/perl -w use strict; use lib 't/lib'; # We're going to need to override exit() later BEGIN { *CORE::GLOBAL::exit = sub(;$) { my $status = @_ ? 0 : shift; CORE::exit $status; }; } use Test::More; use Test::Builder; use Test::Builder::NoOutput; { my $tb = Test::Builder::NoOutput->create; ok $tb->is_passing, "a fresh TB object is passing"; $tb->ok(1); ok $tb->is_passing, " still passing after a test"; $tb->ok(0); ok !$tb->is_passing, " not passing after a failing test"; $tb->ok(1); ok !$tb->is_passing, " a passing test doesn't resurrect it"; $tb->done_testing(3); ok !$tb->is_passing, " a successful plan doesn't help either"; } # See if is_passing() notices a plan overrun { my $tb = Test::Builder::NoOutput->create; $tb->plan( tests => 1 ); $tb->ok(1); ok $tb->is_passing, "Passing with a plan"; $tb->ok(1); ok !$tb->is_passing, " passing test, but it overran the plan"; } # is_passing() vs no_plan { my $tb = Test::Builder::NoOutput->create; $tb->plan( "no_plan" ); ok $tb->is_passing, "Passing with no_plan"; $tb->ok(1); ok $tb->is_passing, " still passing after a test"; $tb->ok(1); ok $tb->is_passing, " and another test"; $tb->_ending; ok $tb->is_passing, " and after the ending"; } # is_passing() vs skip_all { my $tb = Test::Builder::NoOutput->create; { no warnings 'redefine'; local *CORE::GLOBAL::exit = sub { return 1; }; $tb->plan( "skip_all" ); } ok $tb->is_passing, "Passing with skip_all"; } # is_passing() vs done_testing(#) { my $tb = Test::Builder::NoOutput->create; $tb->ok(1); $tb->done_testing(2); ok !$tb->is_passing, "All tests passed but done_testing() does not match"; } # is_passing() with no tests run vs done_testing() { my $tb = Test::Builder::NoOutput->create; $tb->done_testing(); ok !$tb->is_passing, "No tests run with done_testing()"; } # is_passing() with no tests run vs done_testing() { my $tb = Test::Builder::NoOutput->create; $tb->ok(1); $tb->done_testing(); ok $tb->is_passing, "All tests passed with done_testing()"; } done_testing(); Test-Simple-1.001014/t/Builder/done_testing_with_no_plan.t0000644000175000017500000000023012450026765023271 0ustar exodistexodist#!/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); Test-Simple-1.001014/t/Builder/maybe_regex.t0000644000175000017500000000244212450026765020344 0ustar exodistexodist#!/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'); }; Test-Simple-1.001014/t/Builder/reset.t0000644000175000017500000000400012450026765017167 0ustar exodistexodist#!/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); $tb->done_testing; # make sure done_testing gets reset # Now reset it. $tb->reset; # Test the state of the reset builder $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' ); # The reset Test::Builder will take over from here. $Test->no_ending(1); $tb->current_test($Test->current_test); $tb->level(0); $tb->ok(1, 'final test to make sure output was reset'); $tb->done_testing; Test-Simple-1.001014/t/Builder/no_header.t0000644000175000017500000000045212450026765020000 0ustar exodistexodistBEGIN { 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; Test-Simple-1.001014/t/Builder/try.t0000644000175000017500000000135312450026765016673 0ustar exodistexodist#!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"; Test-Simple-1.001014/t/Builder/output.t0000644000175000017500000000371312450026765017417 0ustar exodistexodist#!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 = ); 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 = ; 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, < 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; } Test-Simple-1.001014/t/Builder/done_testing.t0000644000175000017500000000035312450026765020536 0ustar exodistexodist#!/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(); Test-Simple-1.001014/t/Builder/no_plan_at_all.t0000644000175000017500000000132212450026765021013 0ustar exodistexodist#!/usr/bin/perl -w # Test what happens when no plan is declared 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 Test-Simple-1.001014/t/Builder/current_test.t0000644000175000017500000000040312450026765020571 0ustar exodistexodist#!/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); Test-Simple-1.001014/t/plan_no_plan.t0000644000175000017500000000143212450026765017125 0ustar exodistexodistBEGIN { 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' ); } Test-Simple-1.001014/t/use_ok.t0000644000175000017500000000445112450026765015756 0ustar exodistexodist#!/usr/bin/perl -w use strict; use warnings; use lib 't/lib'; use Test::More; note "Basic use_ok"; { package Foo::one; ::use_ok("Symbol"); ::ok( defined &gensym, 'use_ok() no args exports defaults' ); } note "With one arg"; { package Foo::two; ::use_ok("Symbol", qw(qualify)); ::ok( !defined &gensym, ' one arg, defaults overridden' ); ::ok( defined &qualify, ' right function exported' ); } note "Multiple args"; { package Foo::three; ::use_ok("Symbol", qw(gensym ungensym)); ::ok( defined &gensym && defined &ungensym, ' multiple args' ); } note "Defining constants"; { 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'); } note "use Module VERSION"; { package Foo::five; ::use_ok("Symbol", 1.02); } note "use Module VERSION does not call import"; { 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); } note "Signals are preserved"; { package Foo::eight; local $SIG{__DIE__}; ::use_ok("SigDie"); ::ok(defined $SIG{__DIE__}, ' SIG{__DIE__} preserved'); } note "Line numbers preserved"; { my $package = "that_cares_about_line_numbers"; # Store the output of caller. my @caller; { package that_cares_about_line_numbers; sub import { @caller = caller; return; } $INC{"$package.pm"} = 1; # fool use into thinking it's already loaded } ::use_ok($package); my $line = __LINE__-1; ::is( $caller[0], __PACKAGE__, "caller package preserved" ); ::is( $caller[1], __FILE__, " file" ); ::is( $caller[2], $line, " line" ); } note "not confused by functions vs class names"; { $INC{"ok.pm"} = 1; use_ok("ok"); # ok is a function inside Test::More $INC{"Foo/bar.pm"} = 1; sub Foo::bar { 42 } use_ok("Foo::bar"); # Confusing a class name with a function name } done_testing; Test-Simple-1.001014/t/fail-more.t0000644000175000017500000002516212450026765016346 0ustar exodistexodist#!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 => 80); 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 = 38; 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( <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( <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( <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( <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( <new\\(\\) died OUT # Failed test 'undef->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( <new\\(\\) died OUT # Failed test 'Does::Not::Exist->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( <is_eq( $out->read, <is_eq( $err->read, <= 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"); Test-Simple-1.001014/t/harness_active.t0000644000175000017500000000254512450026765017471 0ustar exodistexodist#!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( < 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] ); } Test-Simple-1.001014/t/exit.t0000644000175000017500000000622612450026765015444 0ustar exodistexodist#!/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"}; } else { $Perl = qq("$Perl"); # protect from shell if spaces } 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, 'one_fail_without_plan.plx' => 1, 'missing_done_testing.plx' => 254, ); 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; Test-Simple-1.001014/t/explain.t0000644000175000017500000000110612450026765016123 0ustar exodistexodist#!/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]; Test-Simple-1.001014/t/run_test.t0000644000175000017500000001020712450026765016330 0ustar exodistexodistuse strict; use Test::Tester; use Data::Dumper qw(Dumper); my $test = Test::Builder->new; $test->plan(tests => 54); my $cap; { $cap = Test::Tester->capture; my ($prem, @results) = run_tests( sub {$cap->ok(1, "run pass")} ); local $Test::Builder::Level = 0; $test->is_eq($prem, "", "run pass no prem"); $test->is_num(scalar (@results), 1, "run pass result count"); my $res = $results[0]; $test->is_eq($res->{name}, "run pass", "run pass name"); $test->is_eq($res->{ok}, 1, "run pass ok"); $test->is_eq($res->{actual_ok}, 1, "run pass actual_ok"); $test->is_eq($res->{reason}, "", "run pass reason"); $test->is_eq($res->{type}, "", "run pass type"); $test->is_eq($res->{diag}, "", "run pass diag"); $test->is_num($res->{depth}, 0, "run pass depth"); } { my ($prem, @results) = run_tests( sub {$cap->ok(0, "run fail")} ); local $Test::Builder::Level = 0; $test->is_eq($prem, "", "run fail no prem"); $test->is_num(scalar (@results), 1, "run fail result count"); my $res = $results[0]; $test->is_eq($res->{name}, "run fail", "run fail name"); $test->is_eq($res->{actual_ok}, 0, "run fail actual_ok"); $test->is_eq($res->{ok}, 0, "run fail ok"); $test->is_eq($res->{reason}, "", "run fail reason"); $test->is_eq($res->{type}, "", "run fail type"); $test->is_eq($res->{diag}, "", "run fail diag"); $test->is_num($res->{depth}, 0, "run fail depth"); } { my ($prem, @results) = run_tests( sub {$cap->skip("just because")} ); local $Test::Builder::Level = 0; $test->is_eq($prem, "", "skip no prem"); $test->is_num(scalar (@results), 1, "skip result count"); my $res = $results[0]; $test->is_eq($res->{name}, "", "skip name"); $test->is_eq($res->{actual_ok}, 1, "skip actual_ok"); $test->is_eq($res->{ok}, 1, "skip ok"); $test->is_eq($res->{reason}, "just because", "skip reason"); $test->is_eq($res->{type}, "skip", "skip type"); $test->is_eq($res->{diag}, "", "skip diag"); $test->is_num($res->{depth}, 0, "skip depth"); } { my ($prem, @results) = run_tests( sub {$cap->todo_skip("just because")} ); local $Test::Builder::Level = 0; $test->is_eq($prem, "", "todo_skip no prem"); $test->is_num(scalar (@results), 1, "todo_skip result count"); my $res = $results[0]; $test->is_eq($res->{name}, "", "todo_skip name"); $test->is_eq($res->{actual_ok}, 0, "todo_skip actual_ok"); $test->is_eq($res->{ok}, 1, "todo_skip ok"); $test->is_eq($res->{reason}, "just because", "todo_skip reason"); $test->is_eq($res->{type}, "todo_skip", "todo_skip type"); $test->is_eq($res->{diag}, "", "todo_skip diag"); $test->is_num($res->{depth}, 0, "todo_skip depth"); } { my ($prem, @results) = run_tests( sub {$cap->diag("run diag")} ); local $Test::Builder::Level = 0; $test->is_eq($prem, "run diag\n", "run diag prem"); $test->is_num(scalar (@results), 0, "run diag result count"); } { my ($prem, @results) = run_tests( sub { $cap->ok(1, "multi pass"); $cap->diag("multi pass diag1"); $cap->diag("multi pass diag2"); $cap->ok(0, "multi fail"); $cap->diag("multi fail diag"); } ); local $Test::Builder::Level = 0; $test->is_eq($prem, "", "run multi no prem"); $test->is_num(scalar (@results), 2, "run multi result count"); my $res_pass = $results[0]; $test->is_eq($res_pass->{name}, "multi pass", "run multi pass name"); $test->is_eq($res_pass->{actual_ok}, 1, "run multi pass actual_ok"); $test->is_eq($res_pass->{ok}, 1, "run multi pass ok"); $test->is_eq($res_pass->{reason}, "", "run multi pass reason"); $test->is_eq($res_pass->{type}, "", "run multi pass type"); $test->is_eq($res_pass->{diag}, "multi pass diag1\nmulti pass diag2\n", "run multi pass diag"); $test->is_num($res_pass->{depth}, 0, "run multi pass depth"); my $res_fail = $results[1]; $test->is_eq($res_fail->{name}, "multi fail", "run multi fail name"); $test->is_eq($res_pass->{actual_ok}, 1, "run multi fail actual_ok"); $test->is_eq($res_fail->{ok}, 0, "run multi fail ok"); $test->is_eq($res_pass->{reason}, "", "run multi fail reason"); $test->is_eq($res_pass->{type}, "", "run multi fail type"); $test->is_eq($res_fail->{diag}, "multi fail diag\n", "run multi fail diag"); $test->is_num($res_pass->{depth}, 0, "run multi fail depth"); } Test-Simple-1.001014/t/478-cmp_ok_hash.t0000644000175000017500000000163312450026765017263 0ustar exodistexodistuse strict; use warnings; use Test::More; my $want = 0; my $got = 0; cmp_ok($got, 'eq', $want, "Passes on correct comparison"); my ($res, @ok, @diag, @warn); { no warnings 'redefine'; local *Test::Builder::ok = sub { my ($tb, $ok, $name) = @_; push @ok => $ok; return $ok; }; local *Test::Builder::diag = sub { my ($tb, @d) = @_; push @diag => @d; }; local $SIG{__WARN__} = sub { push @warn => @_; }; $res = cmp_ok($got, '#eq', $want, "You shall not pass!"); } ok(!$res, "Did not pass"); is(@ok, 1, "1 result"); ok(!$ok[0], "result is false"); # We only care that it mentions a syntax error. like(join("\n" => @diag), qr/syntax error at \(eval in cmp_ok\)/, "Syntax error"); # We are not going to inspect the warning because it is not super predictable, # and changes with eval specifics. ok(@warn, "We got warnings"); done_testing; Test-Simple-1.001014/t/buffer.t0000644000175000017500000000065012450026765015737 0ustar exodistexodist#!/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"; } Test-Simple-1.001014/t/plan_skip_all.t0000644000175000017500000000027612450026765017302 0ustar exodistexodistBEGIN { 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'); Test-Simple-1.001014/t/plan_is_noplan.t0000644000175000017500000000062412450026765017463 0ustar exodistexodist#!/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, < 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'); Test-Simple-1.001014/t/missing.t0000644000175000017500000000204312450026765016135 0ustar exodistexodistBEGIN { 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, < "Only tested when releasing" unless $ENV{AUTHOR_TESTING}; my $ver = $Test::More::VERSION; my $changes = first { -f $_ } './Changes', '../Changes'; plan 'skip_all' => 'Could not find changes file' unless $changes; open(my $fh, '<', $changes) || die "Could not load changes file!"; chomp(my $line = <$fh>); like($line, qr/^\Q$ver\E/, "Changes file is up to date"); close($fh); done_testing; Test-Simple-1.001014/t/fail.t0000644000175000017500000000205212450026765015377 0ustar exodistexodist#!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'), <is_eq($tb->read('err'), <done_testing(2); } Test-Simple-1.001014/t/BEGIN_use_ok.t0000644000175000017500000000060412450026765016656 0ustar exodistexodist#!/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); Test-Simple-1.001014/t/c_flag.t0000644000175000017500000000064112450026765015701 0ustar exodistexodist#!/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"; Test-Simple-1.001014/t/bail_out.t0000644000175000017500000000122412450026765016262 0ustar exodistexodist#!/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" ); Test-Simple-1.001014/t/is_deeply_dne_bug.t0000644000175000017500000000156712450026765020136 0ustar exodistexodist#!/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 $@, ''; Test-Simple-1.001014/MANIFEST.SKIP0000644000175000017500000000240012450026765015727 0ustar exodistexodist #!start included /Users/schwern/perl5/perlbrew/perls/perl-v5.12.2/lib/5.12.2/ExtUtils/MANIFEST.SKIP # Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b \B\.git\b \B\.gitignore\b \b_darcs\b \B\.cvsignore$ # Avoid VMS specific MakeMaker generated files \bDescrip.MMS$ \bDESCRIP.MMS$ \bdescrip.mms$ # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ \bBuild.bat$ \bBuild.COM$ \bBUILD.COM$ \bbuild.com$ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ \.tmp$ \.# \.rej$ # Avoid OS-specific files/dirs # Mac OSX metadata \B\.DS_Store # Mac OSX SMB mount metadata files \B\._ # Avoid Devel::Cover and Devel::CoverX::Covered files. \bcover_db\b \bcovered\b # Avoid MYMETA files ^MYMETA\. #!end included /Users/schwern/perl5/perlbrew/perls/perl-v5.12.2/lib/5.12.2/ExtUtils/MANIFEST.SKIP # Avoid this one test that doesn't work yet ^t/strays.t # Don't distribute Test::Harness ^t/lib/Test/Harness # Test::FAQ is not complete. ^lib/Test/FAQ # Avoid Devel::Cover stuff ^cover_db/ # Don't include our dist director ^Test-Simple- .travis.yml