lib/Term/ReadLine.pm Stub readline library
lib/termcap.pl Perl library supporting termcap usage
lib/Test.pm A simple framework for writing test scripts
+lib/Test/Builder.pm For writing new test libraries
lib/Test/Harness.pm A test harness
lib/Test/Harness/Changes Test::Harness
lib/Test/Harness/t/base.t Test::Harness
lib/Test/More.pm More utilities for writing tests
lib/Test/Simple.pm Basic utility for writing tests
lib/Test/Simple/Changes Test::Simple changes
+lib/Test/Simple/t/Builder.t Test::Builder tests
lib/Test/Simple/t/exit.t Test::Simple test, exit codes
lib/Test/Simple/t/extra.t Test::Simple test
lib/Test/Simple/t/fail-like.t Test::More test, like() failures
lib/Test/Simple/t/fail-more.t Test::More test, tests failing
lib/Test/Simple/t/fail.t Test::Simple test, test failures
+lib/Test/Simple/t/filehandles.t Test::Simple test, STDOUT can be played with
+lib/Test/Simple/t/import.t Test::More test, importing functions
+lib/Test/Simple/t/is_deeply.t Test::More test, is_deeply()
lib/Test/Simple/t/missing.t Test::Simple test, missing tests
lib/Test/Simple/t/More.t Test::More test, basic stuff
+lib/Test/Simple/t/no_ending.t Test::Builder test, no_ending()
+lib/Test/Simple/t/no_header.t Test::Builder test, no_header()
lib/Test/Simple/t/no_plan.t Test::Simple test, forgot the plan
+lib/Test/Simple/t/output.t Test::Builder test, output methods
+lib/Test/Simple/t/plan.t Test::More test, plan()
lib/Test/Simple/t/plan_is_noplan.t Test::Simple test, no_plan
+lib/Test/Simple/t/plan_no_plan.t Test::More test, plan() w/no_plan
+lib/Test/Simple/t/plan_skip_all.t Test::More test, plan() w/skip_all
lib/Test/Simple/t/simple.t Test::Simple test, basic stuff
lib/Test/Simple/t/skip.t Test::More test, SKIP tests
lib/Test/Simple/t/skipall.t Test::More test, skip all tests
lib/Test/Simple/t/todo.t Test::More test, TODO tests
lib/Test/Simple/t/undef.t Test::More test, undefs don't cause warnings
+lib/Test/Simple/t/use_ok.t Test::More test, use_ok()
lib/Test/Simple/t/useing.t Test::More test, compile test
lib/Test/t/fail.t See if Test works
lib/Test/t/mix.t See if Test works
lib/Test/t/success.t See if Test works
lib/Test/t/todo.t See if Test works
lib/Test/Tutorial.pod A tutorial on writing tests
-lib/Test/Utils.pm Utility module for Test::Simple/More
lib/Text/Abbrev.pm An abbreviation table builder
lib/Text/Abbrev.t Test Text::Abbrev
lib/Text/Balanced.pm Text::Balanced
t/lib/strict/subs Tests of "use strict 'subs'" for strict.t
t/lib/strict/vars Tests of "use strict 'vars'" for strict.t
t/lib/Test/Simple/Catch.pm Utility module for testing Test::Simple
-t/lib/Test/Simple/Catch/More.pm Utility module for testing Test::More
t/lib/Test/Simple/sample_tests/death.plx for exit.t
t/lib/Test/Simple/sample_tests/death_in_eval.plx for exit.t
t/lib/Test/Simple/sample_tests/extras.plx for exit.t
--- /dev/null
+package Test::Builder;
+
+use 5.004;
+
+# $^C was only introduced in 5.005-ish. We do this to prevent
+# use of uninitialized value warnings in older perls.
+$^C ||= 0;
+
+use strict;
+use vars qw($VERSION $CLASS);
+$VERSION = 0.03;
+$CLASS = __PACKAGE__;
+
+my $IsVMS = $^O eq 'VMS';
+
+use vars qw($Level);
+my @Test_Results = ();
+my @Test_Details = ();
+my($Test_Died) = 0;
+my($Have_Plan) = 0;
+my $Curr_Test = 0;
+
+
+=head1 NAME
+
+Test::Builder - Backend for building test libraries
+
+=head1 SYNOPSIS
+
+ package My::Test::Module;
+ use Test::Builder;
+ require Exporter;
+ @ISA = qw(Exporter);
+ @EXPORT = qw(ok);
+
+ my $Test = Test::Builder->new;
+ $Test->output('my_logfile');
+
+ sub import {
+ my($self) = shift;
+ my $pack = caller;
+
+ $Test->exported_to($pack);
+ $Test->plan(@_);
+
+ $self->export_to_level(1, $self, 'ok');
+ }
+
+ sub ok {
+ my($test, $name) = @_;
+
+ $Test->ok($test, $name);
+ }
+
+
+=head1 DESCRIPTION
+
+I<THIS IS ALPHA GRADE SOFTWARE> The interface will change.
+
+Test::Simple and Test::More have proven to be popular testing modules,
+but they're not always flexible enough. Test::Builder provides the
+a building block upon which to write your own test libraries.
+
+=head2 Construction
+
+=over 4
+
+=item B<new>
+
+ my $Test = Test::Builder->new;
+
+Returns a Test::Builder object representing the current state of the
+test.
+
+Since you only run one test per program, there is B<one and only one>
+Test::Builder object. No matter how many times you call new(), you're
+getting the same object. (This is called a singleton).
+
+=cut
+
+my $Test;
+sub new {
+ my($class) = shift;
+ $Test ||= bless ['Move along, nothing to see here'], $class;
+ return $Test;
+}
+
+=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<exported_to>
+
+ my $pack = $Test->exported_to;
+ $Test->exported_to($pack);
+
+Tells Test::Builder what package you exported your functions to.
+This is important for getting TODO tests right.
+
+=cut
+
+my $Exported_To;
+sub exported_to {
+ my($self, $pack) = @_;
+
+ if( defined $pack ) {
+ $Exported_To = $pack;
+ }
+ return $Exported_To;
+}
+
+=item B<plan>
+
+ $Test->plan('no_plan');
+ $Test->plan( skip_all => $reason );
+ $Test->plan( tests => $num_tests );
+
+A convenient way to set up your tests. Call this and Test::Builder
+will print the appropriate headers and take the appropriate actions.
+
+If you call plan(), don't call any of the other methods below.
+
+=cut
+
+sub plan {
+ my($self, $cmd, $arg) = @_;
+
+ return unless $cmd;
+
+ if( $cmd eq 'no_plan' ) {
+ $self->no_plan;
+ }
+ elsif( $cmd eq 'skip_all' ) {
+ return $self->skip_all($arg);
+ }
+ elsif( $cmd eq 'tests' ) {
+ if( $arg ) {
+ return $self->expected_tests($arg);
+ }
+ elsif( !defined $arg ) {
+ die "Got an undefined number of tests. Looks like you tried to ".
+ "say how many tests you plan to run but made a mistake.\n";
+ }
+ elsif( !$arg ) {
+ die "You said to run 0 tests! You've got to run something.\n";
+ }
+ }
+}
+
+=item B<expected_tests>
+
+ my $max = $Test->expected_tests;
+ $Test->expected_tests($max);
+
+Gets/sets the # of tests we expect this test to run and prints out
+the appropriate headers.
+
+=cut
+
+my $Expected_Tests = 0;
+sub expected_tests {
+ my($self, $max) = @_;
+
+ if( defined $max ) {
+ $Expected_Tests = $max;
+ $Have_Plan = 1;
+
+ $self->_print("1..$max\n") unless $self->no_header;
+ }
+ return $Expected_Tests;
+}
+
+
+=item B<no_plan>
+
+ $Test->no_plan;
+
+Declares that this test will run an indeterminate # of tests.
+
+=cut
+
+my($No_Plan) = 0;
+sub no_plan {
+ $No_Plan = 1;
+ $Have_Plan = 1;
+}
+
+=item B<skip_all>
+
+ $Test->skip_all;
+ $Test->skip_all($reason);
+
+Skips all the tests, using the given $reason. Exits immediately with 0.
+
+=cut
+
+my $Skip_All = 0;
+sub skip_all {
+ my($self, $reason) = @_;
+
+ my $out = "1..0";
+ $out .= " # Skip $reason" if $reason;
+ $out .= "\n";
+
+ $Skip_All = 1;
+
+ $self->_print($out) unless $self->no_header;
+ exit(0);
+}
+
+=back
+
+=head2 Running tests
+
+These actually run the tests, analogous to the functions in
+Test::More.
+
+$name is always optional.
+
+=over 4
+
+=item B<ok>
+
+ $Test->ok($test, $name);
+
+Your basic test. Pass if $test is true, fail if $test is false. Just
+like Test::Simple's ok().
+
+=cut
+
+sub ok {
+ my($self, $test, $name) = @_;
+
+ unless( $Have_Plan ) {
+ die "You tried to run a test without a plan! Gotta have a plan.\n";
+ }
+
+ $Curr_Test++;
+
+ $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
+
+ my($pack, $file, $line) = $self->caller;
+
+ my $todo = $self->todo($pack);
+
+ my $out;
+ unless( $test ) {
+ $out .= "not ";
+ $Test_Results[$Curr_Test-1] = $todo ? 1 : 0;
+ }
+ else {
+ $Test_Results[$Curr_Test-1] = 1;
+ }
+
+ $out .= "ok";
+ $out .= " $Curr_Test" if $self->use_numbers;
+
+ if( defined $name ) {
+ $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
+ $out .= " - $name";
+ }
+
+ if( $todo ) {
+ my $what_todo = $todo;
+ $out .= " # TODO $what_todo";
+ }
+
+ $out .= "\n";
+
+ $self->_print($out);
+
+ unless( $test ) {
+ my $msg = $todo ? "Failed (TODO)" : "Failed";
+ $self->diag("$msg test ($file at line $line)\n");
+ }
+
+ return $test ? 1 : 0;
+}
+
+=item B<is_eq>
+
+ $Test->is_eq($got, $expected, $name);
+
+Like Test::More's is(). Checks if $got eq $expected. This is the
+string version.
+
+=item B<is_num>
+
+ $Test->is_num($get, $expected, $name);
+
+Like Test::More's is(). Checks if $got == $expected. This is the
+numeric version.
+
+=cut
+
+sub is_eq {
+ my $self = shift;
+ local $Level = $Level + 1;
+ return $self->_is('eq', @_);
+}
+
+sub is_num {
+ my $self = shift;
+ local $Level = $Level + 1;
+ return $self->_is('==', @_);
+}
+
+sub _is {
+ my($self, $type, $got, $expect, $name) = @_;
+
+ my $test;
+ {
+ local $^W = 0; # so we can compare undef quietly
+ $test = $type eq 'eq' ? $got eq $expect
+ : $got == $expect;
+ }
+ local $Level = $Level + 1;
+ my $ok = $self->ok($test, $name);
+
+ unless( $ok ) {
+ $got = defined $got ? "'$got'" : 'undef';
+ $expect = defined $expect ? "'$expect'" : 'undef';
+ $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
+ got: %s
+expected: %s
+DIAGNOSTIC
+ }
+
+ return $ok;
+}
+
+=item B<like>
+
+ $Test->like($this, qr/$regex/, $name);
+ $Test->like($this, '/$regex/', $name);
+
+Like Test::More's like(). Checks if $this matches the given $regex.
+
+You'll want to avoid qr// if you want your tests to work before 5.005.
+
+=cut
+
+sub like {
+ my($self, $this, $regex, $name) = @_;
+
+ local $Level = $Level + 1;
+
+ my $ok = 0;
+ if( ref $regex eq 'Regexp' ) {
+ local $^W = 0;
+ $ok = $self->ok( $this =~ $regex ? 1 : 0, $name );
+ }
+ # Check if it looks like '/foo/'
+ elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
+ local $^W = 0;
+ $ok = $self->ok( $this =~ /(?$opts)$re/ ? 1 : 0, $name );
+ }
+ else {
+ $ok = $self->ok( 0, $name );
+
+ $self->diag("'$regex' doesn't look much like a regex to me.");
+
+ return $ok;
+ }
+
+ unless( $ok ) {
+ $this = defined $this ? "'$this'" : 'undef';
+ $self->diag(sprintf <<DIAGNOSTIC, $this);
+ %s
+doesn't match '$regex'
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+=item B<skip>
+
+ $Test->skip;
+ $Test->skip($why);
+
+Skips the current test, reporting $why.
+
+=cut
+
+sub skip {
+ my($self, $why) = @_;
+ $why ||= '';
+
+ unless( $Have_Plan ) {
+ die "You tried to run tests without a plan! Gotta have a plan.\n";
+ }
+
+ $Curr_Test++;
+
+ $Test_Results[$Curr_Test-1] = 1;
+
+ my $out = "ok";
+ $out .= " $Curr_Test" if $self->use_numbers;
+ $out .= " # skip $why\n";
+
+ $Test->_print($out);
+
+ return 1;
+}
+
+=begin _unimplemented
+
+=item B<skip_rest>
+
+ $Test->skip_rest;
+ $Test->skip_rest($reason);
+
+Like skip(), only it skips all the rest of the tests you plan to run
+and terminates the test.
+
+If you're running under no_plan, it skips once and terminates the
+test.
+
+=end _unimplemented
+
+=back
+
+
+=head2 Test style
+
+=over 4
+
+=item B<level>
+
+ $Test->level($how_high);
+
+How far up the call stack should $Test look when reporting where the
+test failed.
+
+Defaults to 1.
+
+Setting $Test::Builder::Level overrides. This is typically useful
+localized:
+
+ {
+ local $Test::Builder::Level = 2;
+ $Test->ok($test);
+ }
+
+=cut
+
+sub level {
+ my($self, $level) = @_;
+
+ if( defined $level ) {
+ $Level = $level;
+ }
+ return $Level;
+}
+
+$CLASS->level(1);
+
+
+=item B<use_numbers>
+
+ $Test->use_numbers($on_or_off);
+
+Whether or not the test should output numbers. That is, this if true:
+
+ ok 1
+ ok 2
+ ok 3
+
+or this if false
+
+ ok
+ ok
+ ok
+
+Most useful when you can't depend on the test output order, such as
+when threads or forking is involved.
+
+Test::Harness will accept either, but avoid mixing the two styles.
+
+Defaults to on.
+
+=cut
+
+my $Use_Nums = 1;
+sub use_numbers {
+ my($self, $use_nums) = @_;
+
+ if( defined $use_nums ) {
+ $Use_Nums = $use_nums;
+ }
+ return $Use_Nums;
+}
+
+=item B<no_header>
+
+ $Test->no_header($no_header);
+
+If set to true, no "1..N" header will be printed.
+
+=item B<no_ending>
+
+ $Test->no_ending($no_ending);
+
+Normally, Test::Builder does some extra diagnostics when the test
+ends. It also changes the exit code as described in Test::Simple.
+
+If this is true, none of that will be done.
+
+=cut
+
+my($No_Header, $No_Ending) = (0,0);
+sub no_header {
+ my($self, $no_header) = @_;
+
+ if( defined $no_header ) {
+ $No_Header = $no_header;
+ }
+ return $No_Header;
+}
+
+sub no_ending {
+ my($self, $no_ending) = @_;
+
+ if( defined $no_ending ) {
+ $No_Ending = $no_ending;
+ }
+ return $No_Ending;
+}
+
+
+=back
+
+=head2 Output
+
+Controlling where the test output goes.
+
+=over 4
+
+=item B<diag>
+
+ $Test->diag(@msgs);
+
+Prints out the given $message. Normally, it uses the failure_output()
+handle, but if this is for a TODO test, the todo_output() handle is
+used.
+
+Output will be indented and prepended with a # as not to interfere
+with test output.
+
+We encourage using this rather than calling print directly.
+
+=cut
+
+sub diag {
+ my($self, @msgs) = @_;
+
+ # Prevent printing headers when compiling (ie. -c)
+ return if $^C;
+
+ # Escape each line with a #.
+ foreach (@msgs) {
+ s/^([^#])/# $1/;
+ s/\n([^#])/\n# $1/g;
+ }
+
+ local $Level = $Level + 1;
+ my $fh = $self->todo ? $self->todo_output : $self->failure_output;
+ local($\, $", $,) = (undef, ' ', '');
+ print $fh @msgs;
+}
+
+=begin _private
+
+=item B<_print>
+
+ $Test->_print(@msgs);
+
+Prints to the output() filehandle.
+
+=end _private
+
+=cut
+
+sub _print {
+ my($self, @msgs) = @_;
+
+ # Prevent printing headers when only compiling. Mostly for when
+ # tests are deparsed with B::Deparse
+ return if $^C;
+
+ local($\, $", $,) = (undef, ' ', '');
+ my $fh = $self->output;
+ print $fh @msgs;
+}
+
+
+=item B<output>
+
+ $Test->output($fh);
+ $Test->output($file);
+
+Where normal "ok/not ok" test output should go.
+
+Defaults to STDOUT.
+
+=item B<failure_output>
+
+ $Test->failure_output($fh);
+ $Test->failure_output($file);
+
+Where diagnostic output on test failures and diag() should go.
+
+Defaults to STDERR.
+
+=item B<todo_output>
+
+ $Test->todo_output($fh);
+ $Test->todo_output($file);
+
+Where diagnostics about todo test failures and diag() should go.
+
+Defaults to STDOUT.
+
+=cut
+
+my($Out_FH, $Fail_FH, $Todo_FH);
+sub output {
+ my($self, $fh) = @_;
+
+ if( defined $fh ) {
+ $Out_FH = _new_fh($fh);
+ }
+ return $Out_FH;
+}
+
+sub failure_output {
+ my($self, $fh) = @_;
+
+ if( defined $fh ) {
+ $Fail_FH = _new_fh($fh);
+ }
+ return $Fail_FH;
+}
+
+sub todo_output {
+ my($self, $fh) = @_;
+
+ if( defined $fh ) {
+ $Todo_FH = _new_fh($fh);
+ }
+ return $Todo_FH;
+}
+
+sub _new_fh {
+ my($file_or_fh) = shift;
+
+ my $fh;
+ unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
+ $fh = do { local *FH };
+ open $fh, ">$file_or_fh" or
+ die "Can't open test output log $file_or_fh: $!";
+ }
+ else {
+ $fh = $file_or_fh;
+ }
+
+ return $fh;
+}
+
+unless( $^C ) {
+ # 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: $!";
+ _autoflush(\*TESTOUT);
+ _autoflush(\*TESTERR);
+ $CLASS->output(\*TESTOUT);
+ $CLASS->failure_output(\*TESTERR);
+ $CLASS->todo_output(\*TESTOUT);
+}
+
+sub _autoflush {
+ my($fh) = shift;
+ my $old_fh = select $fh;
+ $| = 1;
+ select $old_fh;
+}
+
+
+=back
+
+
+=head2 Test Status and Info
+
+=over 4
+
+=item B<current_test>
+
+ my $curr_test = $Test->current_test;
+ $Test->current_test($num);
+
+Gets/sets the current test # we're on.
+
+You usually shouldn't have to set this.
+
+=cut
+
+sub current_test {
+ my($self, $num) = @_;
+
+ if( defined $num ) {
+ $Curr_Test = $num;
+ }
+ return $Curr_Test;
+}
+
+
+=item B<summary>
+
+ my @tests = $Test->summary;
+
+A simple summary of the tests so far. True for pass, false for fail.
+This is a logical pass/fail, so todos are passes.
+
+Of course, test #1 is $tests[0], etc...
+
+=cut
+
+sub summary {
+ my($self) = shift;
+
+ return @Test_Results;
+}
+
+=item B<details> I<UNIMPLEMENTED>
+
+ my @tests = $Test->details;
+
+Like summary(), but with a lot more detail.
+
+ $tests[$test_num - 1] =
+ { ok => is the test considered ok?
+ actual_ok => did it literally say 'ok'?
+ name => name of the test (if any)
+ type => 'skip' or 'todo' (if any)
+ reason => reason for the above (if any)
+ };
+
+=item B<todo>
+
+ my $todo_reason = $Test->todo;
+ my $todo_reason = $Test->todo($pack);
+
+todo() looks for a $TODO variable in your tests. If set, all tests
+will be considered 'todo' (see Test::More and Test::Harness for
+details). Returns the reason (ie. the value of $TODO) if running as
+todo tests, false otherwise.
+
+todo() is pretty part about finding the right package to look for
+$TODO in. It uses the exported_to() package to find it. If that's
+not set, it's pretty good at guessing the right package to look at.
+
+Sometimes there is some confusion about where todo() should be looking
+for the $TODO variable. If you want to be sure, tell it explicitly
+what $pack to use.
+
+=cut
+
+sub todo {
+ my($self, $pack) = @_;
+
+ $pack = $pack || $self->exported_to || $self->caller(1);
+
+ no strict 'refs';
+ return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
+ : 0;
+}
+
+=item B<caller>
+
+ my $package = $Test->caller;
+ my($pack, $file, $line) = $Test->caller;
+ my($pack, $file, $line) = $Test->caller($height);
+
+Like the normal caller(), except it reports according to your level().
+
+=cut
+
+sub caller {
+ my($self, $height) = @_;
+ $height ||= 0;
+
+ my @caller = CORE::caller($self->level + $height + 1);
+ return wantarray ? @caller : $caller[0];
+}
+
+=back
+
+=cut
+
+=begin _private
+
+=over 4
+
+=item B<_sanity_check>
+
+ _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 {
+ _whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
+ _whoa(!$Have_Plan and $Curr_Test,
+ 'Somehow your tests ran without a plan!');
+ _whoa($Curr_Test != @Test_Results,
+ 'Somehow you got a different number of results than tests ran!');
+}
+
+=item B<_whoa>
+
+ _whoa($check, $description);
+
+A sanity check, similar to assert(). If the $check is true, something
+has gone horribly wrong. It will die with the given $description and
+a note to contact the author.
+
+=cut
+
+sub _whoa {
+ my($check, $desc) = @_;
+ if( $check ) {
+ die <<WHOA;
+WHOA! $desc
+This should never happen! Please contact the author immediately!
+WHOA
+ }
+}
+
+=item B<_my_exit>
+
+ _my_exit($exit_num);
+
+Perl seems to have some trouble with exiting inside an END block. 5.005_03
+and 5.6.1 both seem to do odd things. Instead, this function edits $?
+directly. It should ONLY be called from inside an END block. It
+doesn't actually exit, that's your job.
+
+=cut
+
+sub _my_exit {
+ $? = $_[0];
+
+ return 1;
+}
+
+
+=back
+
+=end _private
+
+=cut
+
+$SIG{__DIE__} = sub {
+ # We don't want to muck with death in an eval, but $^S isn't
+ # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
+ # with it. Instead, we use caller. This also means it runs under
+ # 5.004!
+ my $in_eval = 0;
+ for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
+ $in_eval = 1 if $sub =~ /^\(eval\)/;
+ }
+ $Test_Died = 1 unless $in_eval;
+};
+
+sub _ending {
+ my $self = shift;
+
+ _sanity_check();
+
+ # Bailout if plan() was never called. This is so
+ # "require Test::Simple" doesn't puke.
+ do{ _my_exit(0) && return } if !$Have_Plan;
+
+ # Figure out if we passed or failed and print helpful messages.
+ if( @Test_Results ) {
+ # The plan? We have no plan.
+ if( $No_Plan ) {
+ $self->_print("1..$Curr_Test\n") unless $self->no_header;
+ $Expected_Tests = $Curr_Test;
+ }
+
+ my $num_failed = grep !$_, @Test_Results[0..$Expected_Tests-1];
+ $num_failed += abs($Expected_Tests - @Test_Results);
+
+ if( $Curr_Test < $Expected_Tests ) {
+ $self->diag(<<"FAIL");
+# Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
+FAIL
+ }
+ elsif( $Curr_Test > $Expected_Tests ) {
+ my $num_extra = $Curr_Test - $Expected_Tests;
+ $self->diag(<<"FAIL");
+# Looks like you planned $Expected_Tests tests but ran $num_extra extra.
+FAIL
+ }
+ elsif ( $num_failed ) {
+ $self->diag(<<"FAIL");
+# Looks like you failed $num_failed tests of $Expected_Tests.
+FAIL
+ }
+
+ if( $Test_Died ) {
+ $self->diag(<<"FAIL");
+# Looks like your test died just after $Curr_Test.
+FAIL
+
+ _my_exit( 255 ) && return;
+ }
+
+ _my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
+ }
+ elsif ( $Skip_All ) {
+ _my_exit( 0 ) && return;
+ }
+ else {
+ $self->diag("# No tests run!\n");
+ _my_exit( 255 ) && return;
+ }
+}
+
+END {
+ $Test->_ending if defined $Test and !$Test->no_ending;
+}
+
+=head1 EXAMPLES
+
+At this point, Test::Simple and Test::More are your best examples.
+
+=head1 AUTHOR
+
+Original code by chromatic, maintained by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>
+
+=head1 SEE ALSO
+
+Test::Simple, Test::More, Test::Harness
+
+=cut
+
+1;
use 5.004;
use strict;
-use Carp;
-use Test::Utils;
+use Test::Builder;
-BEGIN {
- require Test::Simple;
- *TESTOUT = \*Test::Simple::TESTOUT;
- *TESTERR = \*Test::Simple::TESTERR;
+
+# Can't use Carp because it might cause use_ok() to accidentally succeed
+# even though the module being used forgot to use Carp. Yes, this
+# actually happened.
+sub _carp {
+ my($file, $line) = (caller(1))[1,2];
+ warn @_, sprintf " at $file line $line\n";
}
+
+
require Exporter;
-use vars qw($VERSION @ISA @EXPORT $TODO);
-$VERSION = '0.19';
+use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
+$VERSION = '0.32';
@ISA = qw(Exporter);
@EXPORT = qw(ok use_ok require_ok
- is isnt like
+ is isnt like is_deeply
skip todo
pass fail
eq_array eq_hash eq_set
- skip
$TODO
plan
can_ok isa_ok
);
+my $Test = Test::Builder->new;
-sub import {
- my($class, $plan, @args) = @_;
-
- if( defined $plan ) {
- if( $plan eq 'skip_all' ) {
- $Test::Simple::Skip_All = 1;
- my $out = "1..0";
- $out .= " # Skip @args" if @args;
- $out .= "\n";
-
- my_print *TESTOUT, $out;
- exit(0);
- }
- else {
- Test::Simple->import($plan => @args);
- }
- }
- else {
- Test::Simple->import;
- }
-
- __PACKAGE__->_export_to_level(1, __PACKAGE__);
-}
# 5.004's Exporter doesn't have export_to_level.
sub _export_to_level
isnt($this, $that, $test_name);
like($this, qr/that/, $test_name);
+ is_deeply($complex_structure1, $complex_structure2, $test_name);
+
SKIP: {
skip $why, $how_many unless $have_some_feature;
exit immediately with a zero (success). See L<Test::Harness> for
details.
+If you want to control what functions Test::More will export, you
+have to use the 'import' option. For example, to import everything
+but 'fail', you'd do:
+
+ use Test::More tests => 23, import => ['!fail'];
+
+Alternatively, you can use the plan() function. Useful for when you
+have to calculate the number of tests.
+
+ use Test::More;
+ plan tests => keys %Stuff * 3;
+
+or for deciding between running the tests at all:
+
+ use Test::More;
+ if( $^O eq 'MacOS' ) {
+ plan skip_all => 'Test irrelevent on MacOS';
+ }
+ else {
+ plan tests => 42;
+ }
+
+=cut
+
+sub plan {
+ my(@plan) = @_;
+
+ my $caller = caller;
+
+ $Test->exported_to($caller);
+ $Test->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);
+}
+
+sub import {
+ my($class) = shift;
+ goto &plan;
+}
+
=head2 Test names
=cut
-# We get ok() from Test::Simple's import().
+sub ok ($;$) {
+ my($test, $name) = @_;
+ $Test->ok($test, $name);
+}
=item B<is>
=cut
sub is ($$;$) {
- my($this, $that, $name) = @_;
-
- my $test;
- {
- local $^W = 0; # so is(undef, undef) works quietly.
- $test = $this eq $that;
- }
- my $ok = @_ == 3 ? ok($test, $name)
- : ok($test);
-
- unless( $ok ) {
- $this = defined $this ? "'$this'" : 'undef';
- $that = defined $that ? "'$that'" : 'undef';
- my_print *TESTERR, sprintf <<DIAGNOSTIC, $this, $that;
-# got: %s
-# expected: %s
-DIAGNOSTIC
-
- }
-
- return $ok;
+ $Test->is_eq(@_);
}
sub isnt ($$;$) {
$test = $this ne $that;
}
- my $ok = @_ == 3 ? ok($test, $name)
- : ok($test);
+ my $ok = $Test->ok($test, $name);
unless( $ok ) {
$that = defined $that ? "'$that'" : 'undef';
- my_print *TESTERR, sprintf <<DIAGNOSTIC, $that;
-# it should not be %s
-# but it is.
+ $Test->diag(sprintf <<DIAGNOSTIC, $that);
+it should not be %s
+but it is.
DIAGNOSTIC
}
=cut
sub like ($$;$) {
- my($this, $regex, $name) = @_;
-
- my $ok = 0;
- if( ref $regex eq 'Regexp' ) {
- local $^W = 0;
- $ok = @_ == 3 ? ok( $this =~ $regex ? 1 : 0, $name )
- : ok( $this =~ $regex ? 1 : 0 );
- }
- # Check if it looks like '/foo/i'
- elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
- local $^W = 0;
- $ok = @_ == 3 ? ok( $this =~ /(?$opts)$re/ ? 1 : 0, $name )
- : ok( $this =~ /(?$opts)$re/ ? 1 : 0 );
- }
- else {
- # Can't use fail() here, the call stack will be fucked.
- my $ok = @_ == 3 ? ok(0, $name )
- : ok(0);
-
- my_print *TESTERR, <<ERR;
-# '$regex' doesn't look much like a regex to me. Failing the test.
-ERR
-
- return $ok;
- }
-
- unless( $ok ) {
- $this = defined $this ? "'$this'" : 'undef';
- my_print *TESTERR, sprintf <<DIAGNOSTIC, $this;
-# %s
-# doesn't match '$regex'
-DIAGNOSTIC
-
- }
-
- return $ok;
+ $Test->like(@_);
}
=item B<can_ok>
my @nok = ();
foreach my $method (@methods) {
- my $test = "$class->can('$method')";
+ my $test = "'$class'->can('$method')";
eval $test || push @nok, $method;
}
$name = @methods == 1 ? "$class->can($methods[0])"
: "$class->can(...)";
- ok( !@nok, $name );
+ my $ok = $Test->ok( !@nok, $name );
- my_print *TESTERR, map "# $class->can('$_') failed\n", @nok;
+ $Test->diag(map "$class->can('$_') failed\n", @nok);
- return !@nok;
+ return $ok;
}
=item B<isa_ok>
- isa_ok($object, $class);
+ isa_ok($object, $class, $object_name);
Checks to see if the given $object->isa($class). Also checks to make
sure the object was defined in the first place. Handy for this sort
to safeguard against your test script blowing up.
+The diagnostics of this test normally just refer to 'the object'. If
+you'd like them to be more specific, you can supply an $object_name
+(for example 'Test customer').
+
=cut
-sub isa_ok ($$) {
- my($object, $class) = @_;
+sub isa_ok ($$;$) {
+ my($object, $class, $obj_name) = @_;
my $diag;
- my $name = "object->isa('$class')";
+ $obj_name = 'The object' unless defined $obj_name;
+ my $name = "$obj_name isa $class";
if( !defined $object ) {
- $diag = "The object isn't defined";
+ $diag = "$obj_name isn't defined";
}
elsif( !ref $object ) {
- $diag = "The object isn't a reference";
+ $diag = "$obj_name isn't a reference";
}
elsif( !$object->isa($class) ) {
- $diag = "The object isn't a '$class'";
+ $diag = "$obj_name isn't a '$class'";
}
+ my $ok;
if( $diag ) {
- ok( 0, $name );
- my_print *TESTERR, "# $diag\n";
- return 0;
+ $ok = $Test->ok( 0, $name );
+ $Test->diag("$diag\n");
}
else {
- ok( 1, $name );
- return 1;
+ $ok = $Test->ok( 1, $name );
}
+
+ return $ok;
}
=cut
sub pass (;$) {
- my($name) = @_;
- return @_ == 1 ? ok(1, $name)
- : ok(1);
+ $Test->ok(1, @_);
}
sub fail (;$) {
- my($name) = @_;
- return @_ == 1 ? ok(0, $name)
- : ok(0);
+ $Test->ok(0, @_);
}
=back
$module->import(\@imports);
USE
- my $ok = ok( !$@, "use $module;" );
+ my $ok = $Test->ok( !$@, "use $module;" );
unless( $ok ) {
chomp $@;
- my_print *TESTERR, <<DIAGNOSTIC;
-# Tried to use '$module'.
-# Error: $@
+ $Test->diag(<<DIAGNOSTIC);
+Tried to use '$module'.
+Error: $@
DIAGNOSTIC
}
require $module;
REQUIRE
- my $ok = ok( !$@, "require $module;" );
+ my $ok = $Test->ok( !$@, "require $module;" );
unless( $ok ) {
chomp $@;
- my_print *TESTERR, <<DIAGNOSTIC;
+ $Test->diag(<<DIAGNOSTIC);
# Tried to require '$module'.
# Error: $@
DIAGNOSTIC
completely. Test::More will output special ok's which Test::Harness
interprets as skipped tests. Its important to include $how_many tests
are in the block so the total number of tests comes out right (unless
-you're using C<no_plan>).
+you're using C<no_plan>, in which case you can leave $how_many off if
+you like).
You'll typically use this when a feature is missing, like an optional
module is not installed or the operating system doesn't have some
#'#
sub skip {
my($why, $how_many) = @_;
- unless( $how_many >= 1 ) {
+
+ 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"
- if $Test::Simple::Planned_Tests;
+ _carp "skip() needs to know \$how_many tests are in the block"
+ unless $Test::Builder::No_Plan;
$how_many = 1;
}
for( 1..$how_many ) {
- Test::Simple::_skipped($why);
+ $Test->skip($why);
}
local $^W = 0;
=over 4
+=item B<is_deeply>
+
+ is_deeply( $this, $that, $test_name );
+
+Similar to is(), except that if $this and $that are hash or array
+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.
+
+B<NOTE> Display of scalar refs is not quite 100%
+
+=cut
+
+use vars qw(@Data_Stack);
+my $DNE = bless [], 'Does::Not::Exist';
+sub is_deeply {
+ my($this, $that, $name) = @_;
+
+ my $ok;
+ if( !ref $this || !ref $that ) {
+ $ok = $Test->is_eq($this, $that, $name);
+ }
+ else {
+ local @Data_Stack = ();
+ if( _deep_check($this, $that) ) {
+ $ok = $Test->ok(1, $name);
+ }
+ else {
+ $ok = $Test->ok(0, $name);
+ $ok = $Test->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' :
+ $val eq $DNE ? "Does not exist"
+ : "'$val'";
+ }
+
+ $out .= "$vars[0] = $vals[0]\n";
+ $out .= "$vars[1] = $vals[1]\n";
+
+ return $out;
+}
+
+
=item B<eq_array>
eq_array(\@this, \@that);
#'#
sub eq_array {
my($a1, $a2) = @_;
- return 0 unless @$a1 == @$a2;
return 1 if $a1 eq $a2;
my $ok = 1;
- for (0..$#{$a1}) {
- my($e1,$e2) = ($a1->[$_], $a2->[$_]);
+ my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
+ for (0..$max) {
+ my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
+ my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
+
+ push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] };
$ok = _deep_check($e1,$e2);
+ pop @Data_Stack if $ok;
+
last unless $ok;
}
return $ok;
{
$ok = eq_hash($e1, $e2);
}
+ elsif( UNIVERSAL::isa($e1, 'REF') and
+ UNIVERSAL::isa($e2, 'REF') )
+ {
+ push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
+ $ok = _deep_check($$e1, $$e2);
+ pop @Data_Stack if $ok;
+ }
+ elsif( UNIVERSAL::isa($e1, 'SCALAR') and
+ UNIVERSAL::isa($e2, 'SCALAR') )
+ {
+ push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
+ $ok = _deep_check($$e1, $$e2);
+ }
else {
+ push @Data_Stack, { vals => [$e1, $e2] };
$ok = 0;
}
}
sub eq_hash {
my($a1, $a2) = @_;
- return 0 unless keys %$a1 == keys %$a2;
return 1 if $a1 eq $a2;
my $ok = 1;
- foreach my $k (keys %$a1) {
- my($e1, $e2) = ($a1->{$k}, $a2->{$k});
+ my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
+ foreach my $k (keys %$bigger) {
+ my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
+ my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
+
+ push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] };
$ok = _deep_check($e1, $e2);
+ pop @Data_Stack if $ok;
+
last unless $ok;
}
use 5.004;
use strict 'vars';
-use Test::Utils;
-
use vars qw($VERSION);
+$VERSION = '0.32';
-$VERSION = '0.19';
-
-my(@Test_Results) = ();
-my($Num_Tests, $Planned_Tests, $Test_Died) = (0,0,0);
-my($Have_Plan) = 0;
-my $IsVMS = $^O eq 'VMS';
+use Test::Builder;
+my $Test = Test::Builder->new;
-
-# I'd like to have Test::Simple interfere with the program being
-# tested as little as possible. This includes using Exporter or
-# anything else (including strict).
sub import {
- # preserve caller()
- if( @_ > 1 ) {
- if( $_[1] eq 'no_plan' ) {
- goto &no_plan;
- }
- else {
- goto &plan
- }
- }
-}
-
-sub plan {
- my($class, %config) = @_;
-
- if( !exists $config{tests} ) {
- die "You have to tell $class how many tests you plan to run.\n".
- " use $class tests => 42; for example.\n";
- }
- elsif( !defined $config{tests} ) {
- die "Got an undefined number of tests. Looks like you tried to tell ".
- "$class how many tests you plan to run but made a mistake.\n";
- }
- elsif( !$config{tests} ) {
- die "You told $class you plan to run 0 tests! You've got to run ".
- "something.\n";
- }
- else {
- $Planned_Tests = $config{tests};
- }
-
- $Have_Plan = 1;
-
- my_print *TESTOUT, "1..$Planned_Tests\n";
-
- no strict 'refs';
- my($caller) = caller;
+ my $self = shift;
+ my $caller = caller;
*{$caller.'::ok'} = \&ok;
-
-}
-
-sub no_plan {
- $Have_Plan = 1;
-
- my($caller) = caller;
- no strict 'refs';
- *{$caller.'::ok'} = \&ok;
+ $Test->exported_to($caller);
+ $Test->plan(@_);
}
-unless( $^C ) {
- $| = 1;
- open(*TESTOUT, ">&STDOUT") or _whoa(1, "Can't dup STDOUT!");
- open(*TESTERR, ">&STDOUT") or _whoa(1, "Can't dup STDOUT!");
- {
- my $orig_fh = select TESTOUT;
- $| = 1;
- select TESTERR;
- $| = 1;
- select $orig_fh;
- }
-}
-
=head1 NAME
Test::Simple - Basic utilities for writing tests.
=cut
sub ok ($;$) {
- my($test, $name) = @_;
-
- unless( $Have_Plan ) {
- die "You tried to use ok() without a plan! Gotta have a plan.\n".
- " use Test::Simple tests => 23; for example.\n";
- }
-
- $Num_Tests++;
-
- my_print *TESTERR, <<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
-
-
- my($pack, $file, $line) = caller;
- # temporary special case for Test::More & Parrot::Test's calls.
- if( $pack eq 'Test::More' || $pack eq 'Parrot::Test' ) {
- ($pack, $file, $line) = caller(1);
- }
-
- my($is_todo) = ${$pack.'::TODO'} ? 1 : 0;
-
- # We must print this all in one shot or else it will break on VMS
- my $msg;
- unless( $test ) {
- $msg .= "not ";
- $Test_Results[$Num_Tests-1] = $is_todo ? 1 : 0;
- }
- else {
- $Test_Results[$Num_Tests-1] = 1;
- }
- $msg .= "ok $Num_Tests";
-
- if( defined $name ) {
- $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
- $msg .= " - $name";
- }
- if( $is_todo ) {
- my $what_todo = ${$pack.'::TODO'};
- $msg .= " # TODO $what_todo";
- }
- $msg .= "\n";
-
- my_print *TESTOUT, $msg;
-
- #'#
- unless( $test ) {
- my $msg = $is_todo ? "Failed (TODO)" : "Failed";
- my_print *TESTERR, "# $msg test ($file at line $line)\n";
- }
-
- return $test ? 1 : 0;
-}
-
-
-sub _skipped {
- my($why) = shift;
-
- unless( $Have_Plan ) {
- die "You tried to use ok() without a plan! Gotta have a plan.\n".
- " use Test::Simple tests => 23; for example.\n";
- }
-
- $Num_Tests++;
-
- # XXX Set this to "Skip" instead?
- $Test_Results[$Num_Tests-1] = 1;
-
- # We must print this all in one shot or else it will break on VMS
- my $msg;
- $msg .= "ok $Num_Tests # skip $why\n";
-
- my_print *TESTOUT, $msg;
-
- return 1;
+ $Test->ok(@_);
}
If you fail more than 254 tests, it will be reported as 254.
-=begin _private
-
-=over 4
-
-=item B<_sanity_check>
-
- _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 {
- _whoa($Num_Tests < 0, 'Says here you ran a negative number of tests!');
- _whoa(!$Have_Plan and $Num_Tests,
- 'Somehow your tests ran without a plan!');
- _whoa($Num_Tests != @Test_Results,
- 'Somehow you got a different number of results than tests ran!');
-}
-
-=item B<_whoa>
-
- _whoa($check, $description);
-
-A sanity check, similar to assert(). If the $check is true, something
-has gone horribly wrong. It will die with the given $description and
-a note to contact the author.
-
-=cut
-
-sub _whoa {
- my($check, $desc) = @_;
- if( $check ) {
- die <<WHOA;
-WHOA! $desc
-This should never happen! Please contact the author immediately!
-WHOA
- }
-}
-
-=item B<_my_exit>
-
- _my_exit($exit_num);
-
-Perl seems to have some trouble with exiting inside an END block. 5.005_03
-and 5.6.1 both seem to do odd things. Instead, this function edits $?
-directly. It should ONLY be called from inside an END block. It
-doesn't actually exit, that's your job.
-
-=cut
-
-sub _my_exit {
- $? = $_[0];
-
- return 1;
-}
-
-
-=back
-
-=end _private
-
-=cut
-
-$SIG{__DIE__} = sub {
- # We don't want to muck with death in an eval, but $^S isn't
- # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
- # with it. Instead, we use caller. This also means it runs under
- # 5.004!
- my $in_eval = 0;
- for( my $stack = 1; my $sub = (caller($stack))[3]; $stack++ ) {
- $in_eval = 1 if $sub =~ /^\(eval\)/;
- }
- $Test_Died = 1 unless $in_eval;
-};
-
-END {
- _sanity_check();
-
- # Bailout if import() was never called. This is so
- # "require Test::Simple" doesn't puke.
- do{ _my_exit(0) && return } if !$Have_Plan and !$Num_Tests;
-
- # Figure out if we passed or failed and print helpful messages.
- if( $Num_Tests ) {
- # The plan? We have no plan.
- unless( $Planned_Tests ) {
- my_print *TESTOUT, "1..$Num_Tests\n";
- $Planned_Tests = $Num_Tests;
- }
-
- my $num_failed = grep !$_, @Test_Results[0..$Planned_Tests-1];
- $num_failed += abs($Planned_Tests - @Test_Results);
-
- if( $Num_Tests < $Planned_Tests ) {
- my_print *TESTERR, <<"FAIL";
-# Looks like you planned $Planned_Tests tests but only ran $Num_Tests.
-FAIL
- }
- elsif( $Num_Tests > $Planned_Tests ) {
- my $num_extra = $Num_Tests - $Planned_Tests;
- my_print *TESTERR, <<"FAIL";
-# Looks like you planned $Planned_Tests tests but ran $num_extra extra.
-FAIL
- }
- elsif ( $num_failed ) {
- my_print *TESTERR, <<"FAIL";
-# Looks like you failed $num_failed tests of $Planned_Tests.
-FAIL
- }
-
- if( $Test_Died ) {
- my_print *TESTERR, <<"FAIL";
-# Looks like your test died just after $Num_Tests.
-FAIL
-
- _my_exit( 255 ) && return;
- }
-
- _my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
- }
- elsif ( $Test::Simple::Skip_All ) {
- _my_exit( 0 ) && return;
- }
- else {
- my_print *TESTERR, "# No tests run!\n";
- _my_exit( 255 ) && return;
- }
-}
-
-
-=pod
-
This module is by no means trying to be a complete testing system.
Its just to get you started. Once you're off the ground its
recommended you look at L<Test::More>.
Revision history for Perl extension Test::Simple
+0.32 Tue Oct 16 16:52:02 EDT 2001
+ * Finally added a seperate plan() function
+ * Adding a name field to isa_ok()
+ (Requested by Dave Rolsky)
+ - Test::More was using Carp.pm, causing the occasional false positive.
+ (Reported by Tatsuhiko Miyagawa)
+
+0.31 Mon Oct 8 19:24:53 EDT 2001
+ * Added an import option to Test::More
+ * Added no_ending and no_header options to Test::Builder
+ (Thanks to Dave Rolsky for giving this a swift kick in the ass)
+ * Added is_deeply(). Display of scalar refs not quite 100%
+ (Thanks to Stas Bekman for Apache::TestUtil idea thievery)
+ - Fixed a minor warning with skip()
+ (Thanks to Wolfgang Weisselberg for finding this one)
+
+0.30 Thu Sep 27 22:10:04 EDT 2001
+ * Added Test::Builder
+ * 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.
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::Builder;
+my $Test = Test::Builder->new;
+
+$Test->plan( tests => 4 );
+
+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');
+
-use Test::More tests => 22;
+#!perl -w
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::More tests => 24;
use_ok('Text::Soundex');
require_ok('Test::More');
[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),
har => { foo => 24, bar => 42 },
);
-
-ok( eq_hash(\%hash1, \%hash2),
- 'eq_hash with complicated hashes');
+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)],
# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
-use File::Spec;
+unless( eval { require File::Spec } ) {
+ print "1..0 # Skip Need File::Spec to run this test\n";
+ exit(0);
+}
my $test_num = 1;
# Utility testing functions.
+#!perl -w
+
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
require Test::Simple;
-push @INC, '../t/lib';
+push @INC, '../t/lib/';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
not ok 5 - Sar
OUT
- My::Test::ok($$err =~ /Looks like you planned 3 tests but ran 2 extra/);
+ My::Test::ok($$err eq <<ERR);
+# Failed test ($0 at line 31)
+# Failed test ($0 at line 34)
+# Looks like you planned 3 tests but ran 2 extra.
+ERR
exit 0;
}
# There was a bug with like() involving a qr// not failing properly.
# This tests against that.
-use strict;
-
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
+use strict;
+use lib '../t/lib';
+
+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;
package main;
require Test::More;
-
-push @INC, '../t/lib';
-require Test::Simple::Catch::More;
-my($out, $err) = Test::Simple::Catch::More::caught();
-
Test::More->import(tests => 1);
eval q{ like( "foo", qr/that/, 'is foo like that' ); };
-use strict;
+#!perl -w
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
+use strict;
+use lib '../t/lib';
+
+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;
package main;
require Test::More;
-
-push @INC, '../t/lib';
-require Test::Simple::Catch::More;
-my($out, $err) = Test::Simple::Catch::More::caught();
-
-Test::More->import(tests => 10);
+Test::More->import(tests => 12);
# Preserve the line numbers.
-#line 31
+#line 38
ok( 0, 'failing' );
is( "foo", "bar", 'foo is bar?');
isnt("foo", "foo", 'foo isnt foo?' );
can_ok('Mooble::Hooble::Yooble', qw(this that));
isa_ok(bless([], "Foo"), "Wibble");
+isa_ok(42, "Wibble", "My Wibble");
+isa_ok(undef, "Wibble", "Another Wibble");
use_ok('Hooble::mooble::yooble');
require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble');
END {
My::Test::ok($$out eq <<OUT, 'failing output');
-1..10
+1..12
not ok 1 - failing
not ok 2 - foo is bar?
not ok 3 - foo isnt foo?
not ok 5 - is foo like that
not ok 6 - fail()
not ok 7 - Mooble::Hooble::Yooble->can(...)
-not ok 8 - object->isa('Wibble')
-not ok 9 - use Hooble::mooble::yooble;
-not ok 10 - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;
+not ok 8 - The object isa Wibble
+not ok 9 - My Wibble isa Wibble
+not ok 10 - Another Wibble isa Wibble
+not ok 11 - use Hooble::mooble::yooble;
+not ok 12 - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;
OUT
my $err_re = <<ERR;
-# Failed test ($0 at line 31)
-# Failed test ($0 at line 32)
+# Failed test ($0 at line 38)
+# Failed test ($0 at line 39)
# got: 'foo'
# expected: 'bar'
-# Failed test ($0 at line 33)
+# Failed test ($0 at line 40)
# it should not be 'foo'
# but it is.
-# Failed test ($0 at line 34)
+# Failed test ($0 at line 41)
# it should not be 'foo'
# but it is.
-# Failed test ($0 at line 36)
+# Failed test ($0 at line 43)
# 'foo'
# doesn't match '/that/'
-# Failed test ($0 at line 38)
-# Failed test ($0 at line 40)
+# Failed test ($0 at line 45)
+# Failed test ($0 at line 47)
# Mooble::Hooble::Yooble->can('this') failed
# Mooble::Hooble::Yooble->can('that') failed
-# Failed test ($0 at line 41)
+# Failed test ($0 at line 48)
# The object isn't a 'Wibble'
+# Failed test ($0 at line 49)
+# My Wibble isn't a reference
+# Failed test ($0 at line 50)
+# Another Wibble isn't defined
ERR
my $filename = quotemeta $0;
my $more_err_re = <<ERR;
-# Failed test \\($filename at line 43\\)
+# Failed test \\($filename at line 52\\)
# Tried to use 'Hooble::mooble::yooble'.
# Error: Can't locate Hooble.* in \\\@INC .*
-# Failed test \\($filename at line 44\\)
+# Failed test \\($filename at line 53\\)
# Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'.
# Error: Can't locate ALL.* in \\\@INC .*
-# Looks like you failed 10 tests of 10.
+# Looks like you failed 12 tests of 12.
ERR
unless( My::Test::ok($$err =~ /^\Q$err_re\E$more_err_re$/,
-use strict;
+#!perl -w
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
+use strict;
+use lib qw(../t/lib);
+
+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;
package main;
require Test::Simple;
-
-push @INC, '../t/lib';
-require Test::Simple::Catch;
-my($out, $err) = Test::Simple::Catch::caught();
-
Test::Simple->import(tests => 5);
-#line 32
+#line 35
ok( 1, 'passing' );
ok( 2, 'passing still' );
ok( 3, 'still passing' );
not ok 5 - damnit
OUT
- My::Test::ok($$err =~ /Looks like you failed 2 tests of 5/);
+ My::Test::ok($$err eq <<ERR);
+# Failed test ($0 at line 38)
+# Failed test ($0 at line 39)
+# Looks like you failed 2 tests of 5.
+ERR
# Prevent Test::Simple from exiting with non zero
exit 0;
--- /dev/null
+#!perl -w
+
+use Test::More tests => 1;
+
+tie *STDOUT, "Dev::Null" or die $!;
+
+print "not ok 1\n"; # this should not print.
+pass 'STDOUT can be mucked with';
+
+
+package Dev::Null;
+
+sub TIEHANDLE { bless {} }
+sub PRINT { 1 }
--- /dev/null
+BEGIN {
+ chdir 't' if -d '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' );
--- /dev/null
+#!perl -w
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use strict;
+use lib qw(../t/lib);
+
+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);
+
+# Can't use Test.pm, that's a 5.005 thing.
+package main;
+
+print "1..22\n";
+
+my $test_num = 1;
+# Utility testing functions.
+sub is ($$;$) {
+ my($this, $that, $name) = @_;
+ my $test = $$this eq $that;
+ my $ok = '';
+ $ok .= "not " unless $test;
+ $ok .= "ok $test_num";
+ $ok .= " - $name" if defined $name;
+ $ok .= "\n";
+ print $ok;
+
+ unless( $test ) {
+ print "# got \n$$this";
+ print "# expected \n$that";
+ }
+ $test_num++;
+
+ $$this = '';
+
+ return $test;
+}
+
+sub like ($$;$) {
+ my($this, $regex, $name) = @_;
+
+ my $test = $$this =~ /$regex/;
+
+ my $ok = '';
+ $ok .= "not " unless $test;
+ $ok .= "ok $test_num";
+ $ok .= " - $name" if defined $name;
+ $ok .= "\n";
+ print $ok;
+
+ unless( $test ) {
+ print "# got \n$$this";
+ print "# expected \n$regex";
+ }
+ $test_num++;
+
+ $$this = '';
+
+
+ return $test;
+}
+
+
+require Test::More;
+Test::More->import(tests => 11, import => ['is_deeply']);
+
+my $Filename = quotemeta $0;
+
+#line 68
+is_deeply('foo', 'bar', 'plain strings');
+is( $out, "not ok 1 - plain strings\n", 'plain strings' );
+is( $err, <<ERR, ' right diagnostic' );
+# Failed test ($0 at line 68)
+# got: 'foo'
+# expected: 'bar'
+ERR
+
+
+#line 78
+is_deeply({}, [], 'different types');
+is( $out, "not ok 2 - different types\n", 'different types' );
+like( $err, <<ERR, ' right diagnostic' );
+# Failed test \\($Filename at line 78\\)
+# Structures begin differing at:
+# \\\$got = 'HASH\\(0x[0-9a-f]+\\)'
+# \\\$expected = 'ARRAY\\(0x[0-9a-f]+\\)'
+ERR
+
+#line 88
+is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values');
+is( $out, "not ok 3 - hashes with different values\n",
+ 'hashes with different values' );
+is( $err, <<ERR, ' right diagnostic' );
+# Failed test ($0 at line 88)
+# Structures begin differing at:
+# \$got->{this} = '42'
+# \$expected->{this} = '43'
+ERR
+
+#line 99
+is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys');
+is( $out, "not ok 4 - hashes with different keys\n",
+ 'hashes with different keys' );
+is( $err, <<ERR, ' right diagnostic' );
+# Failed test ($0 at line 99)
+# Structures begin differing at:
+# \$got->{this} = Does not exist
+# \$expected->{this} = '42'
+ERR
+
+#line 110
+is_deeply([1..9], [1..10], 'arrays of different length');
+is( $out, "not ok 5 - arrays of different length\n",
+ 'arrays of different length' );
+is( $err, <<ERR, ' right diagnostic' );
+# Failed test ($0 at line 110)
+# Structures begin differing at:
+# \$got->[9] = Does not exist
+# \$expected->[9] = '10'
+ERR
+
+#line 121
+is_deeply([undef, undef], [undef], 'arrays of undefs' );
+is( $out, "not ok 6 - arrays of undefs\n", 'arrays of undefs' );
+is( $err, <<ERR, ' right diagnostic' );
+# Failed test ($0 at line 121)
+# Structures begin differing at:
+# \$got->[1] = undef
+# \$expected->[1] = Does not exist
+ERR
+
+#line 131
+is_deeply({ foo => undef }, {}, 'hashes of undefs', 'hashes of undefs' );
+is( $out, "not ok 7 - hashes of undefs\n", 'hashes of undefs' );
+is( $err, <<ERR, ' right diagnostic' );
+# Failed test ($0 at line 131)
+# Structures begin differing at:
+# \$got->{foo} = undef
+# \$expected->{foo} = Does not exist
+ERR
+
+#line 141
+is_deeply(\42, \23, 'scalar refs');
+is( $out, "not ok 8 - scalar refs\n", 'scalar refs' );
+is( $err, <<ERR, ' right diagnostic' );
+# Failed test ($0 at line 141)
+# Structures begin differing at:
+# \${ \$got} = '42'
+# \${\$expected} = '23'
+ERR
+
+#line 151
+is_deeply([], \23, 'mixed scalar and array refs');
+is( $out, "not ok 9 - mixed scalar and array refs\n",
+ 'mixed scalar and array refs' );
+like( $err, <<ERR, ' right diagnostic' );
+# Failed test \\($Filename at line 151\\)
+# Structures begin differing at:
+# \\\$got = 'ARRAY\\(0x[0-9a-f]+\\)'
+# \\\$expected = 'SCALAR\\(0x[0-9a-f]+\\)'
+ERR
+
+
+my($a1, $a2, $a3);
+$a1 = \$a2; $a2 = \$a3;
+$a3 = 42;
+
+my($b1, $b2, $b3);
+$b1 = \$b2; $b2 = \$b3;
+$b3 = 23;
+
+#line 173
+is_deeply($a1, $b1, 'deep scalar refs');
+is( $out, "not ok 10 - deep scalar refs\n", 'deep scalar refs' );
+is( $err, <<ERR, ' right diagnostic' );
+# Failed test ($0 at line 173)
+# Structures begin differing at:
+# \${\${ \$got}} = '42'
+# \${\${\$expected}} = '23'
+ERR
+
+# I don't know how to properly display this structure.
+# $a2 = { foo => \$a3 };
+# $b2 = { foo => \$b3 };
+# is_deeply([$a1], [$b1], 'deep mixed scalar refs');
+
+my $foo = {
+ this => [1..10],
+ that => { up => "down", left => "right" },
+ };
+
+my $bar = {
+ this => [1..10],
+ that => { up => "down", left => "right", foo => 42 },
+ };
+
+#line 198
+is_deeply( $foo, $bar, 'deep structures' );
+is( $out, "not ok 11 - deep structures\n", 'deep structures' );
+is( $err, <<ERR, ' right diagnostic' );
+# Failed test ($0 at line 198)
+# Structures begin differing at:
+# \$got->{that}{foo} = Does not exist
+# \$expected->{that}{foo} = '42'
+ERR
-# Can't use Test.pm, that's a 5.005 thing.
-
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
+# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
print "1..2\n";
not ok 2 - Bar
OUT
- My::Test::ok($$err =~ /Looks like you planned 5 tests but only ran 2/);
+ My::Test::ok($$err eq <<ERR);
+# Failed test ($0 at line 31)
+# Looks like you planned 5 tests but only ran 2.
+ERR
exit 0;
}
--- /dev/null
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::Builder;
+
+BEGIN {
+ my $t = Test::Builder->new;
+ $t->no_ending(1);
+}
+
+use Test::More tests => 3;
+
+# Normally, Test::More would yell that we ran too few tests, but we
+# supressed the ending diagnostics.
+pass;
+print "ok 2\n";
+print "ok 3\n";
--- /dev/null
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+# STDOUT must be unbuffered else our prints might come out after
+# Test::More's.
+$| = 1;
+
+use Test::Builder;
+
+BEGIN {
+ Test::Builder->new->no_header(1);
+}
+
+use Test::More tests => 1;
+
+print "1..1\n";
+pass;
-# Can't use Test.pm, that's a 5.005 thing.
-
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
+# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
print "1..12\n";
My::Test::ok($$out eq '');
My::Test::ok($$err eq '');
-My::Test::ok($@ =~ /You told Test::Simple you plan to run 0 tests!/);
+My::Test::ok($@ =~ /You said to run 0 tests!/);
eval {
Test::Simple::ok(1);
};
-My::Test::ok( $@ =~ /You tried to use ok\(\) without a plan!/);
+My::Test::ok( $@ =~ /You tried to run a test without a plan!/);
END {
--- /dev/null
+#!perl -w
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+# Can't use Test.pm, that's a 5.005 thing.
+print "1..3\n";
+
+my $test_num = 1;
+# Utility testing functions.
+sub ok ($;$) {
+ my($test, $name) = @_;
+ my $ok = '';
+ $ok .= "not " unless $test;
+ $ok .= "ok $test_num";
+ $ok .= " - $name" if defined $name;
+ $ok .= "\n";
+ print $ok;
+ $test_num++;
+}
+
+use Test::Builder;
+my $Test = Test::Builder->new();
+
+my $result;
+my $out = $Test->output('foo');
+
+ok( defined $out );
+
+print $out "hi!\n";
+close *$out;
+
+undef $out;
+open(IN, 'foo') or die $!;
+chomp(my $line = <IN>);
+
+ok($line eq 'hi!');
+
+open(FOO, ">>foo") or die $!;
+$out = $Test->output(\*FOO);
+$old = select *$out;
+print "Hello!\n";
+close *$out;
+undef $out;
+select $old;
+open(IN, 'foo') or die $!;
+my @lines = <IN>;
+close IN;
+
+ok($lines[1] =~ /Hello!/);
+
+unlink('foo');
--- /dev/null
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::More;
+
+plan tests => 2;
+
+pass('Just testing plan()');
+pass('Testing it some more');
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
# This feature requires a fairly new version of Test::Harness
BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
require Test::Harness;
if( $Test::Harness::VERSION < 1.20 ) {
- print "1..0\n";
+ print "1..0 # Skipped: Need Test::Harness 1.20 or up\n";
exit(0);
}
}
require Test::Simple;
push @INC, '../t/lib';
-require Test::Simple::Catch::More;
-my($out, $err) = Test::Simple::Catch::More::caught();
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
Test::Simple->import('no_plan');
--- /dev/null
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+# Can't use Test.pm, that's a 5.005 thing.
+package My::Test;
+
+print "1..2\n";
+
+my $test_num = 1;
+# Utility testing functions.
+sub ok ($;$) {
+ my($test, $name) = @_;
+ my $ok = '';
+ $ok .= "not " unless $test;
+ $ok .= "ok $test_num";
+ $ok .= " - $name" if defined $name;
+ $ok .= "\n";
+ print $ok;
+ $test_num++;
+}
+
+
+package main;
+
+require Test::More;
+Test::More->import;
+my($out, $err);
+
+BEGIN {
+ require Test::Harness;
+}
+
+if( $Test::Harness::VERSION < 1.20 ) {
+ plan(skip_all => 'Need Test::Harness 1.20 or up');
+}
+else {
+ push @INC, '../t/lib';
+ require Test::Simple::Catch;
+ ($out, $err) = Test::Simple::Catch::caught();
+ plan('no_plan');
+}
+
+pass('Just testing');
+ok(1, 'Testing again');
+
+END {
+ My::Test::ok($$out eq <<OUT);
+ok 1 - Just testing
+ok 2 - Testing again
+1..2
+OUT
+
+ My::Test::ok($$err eq '');
+}
--- /dev/null
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::More;
+
+plan skip_all => 'Just testing plan & skip_all';
+
+fail('We should never get here');
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
use strict;
BEGIN { $| = 1; $^W = 1; }
-use Test::More tests => 9;
+#!perl -w
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::More tests => 15;
# If we skip with the same name, Test::Harness will report it back and
# we won't get lots of false bug reports.
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");
+}
+
-use strict;
-
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
}
+use strict;
+
# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
require Test::More;
push @INC, '../t/lib';
-require Test::Simple::Catch::More;
-my($out, $err) = Test::Simple::Catch::More::caught();
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
Test::More->import('skip_all');
-#! /usr/local/bin/perl -w
+#!perl -w
+
BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
+}
+
+BEGIN {
require Test::Harness;
require Test::More;
if( $Test::Harness::VERSION < 1.23 ) {
- Test::More->import(skip_all => 'Need the new Test::Harness');
+ Test::More->import(skip_all => 'Need Test::Harness 1.23 or up');
}
else {
Test::More->import(tests => 13);
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
use strict;
use Test::More tests => 10;
--- /dev/null
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
+
+use Test::More tests => 7;
+
+# Using Symbol because it's core and exports lots of stuff.
+{
+ package Foo::one;
+ ::use_ok("Symbol");
+ ::ok( defined &gensym, 'use_ok() no args exports defaults' );
+}
+
+{
+ package Foo::two;
+ ::use_ok("Symbol", qw(qualify));
+ ::ok( !defined &gensym, ' one arg, defaults overriden' );
+ ::ok( defined &qualify, ' right function exported' );
+}
+
+{
+ package Foo::three;
+ ::use_ok("Symbol", qw(gensym ungensym));
+ ::ok( defined &gensym && defined &ungensym, ' multiple args' );
+}
-use Test::More tests => 2;
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+}
-use_ok("Test::More");
+use Test::More tests => 5;
-use_ok("Test::Simple");
+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' );
+}
+++ /dev/null
-package Test::Utils;
-
-use 5.004;
-
-use strict;
-require Exporter;
-use vars qw($VERSION @EXPORT @EXPORT_TAGS @ISA);
-
-$VERSION = '0.02';
-
-@ISA = qw(Exporter);
-@EXPORT = qw( my_print print );
-
-
-
-# Special print function to guard against $\ and -l munging.
-sub my_print (*@) {
- my($fh, @args) = @_;
-
- return 1 if $^C;
-
- local $\;
- print $fh @args;
-}
-
-sub print { die "DON'T USE PRINT! Use _print instead" }
-
-1;
# For testing Test::Simple;
package Test::Simple::Catch;
-my $out = tie *Test::Simple::TESTOUT, __PACKAGE__;
-my $err = tie *Test::Simple::TESTERR, __PACKAGE__;
+use Symbol;
+my($out_fh, $err_fh) = (gensym, gensym);
+my $out = tie *$out_fh, __PACKAGE__;
+my $err = tie *$err_fh, __PACKAGE__;
-# We have to use them to shut up a "used only once" warning.
-() = (*Test::Simple::TESTOUT, *Test::Simple::TESTERR);
+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 }
-
-# Prevent Test::Simple from exiting in its END block.
-*Test::Simple::exit = sub {};
+sub caught { return($out, $err) }
sub PRINT {
my $self = shift;
sub READ {}
sub READLINE {}
sub GETC {}
+sub FILENO {}
1;
+++ /dev/null
-# For testing Test::More;
-package Test::Simple::Catch::More;
-
-my $out = tie *Test::Simple::TESTOUT, __PACKAGE__;
-tie *Test::More::TESTOUT, __PACKAGE__, $out;
-my $err = tie *Test::More::TESTERR, __PACKAGE__;
-tie *Test::Simple::TESTERR, __PACKAGE__, $err;
-
-# We have to use them to shut up a "used only once" warning.
-() = (*Test::More::TESTOUT, *Test::More::TESTERR);
-
-sub caught { return $out, $err }
-
-
-sub PRINT {
- my $self = shift;
- $$self .= join '', @_;
-}
-
-sub TIEHANDLE {
- my($class, $self) = @_;
- my $foo = '';
- $self = $self || \$foo;
- return bless $self, $class;
-}
-sub READ {}
-sub READLINE {}
-sub GETC {}
-
-1;
require Test::Simple;
-push @INC, 't/lib';
+use lib 't/lib';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
projects / p5sagit/p5-mst-13.2.git / commitdiff