9 Test::Leaner - A slimmer Test::More for when you favor performance over completeness.
17 our $VERSION = '0.01';
21 use Test::Leaner tests => 10_000;
24 is $one, 1, "checking situation $_";
30 When profiling some L<Test::More>-based test script that contained about 10 000 unit tests, I realized that 60% of the time was spent in L<Test::Builder> itself, even though every single test actually involved a costly C<eval STRING>.
32 This module aims to be a partial replacement to L<Test::More> in those situations where you want to run a large number of simple tests.
39 if ($] >= 5.008 and $INC{'threads.pm'}) {
40 my $use_ithreads = do {
43 $Config::Config{useithreads};
46 require threads::shared;
47 *THREADSAFE = sub () { 1 };
50 unless (defined &Test::Leaner::THREADSAFE) {
51 *THREADSAFE = sub () { 0 }
55 my $TAP_STREAM = *STDOUT;
56 my $DIAG_STREAM = *STDERR;
58 for ($TAP_STREAM, $DIAG_STREAM) {
64 my ($plan, $test, $failed, $no_diag, $done_testing);
67 sub SKIP_ALL () { -2 }
71 threads::shared::share($_) for $plan, $test, $failed, $no_diag, $done_testing;
74 lock $plan if THREADSAFE;
82 my $level = 1 + ($Test::Builder::Level || 0);
83 my ($file, $line) = (caller $level)[1, 2];
84 warn @_, " at $file line $line.\n";
88 my $level = 1 + ($Test::Builder::Level || 0);
89 my ($file, $line) = (caller $level)[1, 2];
90 die @_, " at $file line $line.\n";
93 sub sanitize_comment {
101 The following functions from L<Test::More> are implemented and exported by default.
103 =head2 C<< plan [ tests => $count | 'no_plan' | skip_all => $reason ] >>
108 my ($key, $value) = @_;
112 lock $plan if THREADSAFE;
114 croak("You tried to plan twice") if defined $plan;
118 if ($key eq 'no_plan') {
119 croak("no_plan takes no arguments") if $value;
121 } elsif ($key eq 'tests') {
122 croak("Got an undefined number of tests") unless defined $value;
123 croak("You said to run 0 tests") unless $value;
124 croak("Number of tests must be a positive integer. You gave it '$value'")
125 unless $value =~ /^\+?[0-9]+$/;
127 $plan_str = "1..$value";
128 } elsif ($key eq 'skip_all') {
130 $plan_str = '1..0 # SKIP';
131 if (defined $value) {
132 sanitize_comment($value);
133 $plan_str .= " $value" if length $value;
136 my @args = grep defined, $key, $value;
137 croak("plan() doesn't understand @args");
140 if (defined $plan_str) {
142 print $TAP_STREAM "$plan_str\n";
145 exit 0 if $plan == SKIP_ALL;
177 if ($item eq 'import') {
178 push @imports, @{ $_[$i+1] };
180 } elsif ($item eq 'no_diag') {
181 lock $plan if THREADSAFE;
187 splice @_, $i, $splice;
194 local $Test::Builder::Level = ($Test::Builder::Level || 0) + 1;
198 @_ = ($class, @imports);
199 goto &Exporter::import;
202 =head2 C<skip_all $reason>
207 @_ = (skip_all => $_[0]);
211 =head2 C<< skip $reason => $count >>
216 my ($reason, $count) = @_;
218 lock $plan if THREADSAFE;
220 if (not defined $count) {
221 carp("skip() needs to know \$how_many tests are in the block")
222 unless defined $plan and $plan == NO_PLAN;
224 } elsif ($count =~ /[^0-9]/) {
225 carp('skip() was passed a non-numeric number of tests. Did you get the arguments backwards?');
232 my $skip_str = "ok $test # skip";
233 if (defined $reason) {
234 sanitize_comment($reason);
235 $skip_str .= " $reason" if length $reason;
239 print $TAP_STREAM "$skip_str\n";
242 no warnings 'exiting';
246 =head2 C<done_testing [ $count ]>
253 lock $plan if THREADSAFE;
255 $count = $test unless defined $count;
256 croak("Number of tests must be a positive integer. You gave it '$count'")
257 unless $count =~ /^\+?[0-9]+$/;
259 if (not defined $plan or $plan == NO_PLAN) {
260 $plan = $count; # $plan can't be NO_PLAN anymore
263 print $TAP_STREAM "1..$plan\n";
266 @_ = ('done_testing() was already called');
268 } elsif ($plan != $count) {
269 @_ = ("planned to run $plan tests but done_testing() expects $count");
277 =head2 C<ok $ok [, $desc ]>
282 my ($ok, $desc) = @_;
284 lock $plan if THREADSAFE;
288 my $test_str = "ok $test";
290 $test_str = "not $test_str";
294 sanitize_comment($desc);
295 $test_str .= " - $desc" if length $desc;
299 print $TAP_STREAM "$test_str\n";
304 =head2 C<pass [ $desc ]>
313 =head2 C<fail [ $desc ]>
322 =head2 C<is $got, $expected [, $desc ]>
327 my ($got, $expected, $desc) = @_;
328 no warnings 'uninitialized';
330 (not(defined $got xor defined $expected) and $got eq $expected),
336 =head2 C<isnt $got, $expected [, $desc ]>
341 my ($got, $expected, $desc) = @_;
342 no warnings 'uninitialized';
344 ((defined $got xor defined $expected) or $got ne $expected),
376 '~~' => 'smartmatch',
381 sub _create_binop_handler {
383 my $name = $binops{$op};
384 croak("Operator $op not supported") unless defined $name;
388 sub is_$name (\$\$;\$) {
389 my (\$got, \$expected, \$desc) = \@_;
390 \@_ = ((\$got $op \$expected), \$desc);
396 $binop_handlers{$op} = do {
398 \&{__PACKAGE__."::is_$name"};
402 =head2 C<like $got, $regexp_expected [, $desc ]>
404 =head2 C<unlike $got, $regexp_expected, [, $desc ]>
410 *like = _create_binop_handler('=~');
411 *unlike = _create_binop_handler('!~');
414 =head2 C<cmp_ok $got, $op, $expected [, $desc ]>
419 my ($got, $op, $expected, $desc) = @_;
420 my $handler = $binop_handlers{$op};
422 local $Test::More::Level = ($Test::More::Level || 0) + 1;
423 $handler = _create_binop_handler($op);
425 @_ = ($got, $expected, $desc);
434 lock $plan if THREADSAFE;
437 my $msg = join '', map { defined($_) ? $_ : 'undef' } @_;
438 sanitize_comment($msg);
439 return unless length $msg;
442 print $fh "# $msg\n";
452 unshift @_, $DIAG_STREAM;
461 unshift @_, $TAP_STREAM;
465 =head2 C<BAIL_OUT [ $desc ]>
472 lock $plan if THREADSAFE;
474 my $bail_out_str = 'Bail out!';
476 sanitize_comment($desc);
477 $bail_out_str .= " $desc" if length $desc; # Two spaces
481 print $TAP_STREAM "$bail_out_str\n";
488 lock $plan if THREADSAFE;
492 $? = $failed <= 254 ? $failed : 254;
493 } elsif ($plan >= 0) {
494 $? = $test == $plan ? 0 : 255;
495 } elsif ($plan == NO_PLAN) {
497 print $TAP_STREAM "1..$test\n";
505 L</pass>, L</fail>, L</ok>, L</is>, L</isnt>, L</like>, L</unlike> and L</cmp_ok> are all guaranteed to return the truth value of the test.
506 Their L<Test::More> counterparts behave the same, but it is not documented anywhere.
512 L<Exporter>, L<Test::More>
516 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
518 You can contact me by mail or on C<irc.perl.org> (vincent).
522 Please report any bugs or feature requests to C<bug-test-leaner at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Leaner>.
523 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
527 You can find documentation for this module with the perldoc command.
531 =head1 COPYRIGHT & LICENSE
533 Copyright 2010 Vincent Pit, all rights reserved.
535 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
539 1; # End of Test::Leaner