lib/Test/Simple/README Test::Simple README
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/diag.t Test::More diag() 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/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/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_ending.t Test::Builder test, no_ending()
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/strays.t Test::Builder stray newline 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
use strict;
use vars qw($VERSION $CLASS);
-$VERSION = '0.12';
+$VERSION = '0.14';
$CLASS = __PACKAGE__;
my $IsVMS = $^O eq 'VMS';
=head1 DESCRIPTION
-I<THIS IS ALPHA GRADE SOFTWARE> Meaning the underlying code is well
-tested, yet the interface is subject to 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 I<which can
die "You said to run 0 tests! You've got to run something.\n";
}
}
+ else {
+ require Carp;
+ my @args = grep { defined } ($cmd, $arg);
+ Carp::croak("plan() doesn't understand @args");
+ }
+
}
=item B<expected_tests>
my($self, $test, $name) = @_;
unless( $Have_Plan ) {
- die "You tried to run a test without a plan! Gotta have a plan.\n";
+ require Carp;
+ Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
}
$Curr_Test++;
}
}
- $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
+ return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
got: %s
expected: %s
DIAGNOSTIC
$self->_regex_ok($this, $regex, '!~', $name);
}
-sub _regex_ok {
- my($self, $this, $regex, $cmp, $name) = @_;
+=item B<maybe_regex>
- local $Level = $Level + 1;
+ $Test->maybe_regex(qr/$regex/);
+ $Test->maybe_regex('/$regex/');
- my $ok = 0;
- my $usable_regex;
+Convenience method for building testing functions that take regular
+expressions as arguments, but need to work before perl 5.005.
+
+Takes a quoted regular expression produced by qr//, or a string
+representing a regular expression.
+
+Returns a Perl value which may be used instead of the corresponding
+regular expression, or undef if it's argument is not recognised.
+
+For example, a version of like(), sans the useful diagnostic messages,
+could be written as:
+
+ sub laconic_like {
+ my ($self, $this, $regex, $name) = @_;
+ my $usable_regex = $self->maybe_regex($regex);
+ die "expecting regex, found '$regex'\n"
+ unless $usable_regex;
+ $self->ok($this =~ m/$usable_regex/, $name);
+ }
+
+=cut
+
+
+sub maybe_regex {
+ my ($self, $regex) = @_;
+ my $usable_regex = undef;
if( ref $regex eq 'Regexp' ) {
$usable_regex = $regex;
}
# Check if it looks like '/foo/'
elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
- $usable_regex = "(?$opts)$re";
- }
- else {
- $ok = $self->ok( 0, $name );
+ $usable_regex = length $opts ? "(?$opts)$re" : $re;
+ };
+ return($usable_regex)
+};
- $self->diag(" '$regex' doesn't look much like a regex to me.");
+sub _regex_ok {
+ my($self, $this, $regex, $cmp, $name) = @_;
+ local $Level = $Level + 1;
+
+ my $ok = 0;
+ my $usable_regex = $self->maybe_regex($regex);
+ unless (defined $usable_regex) {
+ $ok = $self->ok( 0, $name );
+ $self->diag(" '$regex' doesn't look much like a regex to me.");
return $ok;
}
$got = defined $got ? "'$got'" : 'undef';
$expect = defined $expect ? "'$expect'" : 'undef';
- $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
+ return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
%s
%s
%s
$why ||= '';
unless( $Have_Plan ) {
- die "You tried to run tests without a plan! Gotta have a plan.\n";
+ require Carp;
+ Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
}
$Curr_Test++;
$why ||= '';
unless( $Have_Plan ) {
- die "You tried to run tests without a plan! Gotta have a plan.\n";
+ require Carp;
+ Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
}
$Curr_Test++;
my $out = "not ok";
$out .= " $Curr_Test" if $self->use_numbers;
- $out .= " # TODO $why\n";
+ $out .= " # TODO & SKIP $why\n";
$Test->_print($out);
We encourage using this rather than calling print directly.
+Returns false. Why? Because diag() is often used in conjunction with
+a failing test (C<ok() || diag()>) it "passes through" the failure.
+
+ return ok(...) || diag(...);
+
+=for blame transfer
+Mark Fowler <mark@twoshortplanks.com>
+
=cut
sub diag {
# Escape each line with a #.
foreach (@msgs) {
+ $_ = 'undef' unless defined;
s/^/# /gms;
}
my $fh = $self->todo ? $self->todo_output : $self->failure_output;
local($\, $", $,) = (undef, ' ', '');
print $fh @msgs;
+
+ return 0;
}
=begin _private
local($\, $", $,) = (undef, ' ', '');
my $fh = $self->output;
+
+ # Escape each line after the first with a # so we don't
+ # confuse Test::Harness.
+ foreach (@msgs) {
+ s/\n(.)/\n# $1/sg;
+ }
+
+ push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
+
print $fh @msgs;
}
my($self, $num) = @_;
if( defined $num ) {
+
+ unless( $Have_Plan ) {
+ require Carp;
+ Carp::croak("Can't change the current test number without a plan!");
+ }
+
$Curr_Test = $num;
if( $num > @Test_Results ) {
- for ($#Test_Results..$num-1) {
+ my $start = @Test_Results ? $#Test_Results : 0;
+ for ($start..$num-1) {
$Test_Results[$_] = 1;
}
}
require Exporter;
use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.42';
+$VERSION = '0.44';
@ISA = qw(Exporter);
@EXPORT = qw(ok use_ok require_ok
is isnt like unlike is_deeply
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]};
+ my($tag, $imports) = splice @plan, $idx, 2;
+ @imports = @$imports;
last;
}
}
+ $Test->plan(@plan);
+
__PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
}
sub can_ok ($@) {
my($proto, @methods) = @_;
- my $class= ref $proto || $proto;
+ my $class = ref $proto || $proto;
unless( @methods ) {
my $ok = $Test->ok( 0, "$class->can(...)" );
my @nok = ();
foreach my $method (@methods) {
- my $test = "'$class'->can('$method')";
local($!, $@); # don't interfere with caller's $@
# eval sometimes resets $!
- eval $test || push @nok, $method;
+ eval { $proto->can($method) } || push @nok, $method;
}
my $name;
BEGIN { use_ok($module, @imports); }
These simply use the given $module and test to make sure the load
-happened ok. It is recommended that you run use_ok() inside a BEGIN
+happened ok. It's recommended that you run use_ok() inside a BEGIN
block so its functions are exported at compile-time and prototypes are
properly honored.
eval <<USE;
package $pack;
require $module;
-$module->import(\@imports);
+'$module'->import(\@imports);
USE
my $ok = $Test->ok( !$@, "use $module;" );
If pigs cannot fly, the whole block of tests will be skipped
completely. Test::More will output special ok's which Test::Harness
-interprets as skipped tests. It is important to include $how_many tests
+interprets as skipped tests. It's 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>, in which case you can leave $how_many off if
you like).
-It is perfectly safe to nest SKIP blocks.
+It's perfectly safe to nest SKIP blocks.
Tests are skipped when you B<never> expect them to B<ever> pass. Like
an optional module is not installed or the operating system doesn't
...normal testing code...
}
-With todo tests, it is best to have the tests actually run. That way
+With todo tests, it's best to have the tests actually run. That way
you'll know when they start passing. Sometimes this isn't possible.
Often a failing test will cause the whole program to die or hang, even
inside an C<eval BLOCK> with and using C<alarm>. In these extreme
=head1 SEE ALSO
L<Test::Simple> if all this confuses you and you just want to write
-some tests. You can upgrade to Test::More later (it is forward
+some tests. You can upgrade to Test::More later (it's forward
compatible).
L<Test::Differences> for more ways to test complex data structures.
use strict 'vars';
use vars qw($VERSION);
-$VERSION = '0.42';
+$VERSION = '0.44';
use Test::Builder;
ok( $foo eq $bar, $name );
ok( $foo eq $bar );
-ok() is given an expression (in this case C<$foo eq $bar>). If it is
-true, the test passed. If it is false, it didn't. That's about it.
+ok() is given an expression (in this case C<$foo eq $bar>). If it's
+true, the test passed. If it's false, it didn't. That's about it.
ok() prints out either "ok" or "not ok" along with a test number (it
keeps track of that for you).
If you provide a $name, that will be printed along with the "ok/not
ok" to make it easier to find your test when if fails (just search for
the name). It also makes it easier for the next guy to understand
-what your test is for. It is highly recommended you use test names.
+what your test is for. It's highly recommended you use test names.
All tests are run in scalar context. So this:
If you fail more than 254 tests, it will be reported as 254.
This module is by no means trying to be a complete testing system.
-It's just to get you started. Once you're off the ground it is
+It's 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.44 Thu Apr 25 00:27:27 EDT 2002
+ - names containing newlines no longer produce confusing output
+ (from chromatic)
+ - chromatic provided a fix so can_ok() honors can() overrides.
+ - Nick Ing-Simmons suggested todo_skip() be a bit clearer about
+ the skipping part.
+ - Making plan() vomit if it gets something it doesn't understand.
+ - Tatsuhiko Miyagawa fixed use_ok() with pragmata on older perls.
+ - quieting diag(undef)
+
+0.43 Thu Apr 11 22:55:23 EDT 2002
+ - Adrian Howard added TB->maybe_regex()
+ - Adding Mark Fowler's suggestion to make diag() return
+ false.
+ - TB->current_test() still not working when no tests were run via
+ TB itself. Fixed by Dave Rolsky.
+
0.42 Wed Mar 6 15:00:24 EST 2002
- Setting Test::Builder->current_test() now works (see what happens
when you forget to test things?)
use Test::Builder;
my $Test = Test::Builder->new;
-$Test->plan( tests => 7 );
+$Test->plan( tests => 9 );
my $default_lvl = $Test->level;
$Test->level(0);
print "ok $test_num - current_test() set\n";
$Test->ok( 1, 'counter still good' );
+
+eval { $Test->plan(7); };
+$Test->like( $@, q{/^plan\(\) doesn't understand 7/}, 'bad plan()' );
+
+eval { $Test->plan(wibble => 7); };
+$Test->like( $@, q{/^plan\(\) doesn't understand wibble 7/}, 'bad plan()' );
}
}
-use Test::More tests => 37;
+use Test::More tests => 41;
# Make sure we don't mess with $@ or $!. Test at bottom.
my $Err = "this should not be touched";
can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip
can_ok pass fail eq_array eq_hash eq_set));
+
isa_ok(bless([], "Foo"), "Foo");
isa_ok([], 'ARRAY');
isa_ok(\42, 'SCALAR');
+# can_ok() & isa_ok should call can() & isa() on the given object, not
+# just class, in case of custom can()
+{
+ local *Foo::can;
+ local *Foo::isa;
+ *Foo::can = sub { $_[0]->[0] };
+ *Foo::isa = sub { $_[0]->[0] };
+ my $foo = bless([0], 'Foo');
+ ok( ! $foo->can('bar') );
+ ok( ! $foo->isa('bar') );
+ $foo->[0] = 1;
+ can_ok( $foo, 'blah');
+ isa_ok( $foo, 'blah');
+}
+
+
pass('pass() passed');
ok( eq_array([qw(this that whatever)], [qw(this that whatever)]),
--- /dev/null
+#!/usr/bin/perl -w
+
+# Dave Rolsky found a bug where if current_test() is used and no
+# tests are run via Test::Builder it will blow up.
+
+use Test::Builder;
+$TB = Test::Builder->new;
+$TB->plan(tests => 2);
+print "ok 1\n";
+print "ok 2\n";
+$TB->current_test(2);
use strict;
-use Test::More tests => 5;
+use Test::More tests => 7;
my $Test = Test::More->builder;
my $output;
tie *FAKEOUT, 'FakeOut', \$output;
-# force diagnostic output to a filehandle, glad I added this to Test::Builder :)
+# force diagnostic output to a filehandle, glad I added this to
+# Test::Builder :)
my @lines;
+my $ret;
{
local $TODO = 1;
$Test->todo_output(\*FAKEOUT);
push @lines, $output;
$output = '';
- diag("multiple\n", "lines");
+ $ret = diag("multiple\n", "lines");
push @lines, split(/\n/, $output);
}
like( $lines[0], '/^#\s+/', ' should add comment mark to all lines' );
is( $lines[0], "# a single line\n", ' should send exact message' );
is( $output, "# multiple\n# lines\n", ' should append multi messages');
+ok( !$ret, 'diag returns false' );
{
- local $TODO = 1;
+ $Test->failure_output(\*FAKEOUT);
$output = '';
- diag("# foo");
+ $ret = diag("# foo");
}
+$Test->failure_output(\*STDERR);
is( $output, "# # foo\n", "diag() adds a # even if there's one already" );
-
+ok( !$ret, 'diag returns false' );
package FakeOut;
print "1..".keys(%Tests)."\n";
+eval { require POSIX; &POSIX::WEXITSTATUS(0) };
+if( $@ ) {
+ *exitstatus = sub { $_[0] >> 8 };
+}
+else {
+ *exitstatus = sub { POSIX::WEXITSTATUS($_[0]) }
+}
+
chdir 't';
my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests));
while( my($test_name, $exit_codes) = each %Tests ) {
my $file = File::Spec->catfile($lib, $test_name);
my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file});
- my $actual_exit = $wait_stat >> 8;
+ my $actual_exit = exitstatus($wait_stat);
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', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use strict;
+use Test::More tests => 10;
+
+use Test::Builder;
+my $Test = Test::Builder->new;
+
+SKIP: {
+ skip "qr// added in 5.005", 3 if $] < 5.005;
+
+ # 5.004 can't even see qr// or it pukes in compile.
+ eval q{
+ my $r = $Test->maybe_regex(qr/^FOO$/i);
+ ok(defined $r, 'qr// detected');
+ ok(('foo' =~ /$r/), 'qr// good match');
+ ok(('bar' !~ /$r/), 'qr// bad match');
+ };
+ die $@ if $@;
+}
+
+{
+ my $r = $Test->maybe_regex('/^BAR$/i');
+ ok(defined $r, '"//" detected');
+ ok(('bar' =~ m/$r/), '"//" good match');
+ ok(('foo' !~ m/$r/), '"//" bad match');
+};
+
+{
+ my $r = $Test->maybe_regex('not a regex');
+ ok(!defined $r, 'non-regex detected');
+};
+
+
+{
+ my $r = $Test->maybe_regex('/0/');
+ ok(defined $r, 'non-regex detected');
+ ok(('f00' =~ m/$r/), '"//" good match');
+ ok(('b4r' !~ m/$r/), '"//" bad match');
+};
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
- @INC = '../lib';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
}
}
# Can't use Test.pm, that's a 5.005 thing.
-print "1..3\n";
+print "1..4\n";
my $test_num = 1;
# Utility testing functions.
$ok .= "\n";
print $ok;
$test_num++;
+
+ return $test;
}
+use TieOut;
use Test::Builder;
my $Test = Test::Builder->new();
ok($lines[1] =~ /Hello!/);
unlink('foo');
+
+
+# Ensure stray newline in name escaping works.
+$out = tie *FAKEOUT, 'TieOut';
+$Test->output(\*FAKEOUT);
+$Test->exported_to(__PACKAGE__);
+$Test->no_ending(1);
+$Test->plan(tests => 5);
+
+$Test->ok(1, "ok");
+$Test->ok(1, "ok\n");
+$Test->ok(1, "ok, like\nok");
+$Test->skip("wibble\nmoof");
+$Test->todo_skip("todo\nskip\n");
+
+my $output = $out->read;
+ok( $output eq <<OUTPUT ) || print STDERR $output;
+1..5
+ok 1 - ok
+ok 2 - ok
+#
+ok 3 - ok, like
+# ok
+ok 4 # skip wibble
+# moof
+not ok 5 # TODO & SKIP todo
+# skip
+#
+OUTPUT
--- /dev/null
+#!/usr/bin/perl -w
+
+# Check that stray newlines in test output are probably handed.
+
+BEGIN {
+ print "1..0 # Skip not completed\n";
+ exit 0;
+}
+
+BEGIN {
+ if( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+chdir 't';
+
+use TieOut;
+local *FAKEOUT;
+my $out = tie *FAKEOUT, 'TieOut';
+
+
+use Test::Builder;
+my $Test = Test::Builder->new;
+my $orig_out = $Test->output;
+my $orig_err = $Test->failure_output;
+my $orig_todo = $Test->todo_output;
+
+$Test->output(\*FAKEOUT);
+$Test->failure_output(\*FAKEOUT);
+$Test->todo_output(\*FAKEOUT);
+$Test->no_plan();
+
+$Test->ok(1, "name\n");
+$Test->ok(0, "foo\nbar\nbaz");
+$Test->skip("\nmoofer");
+$Test->todo_skip("foo\n\n");
+
+#!/usr/bin/perl -w
+
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
- @INC = '../lib';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
}
}
use strict;
-use Test::More tests => 12;
+use Test::More tests => 14;
+use TieOut;
BEGIN { $^W = 1; }
is( $warnings, '', 'eq_hash() no warnings' );
+my $tb = Test::More->builder;
+
+use TieOut;
+my $caught = tie *CATCH, 'TieOut';
+my $old_fail = $tb->failure_output;
+$tb->failure_output(\*CATCH);
+diag(undef);
+$tb->failure_output($old_fail);
+
+is( $caught->read, "# undef\n" );
+is( $warnings, '', 'diag(undef) no warnings' );
+#!/usr/bin/perl -w
+
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
}
}
-use Test::More tests => 7;
+use Test::More tests => 10;
# Using Symbol because it's core and exports lots of stuff.
{
::use_ok("Symbol", qw(gensym ungensym));
::ok( defined &gensym && defined &ungensym, ' multiple args' );
}
+
+{
+ package Foo::four;
+ my $warn; local $SIG{__WARN__} = sub { $warn .= shift; };
+ ::use_ok("constant", qw(foo bar));
+ ::ok( defined &foo, 'constant' );
+ ::is( $warn, undef, 'no warning');
+}
projects / p5sagit/p5-mst-13.2.git / commitdiff