8 use vars (qw($VERSION @ISA @EXPORT @EXPORT_OK $ntest $TestLevel), #public-ish
9 qw($TESTOUT $ONFAIL %todo %history $planned @FAILDETAIL)#private-ish
16 @EXPORT = qw(&plan &ok &skip);
17 @EXPORT_OK = qw($ntest $TESTOUT);
19 $TestLevel = 0; # how many extra stack frames to skip
22 $TESTOUT = *STDOUT{IO};
24 # Use of this variable is strongly discouraged. It is set mainly to
25 # help test coverage analyzers know which test is running.
26 $ENV{REGRESSION_TEST} = $0;
31 Test - provides a simple framework for writing test scripts
38 # use a BEGIN block so we print our plan before MyModule is loaded
39 BEGIN { plan tests => 14, todo => [3,4] }
47 ok(0); # ok, expected failure (see todo list, above)
48 ok(1); # surprise success!
50 ok(0,1); # failure: '0' ne '1'
51 ok('broke','fixed'); # failure: 'broke' ne 'fixed'
52 ok('fixed','fixed'); # success: 'fixed' eq 'fixed'
53 ok('fixed',qr/x/); # success: 'fixed' =~ qr/x/
55 ok(sub { 1+1 }, 2); # success: '2' eq '2'
56 ok(sub { 1+1 }, 3); # failure: '2' ne '3'
57 ok(0, int(rand(2)); # (just kidding :-)
60 ok @list, 3, "\@list=".join(',',@list); #extra diagnostics
61 ok 'segmentation fault', '/(?i)success/'; #regex match
63 skip($feature_is_missing, ...); #do platform specific test
67 L<Test::Harness|Test::Harness> expects to see particular output when it
68 executes tests. This module aims to make writing proper test scripts just
69 a little bit easier (and less error prone :-).
74 All the following are exported by Test by default.
80 BEGIN { plan %theplan; }
82 This should be the first thing you call in your test script. It
83 declares your testing plan, how many there will be, if any of them
84 should be allowed to fail, etc...
86 Typical usage is just:
89 BEGIN { plan tests => 23 }
91 Things you can put in the plan:
93 tests The number of tests in your script.
94 This means all ok() and skip() calls.
95 todo A reference to a list of tests which are allowed
96 to fail. See L</TODO TESTS>.
97 onfail A subroutine reference to be run at the end of
98 the test script should any of the tests fail.
101 You must call plan() once and only once.
106 croak "Test::plan(%args): odd number of arguments" if @_ & 1;
107 croak "Test::plan(): should not be called more than once" if $planned;
109 local($\, $,); # guard against -l and other things that screw with
113 for (my $x=0; $x < @_; $x+=2) {
114 my ($k,$v) = @_[$x,$x+1];
115 if ($k =~ /^test(s)?$/) { $max = $v; }
116 elsif ($k eq 'todo' or
117 $k eq 'failok') { for (@$v) { $todo{$_}=1; }; }
118 elsif ($k eq 'onfail') {
119 ref $v eq 'CODE' or croak "Test::plan(onfail => $v): must be CODE";
122 else { carp "Test::plan(): skipping unrecognized directive '$k'" }
124 my @todo = sort { $a <=> $b } keys %todo;
126 print $TESTOUT "1..$max todo ".join(' ', @todo).";\n";
128 print $TESTOUT "1..$max\n";
141 my $value = _to_value($input);
143 Converts an ok parameter to its value. Typically this just means
144 running it if its a code reference. You should run all inputed
151 return (ref $v or '') eq 'CODE' ? $v->() : $v;
160 ok($have, $expect, $diagnostics);
162 This is the reason for Test's existance. Its the basic function that
163 handles printing "ok" or "not ok" along with the current test number.
165 In its most basic usage, it simply takes an expression. If its true,
166 the test passes, if false, the test fails. Simp.
168 ok( 1 + 1 == 2 ); # ok if 1 + 1 == 2
169 ok( $foo =~ /bar/ ); # ok if $foo contains 'bar'
170 ok( baz($x + $y) eq 'Armondo' ); # ok if baz($x + $y) returns
172 ok( @a == @b ); # ok if @a and @b are the same length
174 The expression is evaluated in scalar context. So the following will
177 ok( @stuff ); # ok if @stuff has any elements
178 ok( !grep !defined $_, @stuff ); # ok if everything in @stuff is
181 A special case is if the expression is a subroutine reference. In
182 that case, it is executed and its value (true or false) determines if
183 the test passes or fails.
185 In its two argument form it compares the two values to see if they
188 ok( "this", "that" ); # not ok, 'this' ne 'that'
190 If either is a subroutine reference, that is run and used as a
193 Should $expect either be a regex reference (ie. qr//) or a string that
194 looks like a regex (ie. '/foo/') ok() will perform a pattern match
195 against it rather than using eq.
197 ok( 'JaffO', '/Jaff/' ); # ok, 'JaffO' =~ /Jaff/
198 ok( 'JaffO', qr/Jaff/ ); # ok, 'JaffO' =~ qr/Jaff/;
199 ok( 'JaffO', '/(?i)jaff/ ); # ok, 'JaffO' =~ /jaff/i;
201 Finally, an optional set of $diagnostics will be printed should the
202 test fail. This should usually be some useful information about the
203 test pertaining to why it failed or perhaps a description of the test.
206 ok( grep($_ eq 'something unique', @stuff), 1,
207 "Something that should be unique isn't!\n".
208 '@stuff = '.join ', ', @stuff
211 Unfortunately, a diagnostic cannot be used with the single argument
214 All these special cases can cause some problems. See L</BUGS and CAVEATS>.
219 croak "ok: plan before you test!" if !$planned;
221 local($\,$,); # guard against -l and other things that screw with
224 my ($pkg,$file,$line) = caller($TestLevel);
225 my $repetition = ++$history{"$file:$line"};
226 my $context = ("$file at line $line".
227 ($repetition > 1 ? " fail \#$repetition" : ''));
229 my $result = _to_value(shift);
230 my ($expected,$diag,$isregex,$regex);
234 $expected = _to_value(shift);
235 if (!defined $expected) {
236 $ok = !defined $result;
237 } elsif (!defined $result) {
239 } elsif ((ref($expected)||'') eq 'Regexp') {
240 $ok = $result =~ /$expected/;
242 } elsif (($regex) = ($expected =~ m,^ / (.+) / $,sx) or
243 (undef, $regex) = ($expected =~ m,^ m([^\w\s]) (.+) \1 $,sx)) {
244 $ok = $result =~ /$regex/;
246 $ok = $result eq $expected;
249 my $todo = $todo{$ntest};
251 $context .= ' TODO?!' if $todo;
252 print $TESTOUT "ok $ntest # ($context)\n";
254 # Issuing two seperate prints() causes problems on VMS.
256 print $TESTOUT "not ok $ntest\n";
259 print $TESTOUT "ok $ntest\n";
263 my $detail = { 'repetition' => $repetition, 'package' => $pkg,
264 'result' => $result, 'todo' => $todo };
265 $$detail{expected} = $expected if defined $expected;
267 # Get the user's diagnostic, protecting against multi-line
269 $diag = $$detail{diagnostic} = _to_value(shift) if @_;
270 $diag =~ s/\n/\n#/g if defined $diag;
272 $context .= ' *TODO*' if $todo;
273 if (!defined $expected) {
275 print $TESTOUT "# Failed test $ntest in $context\n";
277 print $TESTOUT "# Failed test $ntest in $context: $diag\n";
280 my $prefix = "Test $ntest";
281 print $TESTOUT "# $prefix got: ".
282 (defined $result? "'$result'":'<UNDEF>')." ($context)\n";
283 $prefix = ' ' x (length($prefix) - 5);
284 if (defined $regex) {
285 $expected = 'qr{'.$regex.'}';
288 $expected = "'$expected'";
291 print $TESTOUT "# $prefix Expected: $expected\n";
293 print $TESTOUT "# $prefix Expected: $expected ($diag)\n";
296 push @FAILDETAIL, $detail;
304 local($\, $,); # guard against -l and other things that screw with
307 my $whyskip = _to_value(shift);
308 if (!@_ or $whyskip) {
309 $whyskip = '' if $whyskip =~ m/^\d+$/;
310 $whyskip =~ s/^[Ss]kip(?:\s+|$)//; # backwards compatibility, old
311 # versions required the reason
312 # to start with 'skip'
313 # We print in one shot for VMSy reasons.
314 my $ok = "ok $ntest # skip";
315 $ok .= " $whyskip" if length $whyskip;
321 # backwards compatiblity (I think). skip() used to be
322 # called like ok(), which is weird. I haven't decided what to do with
324 # warn <<WARN if $^W;
325 #This looks like a skip() using the very old interface. Please upgrade to
326 #the documented interface as this has been deprecated.
329 local($TestLevel) = $TestLevel+1; #ignore this stack frame
339 $ONFAIL->(\@FAILDETAIL) if @FAILDETAIL && $ONFAIL;
351 These tests are expected to succeed. If they don't something's
354 =item * SKIPPED TESTS
356 Skip is for tests that might or might not be possible to run depending
357 on the availability of platform specific features. The first argument
358 should evaluate to true (think "yes, please skip") if the required
359 feature is not available. After the first argument, skip works
360 exactly the same way as do normal tests.
364 TODO tests are designed for maintaining an B<executable TODO list>.
365 These tests are expected NOT to succeed. If a TODO test does succeed,
366 the feature in question should not be on the TODO list, now should it?
368 Packages should NOT be released with succeeding TODO tests. As soon
369 as a TODO test starts working, it should be promoted to a normal test
370 and the newly working feature should be documented in the release
377 BEGIN { plan test => 4, onfail => sub { warn "CALL 911!" } }
379 While test failures should be enough, extra diagnostics can be
380 triggered at the end of a test run. C<onfail> is passed an array ref
381 of hash refs that describe each test failure. Each hash will contain
382 at least the following fields: C<package>, C<repetition>, and
383 C<result>. (The file, line, and test number are not included because
384 their correspondence to a particular test is tenuous.) If the test
385 had an expected value or a diagnostic string, these will also be
388 The B<optional> C<onfail> hook might be used simply to print out the
389 version of your package and/or how to report problems. It might also
390 be used to generate extremely sophisticated diagnostics for a
391 particularly bizarre test failure. However it's not a panacea. Core
392 dumps or other unrecoverable errors prevent the C<onfail> hook from
393 running. (It is run inside an C<END> block.) Besides, C<onfail> is
394 probably over-kill in most cases. (Your test code should be simpler
395 than the code it is testing, yes?)
398 =head1 BUGS and CAVEATS
400 ok()'s special handling of subroutine references is an unfortunate
401 "feature" that can't be removed due to compatibility.
403 ok()'s use of string eq can sometimes cause odd problems when comparing
404 numbers, especially if you're casting a string to a number:
407 ok( $foo, 1 ); # not ok, "1.0" ne 1
409 Your best bet is to use the single argument form:
411 ok( $foo == 1 ); # ok "1.0" == 1
413 ok()'s special handing of strings which look like they might be
414 regexes can also cause unexpected behavior. An innocent:
416 ok( $fileglob, '/path/to/some/*stuff/' );
418 will fail since Test.pm considers the second argument to a regex.
419 Again, best bet is to use the single argument form:
421 ok( $fileglob eq '/path/to/some/*stuff/' );
435 L<Test::Simple>, L<Test::More>, L<Test::Harness>, L<Devel::Cover>
437 L<Test::Unit> is an interesting alternative testing library.
442 Copyright (c) 1998-2000 Joshua Nathaniel Pritikin. All rights reserved.
443 Copyright (c) 2001 Michael G Schwern.
445 Current maintainer, Michael G Schwern <schwern@pobox.com>
447 This package is free software and is provided "as is" without express
448 or implied warranty. It may be used, redistributed and/or modified
449 under the terms of the Perl Artistic License (see
450 http://www.perl.com/perl/misc/Artistic.html)