use strict;
use vars qw($VERSION $CLASS);
-$VERSION = '0.15';
+$VERSION = '0.17';
$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;
-
# Make Test::Builder thread-safe for ithreads.
BEGIN {
use Config;
require threads;
require threads::shared;
threads::shared->import;
- share(\$Curr_Test);
- share(\@Test_Details);
- share(\@Test_Results);
}
else {
- *lock = sub { 0 };
+ *share = sub { 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
$Have_Plan = 1;
}
+=item B<has_plan>
+
+ $plan = $Test->has_plan
+
+Find out whether a plan has been defined. $plan is either C<undef> (no plan has been set), C<no_plan> (indeterminate # of tests) or an integer (the number of expected tests).
+
+=cut
+
+sub has_plan {
+ return($Expected_Tests) if $Expected_Tests;
+ return('no_plan') if $No_Plan;
+ return(undef);
+};
+
+
=item B<skip_all>
$Test->skip_all;
sub ok {
my($self, $test, $name) = @_;
+ # $test might contain an object which we don't want to accidentally
+ # store, so we turn it into a boolean.
+ $test = $test ? 1 : 0;
+
unless( $Have_Plan ) {
require Carp;
Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
my $todo = $self->todo($pack);
my $out;
+ my $result = {};
+ share($result);
+
unless( $test ) {
$out .= "not ";
- $Test_Results[$Curr_Test-1] = $todo ? 1 : 0;
+ @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
}
else {
- $Test_Results[$Curr_Test-1] = 1;
+ @$result{ 'ok', 'actual_ok' } = ( 1, $test );
}
$out .= "ok";
if( defined $name ) {
$name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
$out .= " - $name";
+ $result->{name} = $name;
+ }
+ else {
+ $result->{name} = '';
}
if( $todo ) {
my $what_todo = $todo;
$out .= " # TODO $what_todo";
+ $result->{reason} = $what_todo;
+ $result->{type} = 'todo';
+ }
+ else {
+ $result->{reason} = '';
+ $result->{type} = '';
}
+ $Test_Results[$Curr_Test-1] = $result;
$out .= "\n";
$self->_print($out);
lock($Curr_Test);
$Curr_Test++;
- $Test_Results[$Curr_Test-1] = 1;
+ my %result;
+ share(%result);
+ %result = (
+ '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++;
- $Test_Results[$Curr_Test-1] = 1;
+ my %result;
+ share(%result);
+ %result = (
+ '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;
$Curr_Test = $num;
if( $num > @Test_Results ) {
- my $start = @Test_Results ? $#Test_Results : 0;
+ my $start = @Test_Results ? $#Test_Results + 1 : 0;
for ($start..$num-1) {
- $Test_Results[$_] = 1;
+ my %result;
+ share(%result);
+ %result = ( ok => 1,
+ actual_ok => undef,
+ reason => 'incrementing test number',
+ type => 'unknown',
+ name => undef
+ );
+ $Test_Results[$_] = \%result;
}
}
}
sub summary {
my($self) = shift;
- return @Test_Results;
+ return map { $_->{'ok'} } @Test_Results;
}
-=item B<details> I<UNIMPLEMENTED>
+=item B<details>
my @tests = $Test->details;
Like summary(), but with a lot more detail.
$tests[$test_num - 1] =
- { ok => is the test considered ok?
+ { 'ok' => is the test considered a pass?
actual_ok => did it literally say 'ok'?
name => name of the test (if any)
- type => 'skip' or 'todo' (if any)
+ type => type of test (if any, see below).
reason => reason for the above (if any)
};
+'ok' is true if Test::Harness will consider the test to be a pass.
+
+'actual_ok' is a reflection of whether or not the test literally
+printed 'ok' or 'not ok'. This is for examining the result of 'todo'
+tests.
+
+'name' is the name of the test.
+
+'type' indicates if it was a special test. Normal tests have a type
+of ''. Type can be one of the following:
+
+ skip see skip()
+ todo see todo()
+ todo_skip see todo_skip()
+ unknown see below
+
+Sometimes the Test::Builder test counter is incremented without it
+printing any test output, for example, when current_test() is changed.
+In these cases, Test::Builder doesn't know the result of the test, so
+it's type is 'unkown'. These details for these tests are filled in.
+They are considered ok, but the name and actual_ok is left undef.
+
+For example "not ok 23 - hole count # TODO insufficient donuts" would
+result in this structure:
+
+ $tests[22] = # 23 - 1, since arrays start from 0.
+ { ok => 1, # logically, the test passed since it's todo
+ actual_ok => 0, # in absolute terms, it failed
+ name => 'hole count',
+ type => 'todo',
+ reason => 'insufficient donuts'
+ };
+
+=cut
+
+sub details {
+ return @Test_Results;
+}
+
=item B<todo>
my $todo_reason = $Test->todo;
_sanity_check();
+ # Don't bother with an ending if this is a forked copy. Only the parent
+ # should do the ending.
+ do{ _my_exit($?) && return } if $Original_Pid != $$;
+
# Bailout if plan() was never called. This is so
# "require Test::Simple" doesn't puke.
- do{ _my_exit(0) && return } if !$Have_Plan;
+ do{ _my_exit(0) && return } if !$Have_Plan && !$Test_Died;
# Figure out if we passed or failed and print helpful messages.
if( @Test_Results ) {
}
# 5.8.0 threads bug. Shared arrays will not be auto-extended
- # by a slice.
- $Test_Results[$Expected_Tests-1] = undef
- unless defined $Test_Results[$Expected_Tests-1];
+ # 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
+ unless defined $Test_Results[$idx];
+ }
- my $num_failed = grep !$_, @Test_Results[0..$Expected_Tests-1];
+ my $num_failed = grep !$_->{'ok'}, @Test_Results[0..$Expected_Tests-1];
$num_failed += abs($Expected_Tests - @Test_Results);
if( $Curr_Test < $Expected_Tests ) {
elsif ( $Skip_All ) {
_my_exit( 0 ) && return;
}
+ elsif ( $Test_Died ) {
+ $self->diag(<<'FAIL');
+Looks like your test died before it could output anything.
+FAIL
+ }
else {
$self->diag("No tests run!\n");
_my_exit( 255 ) && return;
=head1 COPYRIGHT
-Copyright 2001 by chromatic E<lt>chromatic@wgz.orgE<gt>,
+Copyright 2002 by chromatic E<lt>chromatic@wgz.orgE<gt>,
Michael G Schwern E<lt>schwern@pobox.comE<gt>.
This program is free software; you can redistribute it and/or
require Exporter;
use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.45';
+$VERSION = '0.47';
@ISA = qw(Exporter);
@EXPORT = qw(ok use_ok require_ok
is isnt like unlike is_deeply
Will produce something like this:
not ok 17 - Is foo the same as bar?
- # Failed test 1 (foo.t at line 139)
+ # Failed test (foo.t at line 139)
# got: 'waffle'
# expected: 'yarblokos'
skip "HTML::Lint not installed", 2 if $@;
my $lint = new HTML::Lint;
- ok( $lint, "Created object" );
+ isa_ok( $lint, "HTML::Lint" );
$lint->parse( $html );
- is( scalar $lint->errors, 0, "No errors found in HTML" );
+ is( $lint->errors, 0, "No errors found in HTML" );
}
If the user does not have HTML::Lint installed, the whole block of
important. This is a deep check, but the irrelevancy of order only
applies to the top level.
+B<NOTE> By historical accident, this is not a true set comparision.
+While the order of elements does not matter, duplicate elements do.
+
=cut
# We must make sure that references are treated neutrally. It really
use strict 'vars';
use vars qw($VERSION);
-$VERSION = '0.45';
+$VERSION = '0.47';
use Test::Builder;
Revision history for Perl extension Test::Simple
+0.47 Mon Aug 26 03:54:22 PDT 2002
+ * Tatsuhiko Miyagawa noticed Test::Builder was accidentally storing
+ objects passed into test functions causing problems with tests
+ relying on object destruction.
+ - Added example of calculating the number of tests to Test::Tutorial
+ - Peter Scott made the ending logic not fire on child processes when
+ forking.
+ * Test::Builder is once again ithread safe.
+
+0.46 Sat Jul 20 19:57:40 EDT 2002
+ - Noted eq_set() isn't really a set comparision.
+ - Test fix, exit codes are broken on MacPerl (bleadperl@16868)
+ - Make Test::Simple install itself into the core for >= 5.8
+ - Small fixes to Test::Tutorial and skip examples
+ * Added TB->has_plan() from Adrian Howard
+ - Clarified the meaning of 'actual_ok' from TB->details
+ * Added TB->details() from chromatic
+ - Neil Watkiss fixed a pre-5.8 test glitch with threads.t
+ * If the test died before a plan, it would exit with 0 [ID 20020716.013]
+
0.45 Wed Jun 19 18:41:12 EDT 2002
- Andy Lester made the SKIP & TODO docs a bit clearer.
- Explicitly disallowing double plans. (RT #553)
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use Test::More;
+use Test::Builder;
+my $Test = Test::Builder->new;
+
+$Test->plan( tests => 8 );
+$Test->level(0);
+
+my @Expected_Details;
+
+$Test->is_num( scalar $Test->summary(), 0, 'no tests yet, no summary' );
+push @Expected_Details, { 'ok' => 1,
+ actual_ok => 1,
+ name => 'no tests yet, no summary',
+ type => '',
+ reason => ''
+ };
+
+# Inline TODO tests will confuse pre 1.20 Test::Harness, so we
+# should just avoid the problem and not print it out.
+my $out_fh = $Test->output;
+my $start_test = $Test->current_test + 1;
+require TieOut;
+tie *FH, 'TieOut';
+$Test->output(\*FH);
+
+SKIP: {
+ $Test->skip( 'just testing skip' );
+}
+push @Expected_Details, { 'ok' => 1,
+ actual_ok => 1,
+ name => '',
+ type => 'skip',
+ reason => 'just testing skip',
+ };
+
+TODO: {
+ local $TODO = 'i need a todo';
+ $Test->ok( 0, 'a test to todo!' );
+
+ push @Expected_Details, { 'ok' => 1,
+ actual_ok => 0,
+ name => 'a test to todo!',
+ type => 'todo',
+ reason => 'i need a todo',
+ };
+
+ $Test->todo_skip( 'i need both' );
+}
+push @Expected_Details, { 'ok' => 1,
+ actual_ok => 0,
+ name => '',
+ type => 'todo_skip',
+ reason => 'i need both'
+ };
+
+for ($start_test..$Test->current_test) { print "ok $_\n" }
+$Test->output($out_fh);
+
+$Test->is_num( scalar $Test->summary(), 4, 'summary' );
+push @Expected_Details, { 'ok' => 1,
+ actual_ok => 1,
+ name => 'summary',
+ type => '',
+ reason => '',
+ };
+
+$Test->current_test(6);
+print "ok 6 - current_test incremented\n";
+push @Expected_Details, { 'ok' => 1,
+ actual_ok => undef,
+ name => undef,
+ type => 'unknown',
+ reason => 'incrementing test number',
+ };
+
+my @details = $Test->details();
+$Test->is_num( scalar @details, 6,
+ 'details() should return a list of all test details');
+
+$Test->level(1);
+is_deeply( \@details, \@Expected_Details );
+#!/usr/bin/perl -w
+
# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
'too_few.plx' => [4, 4],
'death.plx' => [255, 4],
'last_minute_death.plx' => [255, 4],
+ 'pre_plan_death.plx' => ['not zero', 'not zero'],
'death_in_eval.plx' => [0, 0],
'require.plx' => [0, 0],
);
my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file});
my $actual_exit = exitstatus($wait_stat);
- My::Test::ok( $actual_exit == $exit_code,
- "$test_name exited with $actual_exit (expected $exit_code)");
+ if( $exit_code eq 'not zero' ) {
+ My::Test::ok( $actual_exit != 0,
+ "$test_name exited with $actual_exit ".
+ "(expected $exit_code)");
+ }
+ else {
+ My::Test::ok( $actual_exit == $exit_code,
+ "$test_name exited with $actual_exit ".
+ "(expected $exit_code)");
+ }
}
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = '../lib';
+ }
+}
+
+use Test::More;
+use Config;
+
+if( !$Config{d_fork} ) {
+ plan skip_all => "This system cannot fork";
+}
+else {
+ plan tests => 1;
+}
+
+if( fork ) { # parent
+ pass("Only the parent should process the ending, not the child");
+}
+else {
+ exit; # child
+}
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib');
+ }
+}
+
+use strict;
+use Test::Builder;
+
+my $unplanned;
+
+BEGIN {
+ $unplanned = 'oops';
+ $unplanned = Test::Builder->has_plan;
+};
+
+use Test::More tests => 2;
+
+is($unplanned, undef, 'no plan yet defined');
+is(Test::Builder->has_plan, 2, 'has fixed plan');
--- /dev/null
+#!/usr/bin/perl -w
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = '../lib';
+ }
+}
+
+use Test::More;
+
+BEGIN {
+ if( !$ENV{HARNESS_ACTIVE} && $ENV{PERL_CORE} ) {
+ plan skip_all => "Won't work with t/TEST";
+ }
+}
+
+BEGIN {
+ require Test::Harness;
+}
+
+if( $Test::Harness::VERSION < 1.20 ) {
+ plan skip_all => 'Need Test::Harness 1.20 or up';
+}
+
+use strict;
+use Test::Builder;
+
+plan 'no_plan';
+is(Test::Builder->has_plan, 'no_plan', 'has no_plan');
--- /dev/null
+#!/usr/bin/perl -w
+
+# Testing to make sure Test::Builder doesn't accidentally store objects
+# passed in as test arguments.
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = '../lib';
+ }
+}
+
+use Test::More tests => 4;
+
+package Foo;
+my $destroyed = 0;
+sub new { bless {}, shift }
+
+sub DESTROY {
+ $destroyed++;
+}
+
+package main;
+
+for (1..3) {
+ ok(my $foo = Foo->new, 'created Foo object');
+}
+is $destroyed, 3, "DESTROY called 3 times";
+
+#!/usr/bin/perl -w
+
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
}
use Config;
-unless ($Config{'useithreads'}) {
+unless ($Config{'useithreads'} and eval { require threads; 1 }) {
print "1..0 # Skip: no threads\n";
exit 0;
}
be inclined to just throw more in as you think of them.
Only problem is, every time we add to that we have to keep adjusting
the C<use Test::More tests =E<gt> ##> line. That can rapidly get
-annoying. Instead we use C<no_plan>. This means we're just running
-some tests, don't know how many. [6]
+annoying. There's two ways to make this work better.
+
+First, we can calculate the plan dynamically using the C<plan()>
+function.
+
+ use Test::More;
+ use Date::ICal;
+
+ my %ICal_Dates = (
+ ...same as before...
+ );
+
+ # For each key in the hash we're running 8 tests.
+ plan tests => keys %ICal_Dates * 8;
+
+Or to be even more flexible, we use C<no_plan>. This means we're just
+running some tests, don't know how many. [6]
use Test::More 'no_plan'; # instead of tests => 32
the date in the Date::ICal test suite. So I'll write one.
use Test::More tests => 1;
+ use Date::ICal;
my $ical = Date::ICal->new;
$ical->ical('20201231Z');
--- /dev/null
+# ID 20020716.013, the exit code would become 0 if the test died
+# before a plan.
+
+require Test::Simple;
+
+push @INC, 't/lib';
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+
+close STDERR;
+die "Knife?";
+
+Test::Simple->import(tests => 3);
+
+ok(1);
+ok(1);
+ok(1);
$$self .= join('', @_);
}
-sub PRINTF {
- my $self = shift;
- my $fmt = shift;
- $$self .= sprintf $fmt, @_;
-}
-
sub read {
my $self = shift;
- return substr($$self, 0, length($$self), '');
+ my $out = $$self;
+ $$self = '';
+ return $out;
}
1;
projects / p5sagit/p5-mst-13.2.git / commitdiff