lib/Test/Simple/Changes Test::Simple changes
lib/Test/Simple.pm Basic utility for writing tests
lib/Test/Simple/README Test::Simple README
+lib/Test/Simple/t/00signature.t Test::Simple test
+lib/Test/Simple/t/00test_harness_check.t Test::Simple test
lib/Test/Simple/t/bad_plan.t Test::Builder plan() test
lib/Test/Simple/t/buffer.t Test::Builder buffering test
lib/Test/Simple/t/Builder.t Test::Builder tests
lib/Test/Simple/t/curr_test.t Test::Builder->curr_test tests
lib/Test/Simple/t/details.t Test::Builder tests
lib/Test/Simple/t/diag.t Test::More diag() test
+lib/Test/Simple/t/eq_set.t Test::Simple test
lib/Test/Simple/t/exit.t Test::Simple test, exit codes
lib/Test/Simple/t/extra.t Test::Simple test
+lib/Test/Simple/t/extra_one.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/fail_one.t Test::Simple test
lib/Test/Simple/t/filehandles.t Test::Simple test, STDOUT can be played with
lib/Test/Simple/t/fork.t Test::More fork tests
+lib/Test/Simple/t/harness_active.t Test::Simple test
lib/Test/Simple/t/has_plan2.t Test::More->plan tests
lib/Test/Simple/t/has_plan.t Test::Builder->plan tests
lib/Test/Simple/t/import.t Test::More test, importing functions
lib/Test/Simple/t/maybe_regex.t Test::Builder->maybe_regex() tests
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_diag.t Test::Simple test
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/ok_obj.t Test::Builder object tests
lib/Test/Simple/t/output.t Test::Builder test, output methods
+lib/Test/Simple/t/overload.t Test::Simple test
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/plan.t Test::More test, plan()
+lib/Test/Simple/t/reset.t Test::Simple test
lib/Test/Simple/t/simple.t Test::Simple test, basic stuff
lib/Test/Simple/t/skipall.t Test::More test, skip all tests
lib/Test/Simple/t/skip.t Test::More test, SKIP tests
lib/Test/Simple/t/strays.t Test::Builder stray newline checks
+lib/Test/Simple/t/thread_taint.t Test::Simple test
lib/Test/Simple/t/threads.t Test::Builder thread-safe checks
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/useing.t Test::More test, compile test
lib/Test/Simple/t/use_ok.t Test::More test, use_ok()
+lib/Test/Simple/TODO Test::Simple TODO
lib/Test/t/05_about_verbose.t See if Test works
lib/Test/t/fail.t See if Test works
lib/Test/t/mix.t See if Test works
t/lib/Math/BigInt/Scalar.pm Pure Perl module to support Math::BigInt
t/lib/Math/BigInt/Subclass.pm Empty subclass of BigInt for test
t/lib/Math/BigRat/Test.pm Math::BigRat test helper
+t/lib/NoExporter.pm Part of Test-Simple
t/lib/sample-tests/bailout Test data for Test::Harness
t/lib/sample-tests/bignum Test data for Test::Harness
t/lib/sample-tests/combined Test data for Test::Harness
$^C ||= 0;
use strict;
-use vars qw($VERSION $CLASS);
-$VERSION = '0.17_01';
-$CLASS = __PACKAGE__;
+use vars qw($VERSION);
+$VERSION = '0.19_01';
my $IsVMS = $^O eq 'VMS';
# Make Test::Builder thread-safe for ithreads.
BEGIN {
use Config;
- if( $] >= 5.008 && $Config{useithreads} ) {
- require threads;
+ # Load threads::shared when threads are turned on
+ if( $] >= 5.008 && $Config{useithreads} && $INC{'threads.pm'}) {
require threads::shared;
threads::shared->import;
}
+ # 5.8.0's threads::shared is busted when threads are off.
+ # We emulate it here.
else {
- *share = sub { 0 };
+ *share = sub { return $_[0] };
*lock = sub { 0 };
}
}
-use vars qw($Level);
-my($Test_Died) = 0;
-my($Have_Plan) = 0;
-my $Original_Pid = $$;
-my $Curr_Test = 0; share($Curr_Test);
-my @Test_Results = (); share(@Test_Results);
-my @Test_Details = (); share(@Test_Details);
-
=head1 NAME
=cut
-my $Test;
+my $Test = Test::Builder->new;
sub new {
my($class) = shift;
$Test ||= bless ['Move along, nothing to see here'], $class;
return $Test;
}
+=item B<reset>
+
+ $Test->reset;
+
+Reinitializes the Test::Builder singleton to its original state.
+Mostly useful for tests run in persistent environments where the same
+test might be run multiple times in the same process.
+
+=cut
+
+my $Test_Died;
+my $Have_Plan;
+my $No_Plan;
+my $Curr_Test; share($Curr_Test);
+use vars qw($Level);
+my $Original_Pid;
+my @Test_Results; share(@Test_Results);
+my @Test_Details; share(@Test_Details);
+
+my $Exported_To;
+my $Expected_Tests;
+
+my $Skip_All;
+
+my $Use_Nums;
+
+my($No_Header, $No_Ending);
+
+$Test->reset;
+
+sub reset {
+ my ($self) = @_;
+
+ $Test_Died = 0;
+ $Have_Plan = 0;
+ $No_Plan = 0;
+ $Curr_Test = 0;
+ $Level = 1;
+ $Original_Pid = $$;
+ @Test_Results = ();
+ @Test_Details = ();
+
+ $Exported_To = undef;
+ $Expected_Tests = 0;
+
+ $Skip_All = 0;
+
+ $Use_Nums = 1;
+
+ ($No_Header, $No_Ending) = (0,0);
+
+ $self->_dup_stdhandles unless $^C;
+
+ return undef;
+}
+
=back
=head2 Setting up tests
=cut
-my $Exported_To;
sub exported_to {
my($self, $pack) = @_;
=cut
-my $Expected_Tests = 0;
sub expected_tests {
my($self, $max) = @_;
=cut
-my($No_Plan) = 0;
sub no_plan {
$No_Plan = 1;
$Have_Plan = 1;
=cut
-my $Skip_All = 0;
sub skip_all {
my($self, $reason) = @_;
lock $Curr_Test;
$Curr_Test++;
+ # In case $name is a string overloaded object, force it to stringify.
+ local($@,$!);
+ eval {
+ if( defined $name ) {
+ require overload;
+ if( my $string_meth = overload::Method($name, '""') ) {
+ $name = $name->$string_meth();
+ }
+ }
+ };
+
$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.
my $todo = $self->todo($pack);
my $out;
- my $result = {};
- share($result);
+ my $result = &share({});
unless( $test ) {
$out .= "not ";
unless( $test ) {
my $msg = $todo ? "Failed (TODO)" : "Failed";
+ $self->_print_diag("\n") if $ENV{HARNESS_ACTIVE};
$self->diag(" $msg test ($file at line $line)\n");
}
my $test = defined $got || defined $dont_expect;
$self->ok($test, $name);
- $self->_cmp_diag('ne', $got, $dont_expect) unless $test;
+ $self->_cmp_diag($got, 'ne', $dont_expect) unless $test;
return $test;
}
my $test = defined $got || defined $dont_expect;
$self->ok($test, $name);
- $self->_cmp_diag('!=', $got, $dont_expect) unless $test;
+ $self->_cmp_diag($got, '!=', $dont_expect) unless $test;
return $test;
}
lock($Curr_Test);
$Curr_Test++;
- my %result;
- share(%result);
- %result = (
+ $Test_Results[$Curr_Test-1] = &share({
'ok' => 1,
actual_ok => 1,
name => '',
type => 'skip',
reason => $why,
- );
- $Test_Results[$Curr_Test-1] = \%result;
+ });
my $out = "ok";
$out .= " $Curr_Test" if $self->use_numbers;
lock($Curr_Test);
$Curr_Test++;
- my %result;
- share(%result);
- %result = (
+ $Test_Results[$Curr_Test-1] = &share({
'ok' => 1,
actual_ok => 0,
name => '',
type => 'todo_skip',
reason => $why,
- );
-
- $Test_Results[$Curr_Test-1] = \%result;
+ });
my $out = "not ok";
$out .= " $Curr_Test" if $self->use_numbers;
return $Level;
}
-$CLASS->level(1);
-
=item B<use_numbers>
=cut
-my $Use_Nums = 1;
sub use_numbers {
my($self, $use_nums) = @_;
$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.
+ends. It also changes the exit code as described below.
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) = @_;
push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
local $Level = $Level + 1;
- my $fh = $self->todo ? $self->todo_output : $self->failure_output;
- local($\, $", $,) = (undef, ' ', '');
- print $fh @msgs;
+ $self->_print_diag(@msgs);
return 0;
}
}
+=item B<_print_diag>
+
+ $Test->_print_diag(@msg);
+
+Like _print, but prints to the current diagnostic filehandle.
+
+=cut
+
+sub _print_diag {
+ my $self = shift;
+
+ local($\, $", $,) = (undef, ' ', '');
+ my $fh = $self->todo ? $self->todo_output : $self->failure_output;
+ print $fh @_;
+}
+
=item B<output>
$Test->output($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: $!";
+sub _autoflush {
+ my($fh) = shift;
+ my $old_fh = select $fh;
+ $| = 1;
+ select $old_fh;
+}
+
+
+my $Opened_Testhandles = 0;
+sub _dup_stdhandles {
+ my $self = shift;
+
+ $self->_open_testhandles unless $Opened_Testhandles;
# Set everything to unbuffered else plain prints to STDOUT will
# come out in the wrong order from our own prints.
_autoflush(\*TESTERR);
_autoflush(\*STDERR);
- $CLASS->output(\*TESTOUT);
- $CLASS->failure_output(\*TESTERR);
- $CLASS->todo_output(\*TESTOUT);
+ $Test->output(\*TESTOUT);
+ $Test->failure_output(\*TESTERR);
+ $Test->todo_output(\*TESTOUT);
}
-sub _autoflush {
- my($fh) = shift;
- my $old_fh = select $fh;
- $| = 1;
- select $old_fh;
+sub _open_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: $!";
+ $Opened_Testhandles = 1;
}
if( $num > @Test_Results ) {
my $start = @Test_Results ? $#Test_Results + 1 : 0;
for ($start..$num-1) {
- my %result;
- share(%result);
- %result = ( ok => 1,
- actual_ok => undef,
- reason => 'incrementing test number',
- type => 'unknown',
- name => undef
- );
- $Test_Results[$_] = \%result;
+ $Test_Results[$_] = &share({
+ 'ok' => 1,
+ actual_ok => undef,
+ reason => 'incrementing test number',
+ type => 'unknown',
+ name => undef
+ });
}
}
}
$Expected_Tests = $Curr_Test;
}
- # 5.8.0 threads bug. Shared arrays will not be auto-extended
- # by a slice. Worse, we have to fill in every entry else
- # we'll get an "Invalid value for shared scalar" error
- for my $idx ($#Test_Results..$Expected_Tests-1) {
- my %empty_result = ();
- share(%empty_result);
- $Test_Results[$idx] = \%empty_result
+ # 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..$Expected_Tests-1 ) {
+ $Test_Results[$idx] = $empty_result
unless defined $Test_Results[$idx];
}
$num_failed += abs($Expected_Tests - @Test_Results);
if( $Curr_Test < $Expected_Tests ) {
+ my $s = $Expected_Tests == 1 ? '' : 's';
$self->diag(<<"FAIL");
-Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
+Looks like you planned $Expected_Tests test$s but only ran $Curr_Test.
FAIL
}
elsif( $Curr_Test > $Expected_Tests ) {
my $num_extra = $Curr_Test - $Expected_Tests;
+ my $s = $Expected_Tests == 1 ? '' : 's';
$self->diag(<<"FAIL");
-Looks like you planned $Expected_Tests tests but ran $num_extra extra.
+Looks like you planned $Expected_Tests test$s but ran $num_extra extra.
FAIL
}
elsif ( $num_failed ) {
+ my $s = $num_failed == 1 ? '' : 's';
$self->diag(<<"FAIL");
-Looks like you failed $num_failed tests of $Expected_Tests.
+Looks like you failed $num_failed test$s of $Expected_Tests.
FAIL
}
$self->diag(<<'FAIL');
Looks like your test died before it could output anything.
FAIL
+ _my_exit( 255 ) && return;
}
else {
$self->diag("No tests run!\n");
$Test->_ending if defined $Test and !$Test->no_ending;
}
+=head1 EXIT CODES
+
+If all your tests passed, Test::Builder will exit with zero (which is
+normal). If anything failed it will exit with how many failed. If
+you run less (or more) tests than you planned, the missing (or extras)
+will be considered failures. If no tests were ever run Test::Builder
+will throw a warning and exit with 255. If the test died, even after
+having successfully completed all its tests, it will still be
+considered a failure and will exit with 255.
+
+So the exit codes are...
+
+ 0 all tests successful
+ 255 test died
+ 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.0 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 current_test() they will all be effected.
+Test::Builder is only thread-aware if threads.pm is loaded I<before>
+Test::Builder.
+
=head1 EXAMPLES
CPAN can provide the best examples. Test::Simple, Test::More,
require Exporter;
use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.47';
+$VERSION = '0.50';
@ISA = qw(Exporter);
@EXPORT = qw(ok use_ok require_ok
is isnt like unlike is_deeply
);
my $Test = Test::Builder->new;
+my $Show_Diag = 1;
# 5.004's Exporter doesn't have export_to_level.
use Test::More qw(no_plan);
+B<NOTE>: using no_plan requires a Test::Harness upgrade else it will
+think everything has failed. See L<BUGS and CAVEATS>)
+
In some cases, you'll want to completely skip an entire testing script.
use Test::More skip_all => $skip_reason;
$Test->exported_to($caller);
+ my @cleaned_plan;
my @imports = ();
- foreach my $idx (0..$#plan) {
+ my $idx = 0;
+ while( $idx <= $#plan ) {
if( $plan[$idx] eq 'import' ) {
- my($tag, $imports) = splice @plan, $idx, 2;
- @imports = @$imports;
- last;
+ @imports = @{$plan[$idx+1]};
+ $idx += 2;
+ }
+ elsif( $plan[$idx] eq 'no_diag' ) {
+ $Show_Diag = 0;
+ $idx++;
+ }
+ else {
+ push @cleaned_plan, $plan[$idx];
+ $idx++;
}
}
- $Test->plan(@plan);
+ $Test->plan(@cleaned_plan);
__PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
}
however do not be tempted to use them to find out if something is
true or false!
- # XXX BAD! $pope->isa('Catholic') eq 1
- is( $pope->isa('Catholic'), 1, 'Is the Pope Catholic?' );
+ # XXX BAD!
+ is( exists $brooklyn{tree}, 1, 'A tree grows in Brooklyn' );
-This does not check if C<$pope->isa('Catholic')> is true, it checks if
+This does not check if C<exists $brooklyn{tree}> is true, it checks if
it returns 1. Very different. Similar caveats exist for false and 0.
In these cases, use ok().
- ok( $pope->isa('Catholic') ), 'Is the Pope Catholic?' );
+ ok( exists $brooklyn{tree}, 'A tree grows in Brooklyn' );
For those grammatical pedants out there, there's an C<isn't()>
function which is an alias of isnt().
=cut
-sub unlike {
+sub unlike ($$;$) {
$Test->unlike(@_);
}
cmp_ok( $this, '==', $that, 'this == that' );
# ok( $this && $that );
- cmp_ok( $this, '&&', $that, 'this || that' );
+ cmp_ok( $this, '&&', $that, 'this && that' );
...etc...
Its advantage over ok() is when the test fails you'll know what $this
isa_ok($object, $class, $object_name);
isa_ok($ref, $type, $ref_name);
-Checks to see if the given $object->isa($class). Also checks to make
+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:
You might remember C<ok() or diag()> with the mnemonic C<open() or
die()>.
+All diag()s can be made silent by passing the "no_diag" option to
+Test::More. C<use Test::More tests => 1, 'no_diag'>. This is useful
+if you have diagnostics for personal testing but then wish to make
+them silent for release without commenting out each individual
+statement.
+
B<NOTE> The exact formatting of the diagnostic output is still
changing, but it is guaranteed that whatever you throw at it it won't
interfere with the test.
=cut
sub diag {
+ return unless $Show_Diag;
$Test->diag(@_);
}
use Some::Module qw(foo bar);
-don't try to do this:
+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');
...happening at compile time...
}
-instead, you want:
+because the notion of "compile-time" is relative. Instead, you want:
BEGIN { use_ok('Some::Module') }
BEGIN { ...some code that depends on the use... }
my($module, @imports) = @_;
@imports = () unless @imports;
- my $pack = caller;
+ my($pack,$filename,$line) = caller;
local($@,$!); # eval sometimes interferes with $!
- eval <<USE;
+
+ 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.
+ eval <<USE;
package $pack;
-require $module;
-'$module'->import(\@imports);
+use $module $imports[0];
USE
+ }
+ else {
+ eval <<USE;
+package $pack;
+use $module \@imports;
+USE
+ }
my $ok = $Test->ok( !$@, "use $module;" );
unless( $ok ) {
chomp $@;
+ $@ =~ s{^BEGIN failed--compilation aborted at .*$}
+ {BEGIN failed--compilation aborted at $filename line $line.}m;
$Test->diag(<<DIAGNOSTIC);
Tried to use '$module'.
Error: $@
Once a todo test starts succeeding, simply move it outside the block.
When the block is empty, delete it.
+B<NOTE>: TODO tests require a Test::Harness upgrade else it will
+treat it as a normal failure. See L<BUGS and CAVEATS>)
+
=item B<todo_skip>
see if they are equivalent. If the two structures are different, it
will display the place where they start differing.
-Barrie Slaymaker's Test::Differences module provides more in-depth
-functionality along these lines, and it plays well with Test::More.
-
-B<NOTE> Display of scalar refs is not quite 100%
+Test::Differences and Test::Deep provide more in-depth functionality
+along these lines.
=cut
use vars qw(@Data_Stack);
my $DNE = bless [], 'Does::Not::Exist';
sub is_deeply {
+ 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 @_;
+ }
+
my($this, $that, $name) = @_;
my $ok;
# We must make sure that references are treated neutrally. It really
# doesn't matter how we sort them, as long as both arrays are sorted
# with the same algorithm.
-sub _bogus_sort { local $^W = 0; ref $a ? 0 : $a cmp $b }
+sub _bogus_sort { local $^W = 0; ref $a ? -1 : ref $b ? 1 : $a cmp $b }
sub eq_set {
my($a1, $a2) = @_;
=back
+=head1 EXIT CODES
+
+If all your tests passed, Test::Builder will exit with zero (which is
+normal). If anything failed it will exit with how many failed. If
+you run less (or more) tests than you planned, the missing (or extras)
+will be considered failures. If no tests were ever run Test::Builder
+will throw a warning and exit with 255. If the test died, even after
+having successfully completed all its tests, it will still be
+considered a failure and will exit with 255.
+
+So the exit codes are...
+
+ 0 all tests successful
+ 255 test died
+ any other number how many failed (including missing or extras)
+
+If you fail more than 254 tests, it will be reported as 254.
+
+
=head1 NOTES
Test::More is B<explicitly> tested all the way back to perl 5.004.
-Test::More is thread-safe for perl 5.8.0 and up.
-
=head1 BUGS and CAVEATS
=over 4
+=item Threads
+
+Test::More will only be aware of threads if "use threads" has been done
+I<before> Test::More is loaded. This is ok:
+
+ use threads;
+ use Test::More;
+
+This may cause problems:
+
+ use Test::More
+ use threads;
+
=item Making your own ok()
If you are trying to extend Test::More, don't. Use Test::Builder
=item The eq_* family has some caveats.
-=item Test::Harness upgrades
+=item Test::Harness upgrade
no_plan and todo depend on new Test::Harness features and fixes. If
you're going to distribute tests that use no_plan or todo your
CPAN. If you avoid no_plan and TODO tests, the stock Test::Harness
will work fine.
-If you simply depend on Test::More, it's own dependencies will cause a
-Test::Harness upgrade.
+Installing Test::More should also upgrade Test::Harness.
=back
some tests. You can upgrade to Test::More later (it's forward
compatible).
-L<Test::Differences> for more ways to test complex data structures.
-And it plays well with Test::More.
-
L<Test> is the old testing module. Its main benefit is that it has
been distributed with Perl since 5.004_05.
L<Test::Harness> for details on how your test results are interpreted
by Perl.
-L<Test::Unit> describes a very featureful unit testing interface.
+L<Test::Differences> for more ways to test complex data structures.
+And it plays well with Test::More.
+
+L<Test::Class> is like XUnit but more perlish.
+
+L<Test::Deep> gives you more powerful complex data structure testing.
+
+L<Test::Unit> is XUnit style testing.
L<Test::Inline> shows the idea of embedded testing.
-L<SelfTest> is another approach to embedded testing.
+L<Bundle::Test> installs a whole bunch of useful test modules.
=head1 AUTHORS
Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
from Joshua Pritikin's Test module and lots of help from Barrie
-Slaymaker, Tony Bowden, chromatic and the perl-qa gang.
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic and the perl-qa gang.
=head1 COPYRIGHT
-Copyright 2001 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+Copyright 2001, 2002 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
use strict 'vars';
use vars qw($VERSION);
-$VERSION = '0.47';
+$VERSION = '0.50';
use Test::Builder;
-Revision history for Perl extension Test::Simple
+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 version control
+ system change.
+ - 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
--- /dev/null
+ Test use_ok() with imports better.
+
+ Add BAIL_OUT() (little known Test::Harness feature that basically
+ declares that the universe has turned out all wrong and the test
+ will now stop what it's doing and just go back to bed.)
+
+ Add a way to ask "Are we passing so far?". Probably a
+ Test::Builder method.
+
+ Finish (start?) Test::FAQ
+
+ Expand the Test::Tutorial
+
+ Restructure the Test::More synopsis.
+
+ Decide if the exit code behavior on failure is a useful default
+ case.
+
+ $^C exception control?
+
+ Document that everything goes through Test::Builder->ok()
+
+ Add test name to diagnostic output
+
+ Put a newline before the first diagnostic failure when in Test::Harness
+
+ Trap bare exit() calls.
+
+ Add diag() to details().
+
+ Add is_passing() method to check if we're passing?
+
+ Add at_end() callback?
+
+ Combine all *output methods into outputs().
+
+ Change *output* to return the old FH, not the new one when setting.
--- /dev/null
+#!/usr/bin/perl
+# $File: //member/autrijus/Module-Signature/t/0-signature.t $ $Author: autrijus $
+# $Revision: #5 $ $Change: 7212 $ $DateTime: 2003/07/28 14:21:21 $
+
+use strict;
+use Test::More tests => 1;
+
+SKIP: {
+ if (!eval { require Module::Signature; 1 }) {
+ skip("Next time around, consider install Module::Signature, ".
+ "so you can verify the integrity of this distribution.", 1);
+ }
+ elsif (!eval { require Socket; Socket::inet_aton('pgp.mit.edu') }) {
+ skip("Cannot connect to the keyserver", 1);
+ }
+ else {
+ ok(Module::Signature::verify() == Module::Signature::SIGNATURE_OK()
+ => "Valid signature" );
+ }
+}
+
+__END__
--- /dev/null
+#!/usr/bin/perl -w
+
+# A test to make sure the new Test::Harness was installed properly.
+
+use Test::More;
+plan tests => 1;
+
+require Test::Harness;
+unless( cmp_ok( $Test::Harness::VERSION, '>', 1.20, "T::H version" ) ) {
+ diag <<INSTRUCTIONS;
+
+Test::Simple/More/Builder has features which depend on a version of
+Test::Harness greater than 1.20. You have $Test::Harness::VERSION.
+Please install a new version from CPAN.
+
+If you've already tried to upgrade Test::Harness and still get this
+message, the new version may be "shadowed" by the old. Check the
+output of Test::Harness's "make install" for "## Differing version"
+messages. You can delete the old version by running
+"make install UNINST=1".
+
+INSTRUCTIONS
+}
+
}
}
-use Test::More tests => 41;
+use Test::More tests => 42;
# Make sure we don't mess with $@ or $!. Test at bottom.
my $Err = "this should not be touched";
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
}
}
+
+# Turn on threads here, if available, since this test tends to find
+# lots of threading bugs.
+use Config;
+BEGIN {
+ if( $] >= 5.008 && $Config{useithreads} ) {
+ require threads;
+ 'threads'->import;
+ }
+}
+
+
use strict;
use Test::More tests => 7;
--- /dev/null
+#!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 => 2;
+
+# RT 3747
+ok( eq_set([1, 2, [3]], [[3], 1, 2]) );
+ok( eq_set([1,2,[3]], [1,[3],2]) );
push @INC, '../t/lib/';
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
+local $ENV{HARNESS_ACTIVE} = 0;
Test::Simple->import(tests => 3);
--- /dev/null
+#!/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;
+
+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::Simple;
+Test::Simple->import(tests => 1);
+ok(1);
+ok(1);
+ok(1);
+
+END {
+ My::Test::ok($$out eq <<OUT);
+1..1
+ok 1
+ok 2
+ok 3
+OUT
+
+ My::Test::ok($$err eq <<ERR);
+# Looks like you planned 1 test but ran 2 extra.
+ERR
+
+ # Prevent Test::Simple from existing with non-zero
+ exit 0;
+}
# of high enough version.
BEGIN {
if( $] < 5.005 ) {
- print "1..0\n";
+ print "1..0 # Skipped Test requires qr//\n";
exit(0);
}
}
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.
# Failed test \\(.*\\)
# 'foo'
# doesn't match '\\(\\?-xism:that\\)'
-# Looks like you failed 1 tests of 1\\.
+# Looks like you failed 1 test of 1\\.
ERR
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;
-print "1..2\n";
+print "1..12\n";
my $test_num = 1;
# Utility testing functions.
}
+sub main::err ($) {
+ my($expect) = @_;
+ my $got = $err->read;
+
+ my $ok = ok( $got eq $expect );
+
+ unless( $ok ) {
+ print STDERR "$got\n";
+ print STDERR "$expect\n";
+ }
+
+ return $ok;
+}
+
+
package main;
require Test::More;
-my $Total = 28;
+my $Total = 29;
Test::More->import(tests => $Total);
+my $tb = Test::More->builder;
+$tb->use_numbers(0);
+
# Preserve the line numbers.
#line 38
ok( 0, 'failing' );
+err( <<ERR );
+# Failed test ($0 at line 38)
+ERR
#line 40
is( "foo", "bar", 'foo is bar?');
is( undef, '', 'undef is empty string?');
is( undef, 0, 'undef is 0?');
is( '', 0, 'empty string is 0?' );
-
-isnt("foo", "foo", 'foo isnt foo?' );
-isn't("foo", "foo",'foo isn\'t foo?' );
-
-like( "foo", '/that/', 'is foo like that' );
-unlike( "foo", '/foo/', 'is foo unlike foo' );
-
-# Nick Clark found this was a bug. Fixed in 0.40.
-like( "bug", '/(%)/', 'regex with % in it' );
-
-fail('fail()');
-
-#line 52
-can_ok('Mooble::Hooble::Yooble', qw(this that));
-can_ok('Mooble::Hooble::Yooble', ());
-
-isa_ok(bless([], "Foo"), "Wibble");
-isa_ok(42, "Wibble", "My Wibble");
-isa_ok(undef, "Wibble", "Another Wibble");
-isa_ok([], "HASH");
-
-#line 68
-cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' );
-cmp_ok( 42.1, '==', 23, , ' ==' );
-cmp_ok( 42, '!=', 42 , ' !=' );
-cmp_ok( 1, '&&', 0 , ' &&' );
-cmp_ok( 42, '==', "foo", ' == with strings' );
-cmp_ok( 42, 'eq', "foo", ' eq with numbers' );
-cmp_ok( undef, 'eq', 'foo', ' eq with undef' );
-
-# generate a $!, it changes its value by context.
--e "wibblehibble";
-my $Errno_Number = $!+0;
-my $Errno_String = $!.'';
-cmp_ok( $!, 'eq', '', ' eq with stringified errno' );
-cmp_ok( $!, '==', -1, ' eq with numerified errno' );
-
-#line 84
-use_ok('Hooble::mooble::yooble');
-require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble');
-
-#line 88
-END {
- My::Test::ok($$out eq <<OUT, 'failing output');
-1..$Total
-not ok 1 - failing
-not ok 2 - foo is bar?
-not ok 3 - undef is empty string?
-not ok 4 - undef is 0?
-not ok 5 - empty string is 0?
-not ok 6 - foo isnt foo?
-not ok 7 - foo isn't foo?
-not ok 8 - is foo like that
-not ok 9 - is foo unlike foo
-not ok 10 - regex with % in it
-not ok 11 - fail()
-not ok 12 - Mooble::Hooble::Yooble->can(...)
-not ok 13 - Mooble::Hooble::Yooble->can(...)
-not ok 14 - The object isa Wibble
-not ok 15 - My Wibble isa Wibble
-not ok 16 - Another Wibble isa Wibble
-not ok 17 - The object isa HASH
-not ok 18 - cmp_ok eq
-not ok 19 - ==
-not ok 20 - !=
-not ok 21 - &&
-not ok 22 - == with strings
-not ok 23 - eq with numbers
-not ok 24 - eq with undef
-not ok 25 - eq with stringified errno
-not ok 26 - eq with numerified errno
-not ok 27 - use Hooble::mooble::yooble;
-not ok 28 - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;
-OUT
-
- my $err_re = <<ERR;
-# Failed test ($0 at line 38)
+err( <<ERR );
# Failed test ($0 at line 40)
# got: 'foo'
# expected: 'bar'
# Failed test ($0 at line 43)
# got: ''
# expected: '0'
+ERR
+
+#line 45
+isnt("foo", "foo", 'foo isnt foo?' );
+isn't("foo", "foo",'foo isn\'t foo?' );
+isnt(undef, undef, 'undef isnt undef?');
+err( <<ERR );
# Failed test ($0 at line 45)
# 'foo'
# ne
# 'foo'
# ne
# 'foo'
+# Failed test ($0 at line 47)
+# undef
+# ne
+# undef
+ERR
+
+#line 48
+like( "foo", '/that/', 'is foo like that' );
+unlike( "foo", '/foo/', 'is foo unlike foo' );
+err( <<ERR );
# Failed test ($0 at line 48)
# 'foo'
# doesn't match '/that/'
# Failed test ($0 at line 49)
# 'foo'
# matches '/foo/'
-# Failed test ($0 at line 52)
+ERR
+
+# Nick Clark found this was a bug. Fixed in 0.40.
+like( "bug", '/(%)/', 'regex with % in it' );
+err( <<ERR );
+# Failed test ($0 at line 60)
# 'bug'
# doesn't match '/(%)/'
-# Failed test ($0 at line 54)
+ERR
+
+fail('fail()');
+err( <<ERR );
+# Failed test ($0 at line 67)
+ERR
+
+#line 52
+can_ok('Mooble::Hooble::Yooble', qw(this that));
+can_ok('Mooble::Hooble::Yooble', ());
+err( <<ERR );
# Failed test ($0 at line 52)
# Mooble::Hooble::Yooble->can('this') failed
# Mooble::Hooble::Yooble->can('that') failed
# Failed test ($0 at line 53)
# can_ok() called with no methods
+ERR
+
+#line 55
+isa_ok(bless([], "Foo"), "Wibble");
+isa_ok(42, "Wibble", "My Wibble");
+isa_ok(undef, "Wibble", "Another Wibble");
+isa_ok([], "HASH");
+err( <<ERR );
# Failed test ($0 at line 55)
# The object isn't a 'Wibble' it's a 'Foo'
# Failed test ($0 at line 56)
# Another Wibble isn't defined
# Failed test ($0 at line 58)
# The object isn't a 'HASH' it's a 'ARRAY'
+ERR
+
+#line 68
+cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' );
+cmp_ok( 42.1, '==', 23, , ' ==' );
+cmp_ok( 42, '!=', 42 , ' !=' );
+cmp_ok( 1, '&&', 0 , ' &&' );
+cmp_ok( 42, '==', "foo", ' == with strings' );
+cmp_ok( 42, 'eq', "foo", ' eq with numbers' );
+cmp_ok( undef, 'eq', 'foo', ' eq with undef' );
+err( <<ERR );
# Failed test ($0 at line 68)
# got: 'foo'
# expected: 'bar'
# Failed test ($0 at line 74)
# got: undef
# expected: 'foo'
+ERR
+
+# generate a $!, it changes its value by context.
+-e "wibblehibble";
+my $Errno_Number = $!+0;
+my $Errno_String = $!.'';
+#line 80
+cmp_ok( $!, 'eq', '', ' eq with stringified errno' );
+cmp_ok( $!, '==', -1, ' eq with numerified errno' );
+err( <<ERR );
# Failed test ($0 at line 80)
# got: '$Errno_String'
# expected: ''
# expected: -1
ERR
+#line 84
+use_ok('Hooble::mooble::yooble');
+require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble');
+
+#line 88
+END {
+ My::Test::ok($$out eq <<OUT, 'failing output');
+1..$Total
+not ok - failing
+not ok - foo is bar?
+not ok - undef is empty string?
+not ok - undef is 0?
+not ok - empty string is 0?
+not ok - foo isnt foo?
+not ok - foo isn't foo?
+not ok - undef isnt undef?
+not ok - is foo like that
+not ok - is foo unlike foo
+not ok - regex with % in it
+not ok - fail()
+not ok - Mooble::Hooble::Yooble->can(...)
+not ok - Mooble::Hooble::Yooble->can(...)
+not ok - The object isa Wibble
+not ok - My Wibble isa Wibble
+not ok - Another Wibble isa Wibble
+not ok - The object isa HASH
+not ok - cmp_ok eq
+not ok - ==
+not ok - !=
+not ok - &&
+not ok - == with strings
+not ok - eq with numbers
+not ok - eq with undef
+not ok - eq with stringified errno
+not ok - eq with numerified errno
+not ok - use Hooble::mooble::yooble;
+not ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;
+OUT
+
my $filename = quotemeta $0;
my $more_err_re = <<ERR;
# Failed test \\($filename at line 84\\)
# Tried to use 'Hooble::mooble::yooble'.
# Error: Can't locate Hooble.* in \\\@INC .*
+# BEGIN failed--compilation aborted at $filename line 84.
# Failed test \\($filename at line 85\\)
# Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'.
# Error: Can't locate ALL.* in \\\@INC .*
# Looks like you failed $Total tests of $Total.
ERR
- unless( My::Test::ok($$err =~ /^\Q$err_re\E$more_err_re$/,
+ unless( My::Test::ok($$err =~ /^$more_err_re$/,
'failing errors') ) {
print $$err;
}
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.
--- /dev/null
+#!/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();
+local $ENV{HARNESS_ACTIVE} = 0;
+
+
+# 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++;
+
+ return $test ? 1 : 0;
+}
+
+
+package main;
+
+require Test::Simple;
+Test::Simple->import(tests => 1);
+
+#line 45
+ok(0);
+
+END {
+ My::Test::ok($$out eq <<OUT);
+1..1
+not ok 1
+OUT
+
+ My::Test::ok($$err eq <<"ERR") || print $$err;
+# Failed test ($0 at line 45)
+# Looks like you failed 1 test of 1.
+ERR
+
+ # Prevent Test::Simple from existing with non-zero
+ exit 0;
+}
--- /dev/null
+#!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;
+
+print "1..4\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++;
+
+ return $test;
+}
+
+
+sub main::err ($) {
+ my($expect) = @_;
+ my $got = $err->read;
+
+ my $ok = ok( $got eq $expect );
+
+ unless( $ok ) {
+ print STDERR "got\n$got\n";
+ print STDERR "expected\n$expect\n";
+ }
+
+ return $ok;
+}
+
+
+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( <<ERR );
+# Failed test ($0 at line 62)
+ERR
+
+#line 72
+ is( 1, 0 );
+ err( <<ERR );
+# Failed test ($0 at line 72)
+# got: '1'
+# expected: '0'
+ERR
+}
+
+{
+ local $ENV{HARNESS_ACTIVE} = 1;
+
+#line 71
+ fail( "this fails" );
+ err( <<ERR );
+
+# Failed test ($0 at line 71)
+ERR
+
+
+#line 84
+ is( 1, 0 );
+ err( <<ERR );
+
+# Failed test ($0 at line 84)
+# got: '1'
+# expected: '0'
+ERR
+
+}
require Test::Harness;
}
-if( $Test::Harness::VERSION < 1.20 ) {
- plan skip_all => 'Need Test::Harness 1.20 or up';
+# This feature requires a fairly new version of Test::Harness
+if( $Test::Harness::VERSION < 2.03 ) {
+ plan tests => 1;
+ diag "Need Test::Harness 2.03 or up. You have $Test::Harness::VERSION.";
+ fail 'Need Test::Harness 2.03 or up';
+ exit;
}
use strict;
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;
-print "1..22\n";
+print "1..25\n";
my $test_num = 1;
# Utility testing functions.
sub like ($$;$) {
my($this, $regex, $name) = @_;
-
- my $test = $$this =~ /$regex/;
+
+ $regex = qr/$regex/ unless ref $regex;
+ my $test = $$this =~ $regex;
my $ok = '';
$ok .= "not " unless $test;
ERR
#line 131
-is_deeply({ foo => undef }, {}, 'hashes of undefs', 'hashes of undefs' );
+is_deeply({ foo => undef }, {}, 'hashes of undefs' );
is( $out, "not ok 7 - hashes of undefs\n", 'hashes of undefs' );
is( $err, <<ERR, ' right diagnostic' );
# Failed test ($0 at line 131)
# \$got->{that}{foo} = Does not exist
# \$expected->{that}{foo} = '42'
ERR
+
+
+#line 221
+my @tests = ([],
+ [qw(42)],
+ [qw(42 23), qw(42 23)]
+ );
+
+foreach my $test (@tests) {
+ my $num_args = @$test;
+
+ my $warning;
+ local $SIG{__WARN__} = sub { $warning .= join '', @_; };
+ is_deeply(@$test);
+
+ like \$warning,
+ qr/^is_deeply\(\) takes two or three args, you gave $num_args\.\n/;
+}
require Test::Simple::Catch;
my($out, $err) = Test::Simple::Catch::caught();
+local $ENV{HARNESS_ACTIVE} = 0;
Test::Simple->import(tests => 5);
--- /dev/null
+#!/usr/bin/perl -w
+
+use Test::More 'no_diag', tests => 1;
+
+pass('foo');
+diag('This should not be displayed');
unshift @INC, 't/lib';
}
}
+chdir 't';
+
# Can't use Test.pm, that's a 5.005 thing.
print "1..4\n";
my $Test = Test::Builder->new();
my $result;
-my $out = $Test->output('foo');
+my $tmpfile = 'foo.tmp';
+my $out = $Test->output($tmpfile);
+END { unlink($tmpfile) }
ok( defined $out );
close *$out;
undef $out;
-open(IN, 'foo') or die $!;
+open(IN, $tmpfile) or die $!;
chomp(my $line = <IN>);
close IN;
ok($line eq 'hi!');
-open(FOO, ">>foo") or die $!;
+open(FOO, ">>$tmpfile") or die $!;
$out = $Test->output(\*FOO);
$old = select *$out;
print "Hello!\n";
close *$out;
undef $out;
select $old;
-open(IN, 'foo') or die $!;
+open(IN, $tmpfile) or die $!;
my @lines = <IN>;
close IN;
ok($lines[1] =~ /Hello!/);
-unlink('foo');
# Ensure stray newline in name escaping works.
--- /dev/null
+#!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;
+
+BEGIN {
+ if( !eval "require overload" ) {
+ plan skip_all => "needs overload.pm";
+ }
+ else {
+ plan tests => 3;
+ }
+}
+
+
+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 '', @_ };
+my $obj = Overloaded->new('foo');
+ok( 1, $obj );
+
+my $undef = Overloaded->new(undef);
+pass( $undef );
+
+is( $warnings, '' );
# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
-BEGIN {
- if( !$ENV{HARNESS_ACTIVE} && $ENV{PERL_CORE} ) {
- print "1..0 # Skipped: Won't work with t/TEST\n";
- exit 0;
- }
-
- # This feature requires a fairly new version of Test::Harness
- require Test::Harness;
- if( $Test::Harness::VERSION < 1.20 ) {
- print "1..0 # Skipped: Need Test::Harness 1.20 or up\n";
- exit(0);
- }
-}
-
print "1..2\n";
my $test_num = 1;
require Test::Harness;
}
-if( $Test::Harness::VERSION < 1.20 ) {
- plan skip_all => 'Need Test::Harness 1.20 or up';
-}
-else {
- plan 'no_plan';
+# This feature requires a fairly new version of Test::Harness
+if( $Test::Harness::VERSION < 2.03 ) {
+ plan tests => 1;
+ diag "Need Test::Harness 2.03 or up. You have $Test::Harness::VERSION.";
+ fail 'Need Test::Harness 2.03 or up';
+ exit;
}
+plan 'no_plan';
+
pass('Just testing');
ok(1, 'Testing again');
--- /dev/null
+#!/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 $tb = Test::Builder->new;
+$tb->plan(tests => 14);
+$tb->level(0);
+
+# Alter the state of Test::Builder as much as possible.
+$tb->ok(1, "Running a test to alter TB's state");
+
+my $tmpfile = 'foo.tmp';
+
+$tb->output($tmpfile);
+$tb->failure_output($tmpfile);
+$tb->todo_output($tmpfile);
+END { unlink $tmpfile }
+
+# This won't print since we just sent output off to oblivion.
+$tb->ok(0, "And a failure for fun");
+
+$Test::Builder::Level = 3;
+
+$tb->exported_to('Foofer');
+
+$tb->use_numbers(0);
+$tb->no_header(1);
+$tb->no_ending(1);
+
+
+# Now reset it.
+$tb->reset;
+
+my $test_num = 2; # since we already printed 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++;
+
+ return $test;
+}
+
+
+ok( !defined $tb->exported_to, 'exported_to' );
+ok( $tb->expected_tests == 0, 'expected_tests' );
+ok( $tb->level == 1, 'level' );
+ok( $tb->use_numbers == 1, 'use_numbers' );
+ok( $tb->no_header == 0, 'no_header' );
+ok( $tb->no_ending == 0, 'no_ending' );
+ok( fileno $tb->output == fileno *Test::Builder::TESTOUT,
+ 'output' );
+ok( fileno $tb->failure_output == fileno *Test::Builder::TESTERR,
+ 'failure_output' );
+ok( fileno $tb->todo_output == fileno *Test::Builder::TESTOUT,
+ 'todo_output' );
+ok( $tb->current_test == 0, 'current_test' );
+ok( $tb->summary == 0, 'summary' );
+ok( $tb->details == 0, 'details' );
+
+$tb->no_ending(1);
+$tb->no_header(1);
+$tb->plan(tests => 14);
+$tb->current_test(13);
+$tb->level(0);
+$tb->ok(1, 'final test to make sure output was reset');
--- /dev/null
+#!/usr/bin/perl -w
+
+use Test::More tests => 1;
+
+ok( !$INC{'threads.pm'}, 'Loading Test::More does not load threads.pm' );
\ No newline at end of file
}
use Config;
-unless ($Config{'useithreads'} and eval { require threads; 1 }) {
- print "1..0 # Skip: no threads\n";
- exit 0;
+BEGIN {
+ unless ( $] >= 5.008 && $Config{'useithreads'} &&
+ eval { require threads; 'threads'->import; 1; })
+ {
+ print "1..0 # Skip: no threads\n";
+ exit 0;
+ }
}
use strict;
-require threads;
use Test::Builder;
my $Test = Test::Builder->new;
}
}
-BEGIN {
- require Test::Harness;
- use Test::More;
-
- if( $Test::Harness::VERSION < 1.23 ) {
- plan skip_all => 'Need Test::Harness 1.23 or up';
- }
- else {
- plan tests => 15;
- }
+require Test::Harness;
+use Test::More;
+
+# This feature requires a fairly new version of Test::Harness
+(my $th_version = $Test::Harness::VERSION) =~ s/_//; # for X.Y_Z alpha versions
+if( $th_version < 2.03 ) {
+ plan tests => 1;
+ fail "Need Test::Harness 2.03 or up. You have $th_version.";
+ exit;
}
+plan tests => 15;
+
+
$Why = 'Just testing the todo interface.';
TODO: {
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
- @INC = '../lib';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
}
}
-use Test::More tests => 10;
+use Test::More tests => 13;
# Using Symbol because it's core and exports lots of stuff.
{
::ok( defined &foo, 'constant' );
::is( $warn, undef, 'no warning');
}
+
+{
+ package Foo::five;
+ ::use_ok("Symbol", 1.02);
+}
+
+{
+ package Foo::six;
+ ::use_ok("NoExporter", 1.02);
+}
+
+{
+ package Foo::seven;
+ local $SIG{__WARN__} = sub {
+ # Old perls will warn on X.YY_ZZ style versions. Not our problem
+ warn @_ unless $_[0] =~ /^Argument "\d+\.\d+_\d+" isn't numeric/;
+ };
+ ::use_ok("Test::More", 0.47);
+}
=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 effects I<all> code in your program
+features. Once you turn it on, it affects I<all> code in your program
and I<all> modules used (and all the modules they use). If a single
piece of code isn't taint clean, the whole thing explodes. With that
in mind, it's very important to ensure your module works under taint
#!/usr/bin/perl -Tw
- use Test::More 'no_plan';
-
...test normally here...
So when you say C<make test> it will be run with taint mode and
--- /dev/null
+package NoExporter;
+
+$VERSION = 1.02;
+sub import {
+ shift;
+ die "NoExporter exports nothing. You asked for: @_" if @_;
+}
+
+1;
+
package Test::Simple::Catch;
use Symbol;
+use TieOut;
my($out_fh, $err_fh) = (gensym, gensym);
-my $out = tie *$out_fh, __PACKAGE__;
-my $err = tie *$err_fh, __PACKAGE__;
+my $out = tie *$out_fh, 'TieOut';
+my $err = tie *$err_fh, 'TieOut';
use Test::Builder;
my $t = Test::Builder->new;
sub caught { return($out, $err) }
-sub PRINT {
- my $self = shift;
- $$self .= join '', @_;
-}
-
-sub TIEHANDLE {
- my $class = shift;
- my $self = '';
- return bless \$self, $class;
-}
-sub READ {}
-sub READLINE {}
-sub GETC {}
-sub FILENO {}
-
1;
package TieOut;
sub TIEHANDLE {
- bless( \(my $scalar), $_[0]);
+ my $scalar = '';
+ bless( \$scalar, $_[0]);
}
sub PRINT {
- my $self = shift;
- $$self .= join('', @_);
+ my $self = shift;
+ $$self .= join('', @_);
}
sub PRINTF {
- my $self = shift;
+ my $self = shift;
my $fmt = shift;
- $$self .= sprintf $fmt, @_;
+ $$self .= sprintf $fmt, @_;
}
sub read {
- my $self = shift;
- return substr($$self, 0, length($$self), '');
+ my $self = shift;
+ my $data = $$self;
+ $$self = '';
+ return $data;
}
1;
projects / p5sagit/p5-mst-13.2.git / commitdiff