4 # Time-stamp: "2003-04-18 21:48:01 AHDT"
9 use vars (qw($VERSION @ISA @EXPORT @EXPORT_OK $ntest $TestLevel), #public-ish
10 qw($TESTOUT $TESTERR %Program_Lines
11 $ONFAIL %todo %history $planned @FAILDETAIL) #private-ish
14 # In case a test is run in a persistent environment.
20 $TestLevel = 0; # how many extra stack frames to skip
28 @EXPORT = qw(&plan &ok &skip);
29 @EXPORT_OK = qw($ntest $TESTOUT $TESTERR);
32 $TESTOUT = *STDOUT{IO};
33 $TESTERR = *STDERR{IO};
35 # Use of this variable is strongly discouraged. It is set mainly to
36 # help test coverage analyzers know which test is running.
37 $ENV{REGRESSION_TEST} = $0;
42 Test - provides a simple framework for writing test scripts
49 # use a BEGIN block so we print our plan before MyModule is loaded
50 BEGIN { plan tests => 14, todo => [3,4] }
55 # Helpful notes. All note-lines must start with a "#".
56 print "# I'm testing MyModule version $MyModule::VERSION\n";
61 ok(0); # ok, expected failure (see todo list, above)
62 ok(1); # surprise success!
64 ok(0,1); # failure: '0' ne '1'
65 ok('broke','fixed'); # failure: 'broke' ne 'fixed'
66 ok('fixed','fixed'); # success: 'fixed' eq 'fixed'
67 ok('fixed',qr/x/); # success: 'fixed' =~ qr/x/
69 ok(sub { 1+1 }, 2); # success: '2' eq '2'
70 ok(sub { 1+1 }, 3); # failure: '2' ne '3'
73 ok @list, 3, "\@list=".join(',',@list); #extra notes
74 ok 'segmentation fault', '/(?i)success/'; #regex match
77 $^O eq 'MSWin' ? "Skip unless MSWin" : 0, # whether to skip
78 $foo, $bar # arguments just like for ok(...)
81 $^O eq 'MSWin' ? 0 : "Skip if MSWin", # whether to skip
82 $foo, $bar # arguments just like for ok(...)
87 This module simplifies the task of writing test files for Perl modules,
88 such that their output is in the format that
89 L<Test::Harness|Test::Harness> expects to see.
91 =head1 QUICK START GUIDE
93 To write a test for your new (and probably not even done) module, create
94 a new file called F<t/test.t> (in a new F<t> directory). If you have
95 multiple test files, to test the "foo", "bar", and "baz" feature sets,
96 then feel free to call your files F<t/foo.t>, F<t/bar.t>, and
101 This module defines three public functions, C<plan(...)>, C<ok(...)>,
102 and C<skip(...)>. By default, all three are exported by
103 the C<use Test;> statement.
109 BEGIN { plan %theplan; }
111 This should be the first thing you call in your test script. It
112 declares your testing plan, how many there will be, if any of them
113 should be allowed to fail, and so on.
115 Typical usage is just:
118 BEGIN { plan tests => 23 }
120 These are the things that you can put in the parameters to plan:
124 =item C<tests =E<gt> I<number>>
126 The number of tests in your script.
127 This means all ok() and skip() calls.
129 =item C<todo =E<gt> [I<1,5,14>]>
131 A reference to a list of tests which are allowed to fail.
134 =item C<onfail =E<gt> sub { ... }>
136 =item C<onfail =E<gt> \&some_sub>
138 A subroutine reference to be run at the end of the test script, if
139 any of the tests fail. See L</ONFAIL>.
143 You must call C<plan(...)> once and only once. You should call it
144 in a C<BEGIN {...}> block, like so:
146 BEGIN { plan tests => 23 }
151 croak "Test::plan(%args): odd number of arguments" if @_ & 1;
152 croak "Test::plan(): should not be called more than once" if $planned;
154 local($\, $,); # guard against -l and other things that screw with
159 _read_program( (caller)[1] );
162 for (my $x=0; $x < @_; $x+=2) {
163 my ($k,$v) = @_[$x,$x+1];
164 if ($k =~ /^test(s)?$/) { $max = $v; }
165 elsif ($k eq 'todo' or
166 $k eq 'failok') { for (@$v) { $todo{$_}=1; }; }
167 elsif ($k eq 'onfail') {
168 ref $v eq 'CODE' or croak "Test::plan(onfail => $v): must be CODE";
171 else { carp "Test::plan(): skipping unrecognized directive '$k'" }
173 my @todo = sort { $a <=> $b } keys %todo;
175 print $TESTOUT "1..$max todo ".join(' ', @todo).";\n";
177 print $TESTOUT "1..$max\n";
180 print $TESTOUT "# Running under perl version $] for $^O",
181 (chr(65) eq 'A') ? "\n" : " in a non-ASCII world\n";
183 print $TESTOUT "# Win32::BuildNumber ", &Win32::BuildNumber(), "\n"
184 if defined(&Win32::BuildNumber) and defined &Win32::BuildNumber();
186 print $TESTOUT "# MacPerl version $MacPerl::Version\n"
187 if defined $MacPerl::Version;
190 "# Current time local: %s\n# Current time GMT: %s\n",
191 scalar(localtime($^T)), scalar(gmtime($^T));
193 print $TESTOUT "# Using Test.pm version $VERSION\n";
201 return unless defined $file and length $file
202 and -e $file and -f _ and -r _;
203 open(SOURCEFILE, "<$file") || return;
204 $Program_Lines{$file} = [<SOURCEFILE>];
207 foreach my $x (@{$Program_Lines{$file}})
208 { $x =~ tr/\cm\cj\n\r//d }
210 unshift @{$Program_Lines{$file}}, '';
218 my $value = _to_value($input);
220 Converts an C<ok> parameter to its value. Typically this just means
221 running it, if it's a code reference. You should run all inputted
228 return (ref $v or '') eq 'CODE' ? $v->() : $v;
237 ok($have, $expect, $diagnostics);
239 This function is the reason for C<Test>'s existence. It's
240 the basic function that
241 handles printing "C<ok>" or "C<not ok>", along with the
242 current test number. (That's what C<Test::Harness> wants to see.)
244 In its most basic usage, C<ok(...)> simply takes a single scalar
245 expression. If its value is true, the test passes; if false,
246 the test fails. Examples:
248 # Examples of ok(scalar)
250 ok( 1 + 1 == 2 ); # ok if 1 + 1 == 2
251 ok( $foo =~ /bar/ ); # ok if $foo contains 'bar'
252 ok( baz($x + $y) eq 'Armondo' ); # ok if baz($x + $y) returns
254 ok( @a == @b ); # ok if @a and @b are the same length
256 The expression is evaluated in scalar context. So the following will
259 ok( @stuff ); # ok if @stuff has any elements
260 ok( !grep !defined $_, @stuff ); # ok if everything in @stuff is
263 A special case is if the expression is a subroutine reference (in either
264 C<sub {...}> syntax or C<\&foo> syntax). In
265 that case, it is executed and its value (true or false) determines if
266 the test passes or fails. For example,
268 ok( sub { # See whether sleep works at least passably
269 my $start_time = time;
271 time() - $start_time >= 4
274 In its two-argument form, C<ok(I<arg1>,I<arg2>)> compares the two scalar
275 values to see if they equal. (The equality is checked with C<eq>).
277 # Example of ok(scalar, scalar)
279 ok( "this", "that" ); # not ok, 'this' ne 'that'
281 If either (or both!) is a subroutine reference, it is run and used
282 as the value for comparing. For example:
285 open(OUT, ">x.dat") || die $!;
286 print OUT "\x{e000}";
288 my $bytecount = -s 'x.dat';
289 unlink 'x.dat' or warn "Can't unlink : $!";
294 The above test passes two values to C<ok(arg1, arg2)> -- the first is
295 the number 4, and the second is a coderef. Before C<ok> compares them,
296 it calls the coderef, and uses its return value as the real value of
297 this parameter. Assuming that C<$bytecount> returns 4, C<ok> ends up
298 testing C<4 eq 4>. Since that's true, this test passes.
300 If C<arg2> is either a regex object (i.e., C<qr/.../>) or a string
301 that I<looks like> a regex (e.g., C<'/foo/'>), then
302 C<ok(I<arg1>,I<arg2>)> will perform a pattern
303 match against it, instead of using C<eq>.
305 ok( 'JaffO', '/Jaff/' ); # ok, 'JaffO' =~ /Jaff/
306 ok( 'JaffO', qr/Jaff/ ); # ok, 'JaffO' =~ qr/Jaff/;
307 ok( 'JaffO', '/(?i)jaff/ ); # ok, 'JaffO' =~ /jaff/i;
309 Finally, you can append an optional third argument, in
310 C<ok(I<arg1>,I<arg2>, I<note>)>, where I<note> is a string value that
311 will be printed if the test fails. This should be some useful
312 information about the test, pertaining to why it failed, and/or
313 a description of the test. For example:
315 ok( grep($_ eq 'something unique', @stuff), 1,
316 "Something that should be unique isn't!\n".
317 '@stuff = '.join ', ', @stuff
320 Unfortunately, a note cannot be used with the single argument
321 style of C<ok()>. That is, if you try C<ok(I<arg1>, I<note>)>, then
322 C<Test> will interpret this as C<ok(I<arg1>, I<arg2>)>, and probably
323 end up testing C<I<arg1> eq I<arg2>> -- and that's not what you want!
325 All of the above special cases can occasionally cause some
326 problems. See L</BUGS and CAVEATS>.
330 # A past maintainer of this module said:
331 # <<ok(...)'s special handling of subroutine references is an unfortunate
332 # "feature" that can't be removed due to compatibility.>>
336 croak "ok: plan before you test!" if !$planned;
338 local($\,$,); # guard against -l and other things that screw with
341 my ($pkg,$file,$line) = caller($TestLevel);
342 my $repetition = ++$history{"$file:$line"};
343 my $context = ("$file at line $line".
344 ($repetition > 1 ? " fail \#$repetition" : ''));
346 # Are we comparing two values?
350 my $result = _to_value(shift);
351 my ($expected,$diag,$isregex,$regex);
356 $expected = _to_value(shift);
357 if (!defined $expected) {
358 $ok = !defined $result;
359 } elsif (!defined $result) {
361 } elsif ((ref($expected)||'') eq 'Regexp') {
362 $ok = $result =~ /$expected/;
364 } elsif (($regex) = ($expected =~ m,^ / (.+) / $,sx) or
365 (undef, $regex) = ($expected =~ m,^ m([^\w\s]) (.+) \1 $,sx)) {
366 $ok = $result =~ /$regex/;
368 $ok = $result eq $expected;
371 my $todo = $todo{$ntest};
373 $context .= ' TODO?!' if $todo;
374 print $TESTOUT "ok $ntest # ($context)\n";
376 # Issuing two seperate prints() causes problems on VMS.
378 print $TESTOUT "not ok $ntest\n";
381 print $TESTOUT "ok $ntest\n";
385 my $detail = { 'repetition' => $repetition, 'package' => $pkg,
386 'result' => $result, 'todo' => $todo };
387 $$detail{expected} = $expected if defined $expected;
389 # Get the user's diagnostic, protecting against multi-line
391 $diag = $$detail{diagnostic} = _to_value(shift) if @_;
392 $diag =~ s/\n/\n#/g if defined $diag;
394 $context .= ' *TODO*' if $todo;
397 print $TESTERR "# Failed test $ntest in $context\n";
399 print $TESTERR "# Failed test $ntest in $context: $diag\n";
402 my $prefix = "Test $ntest";
403 print $TESTERR "# $prefix got: ".
404 (defined $result? "'$result'":'<UNDEF>')." ($context)\n";
405 $prefix = ' ' x (length($prefix) - 5);
406 if (defined $regex) {
407 $expected = 'qr{'.$regex.'}';
409 elsif (defined $expected) {
410 $expected = "'$expected'";
413 $expected = '<UNDEF>';
416 print $TESTERR "# $prefix Expected: $expected\n";
418 print $TESTERR "# $prefix Expected: $expected ($diag)\n";
422 if(defined $Program_Lines{$file}[$line]) {
424 "# $file line $line is: $Program_Lines{$file}[$line]\n"
426 $Program_Lines{$file}[$line] =~ m/[^\s\#\(\)\{\}\[\]\;]/
427 # Otherwise it's a pretty uninteresting line!
430 undef $Program_Lines{$file}[$line];
431 # So we won't repeat it.
434 push @FAILDETAIL, $detail;
441 =item C<skip(I<skip_if_true>, I<args...>)>
443 This is used for tests that under some conditions can be skipped. It's
444 basically equivalent to:
446 if( $skip_if_true ) {
452 ...except that the C<ok(1)> emits not just "C<ok I<testnum>>" but
453 actually "C<ok I<testnum> # I<skip_if_true_value>>".
455 The arguments after the I<skip_if_true> are what is fed to C<ok(...)> if
456 this test isn't skipped.
461 $^O eq 'MSWin' ? 'Skip if under MSWin' : '';
463 # A test to be run EXCEPT under MSWin:
464 skip($if_MSWin, thing($foo), thing($bar) );
466 Or, going the other way:
469 $^O eq 'MSWin' ? 'Skip unless under MSWin' : '';
471 # A test to be run EXCEPT under MSWin:
472 skip($unless_MSWin, thing($foo), thing($bar) );
474 The tricky thing to remember is that the first parameter is true if
475 you want to I<skip> the test, not I<run> it; and it also doubles as a
476 note about why it's being skipped. So in the first codeblock above, read
477 the code as "skip if MSWin -- (otherwise) test whether C<thing($foo)> is
478 C<thing($bar)>" or for the second case, "skip unless MSWin...".
480 Also, when your I<skip_if_reason> string is true, it really should (for
481 backwards compatibility with older Test.pm versions) start with the
482 string "Skip", as shown in the above examples.
484 Note that in the above cases, C<thing($foo)> and C<thing($bar)>
485 I<are> evaluated -- but as long as the C<skip_if_true> is true,
486 then we C<skip(...)> just tosses out their value (i.e., not
487 bothering to treat them like values to C<ok(...)>. But if
488 you need to I<not> eval the arguments when skipping the
494 # This code returns true if the test passes.
495 # (But it doesn't even get called if the test is skipped.)
496 thing($foo) eq thing($bar)
500 or even this, which is basically equivalent:
503 sub { thing($foo) }, sub { thing($bar) }
506 That is, both are like this:
508 if( $unless_MSWin ) {
509 ok(1); # but it actually appends "# $unless_MSWin"
510 # so that Test::Harness can tell it's a skip
512 # Not skipping, so actually call and evaluate...
513 ok( sub { thing($foo) }, sub { thing($bar) } );
519 local($\, $,); # guard against -l and other things that screw with
522 my $whyskip = _to_value(shift);
523 if (!@_ or $whyskip) {
524 $whyskip = '' if $whyskip =~ m/^\d+$/;
525 $whyskip =~ s/^[Ss]kip(?:\s+|$)//; # backwards compatibility, old
526 # versions required the reason
527 # to start with 'skip'
528 # We print in one shot for VMSy reasons.
529 my $ok = "ok $ntest # skip";
530 $ok .= " $whyskip" if length $whyskip;
536 # backwards compatiblity (I think). skip() used to be
537 # called like ok(), which is weird. I haven't decided what to do with
539 # warn <<WARN if $^W;
540 #This looks like a skip() using the very old interface. Please upgrade to
541 #the documented interface as this has been deprecated.
544 local($TestLevel) = $TestLevel+1; #to ignore this stack frame
554 $ONFAIL->(\@FAILDETAIL) if @FAILDETAIL && $ONFAIL;
566 These tests are expected to succeed. Usually, most or all of your tests
567 are in this category. If a normal test doesn't succeed, then that
568 means that something is I<wrong>.
570 =item * SKIPPED TESTS
572 The C<skip(...)> function is for tests that might or might not be
573 possible to run, depending
574 on the availability of platform-specific features. The first argument
575 should evaluate to true (think "yes, please skip") if the required
576 feature is I<not> available. After the first argument, C<skip(...)> works
577 exactly the same way as C<ok(...)> does.
581 TODO tests are designed for maintaining an B<executable TODO list>.
582 These tests are I<expected to fail.> If a TODO test does succeed,
583 then the feature in question shouldn't be on the TODO list, now
586 Packages should NOT be released with succeeding TODO tests. As soon
587 as a TODO test starts working, it should be promoted to a normal test,
588 and the newly working feature should be documented in the release
589 notes or in the change log.
595 BEGIN { plan test => 4, onfail => sub { warn "CALL 911!" } }
597 Although test failures should be enough, extra diagnostics can be
598 triggered at the end of a test run. C<onfail> is passed an array ref
599 of hash refs that describe each test failure. Each hash will contain
600 at least the following fields: C<package>, C<repetition>, and
601 C<result>. (The file, line, and test number are not included because
602 their correspondence to a particular test is tenuous.) If the test
603 had an expected value or a diagnostic (or "note") string, these will also be
606 The I<optional> C<onfail> hook might be used simply to print out the
607 version of your package and/or how to report problems. It might also
608 be used to generate extremely sophisticated diagnostics for a
609 particularly bizarre test failure. However it's not a panacea. Core
610 dumps or other unrecoverable errors prevent the C<onfail> hook from
611 running. (It is run inside an C<END> block.) Besides, C<onfail> is
612 probably over-kill in most cases. (Your test code should be simpler
613 than the code it is testing, yes?)
616 =head1 BUGS and CAVEATS
622 C<ok(...)>'s special handing of strings which look like they might be
623 regexes can also cause unexpected behavior. An innocent:
625 ok( $fileglob, '/path/to/some/*stuff/' );
627 will fail, since Test.pm considers the second argument to be a regex!
628 The best bet is to use the one-argument form:
630 ok( $fileglob eq '/path/to/some/*stuff/' );
634 C<ok(...)>'s use of string C<eq> can sometimes cause odd problems
636 numbers, especially if you're casting a string to a number:
639 ok( $foo, 1 ); # not ok, "1.0" ne 1
641 Your best bet is to use the single argument form:
643 ok( $foo == 1 ); # ok "1.0" == 1
647 As you may have inferred from the above documentation and examples,
648 C<ok>'s prototype is C<($;$$)> (and, incidentally, C<skip>'s is
649 C<($;$$$)>). This means, for example, that you can do C<ok @foo, @bar>
650 to compare the I<size> of the two arrays. But don't be fooled into
651 thinking that C<ok @foo, @bar> means a comparison of the contents of two
652 arrays -- you're comparing I<just> the number of elements of each. It's
653 so easy to make that mistake in reading C<ok @foo, @bar> that you might
654 want to be very explicit about it, and instead write C<ok scalar(@foo),
659 This almost definitely doesn't do what you expect:
661 ok $thingy->can('some_method');
663 Why? Because C<can> returns a coderef to mean "yes it can (and the
664 method is this...)", and then C<ok> sees a coderef and thinks you're
665 passing a function that you want it to call and consider the truth of
666 the result of! I.e., just like:
668 ok $thingy->can('some_method')->();
670 What you probably want instead is this:
672 ok $thingy->can('some_method') && 1;
674 If the C<can> returns false, then that is passed to C<ok>. If it
675 returns true, then the larger expression S<< C<<
676 $thingy->can('some_method') && 1 >> >> returns 1, which C<ok> sees as
677 a simple signal of success, as you would expect.
682 The syntax for C<skip> is about the only way it can be, but it's still
683 quite confusing. Just start with the above examples and you'll
686 Moreover, users may expect this:
688 skip $unless_mswin, foo($bar), baz($quux);
690 to not evaluate C<foo($bar)> and C<baz($quux)> when the test is being
691 skipped. But in reality, they I<are> evaluated, but C<skip> just won't
692 bother comparing them if C<$unless_mswin> is true.
696 skip $unless_mswin, sub{foo($bar)}, sub{baz($quux)};
698 But that's not terribly pretty. You may find it simpler or clearer in
699 the long run to just do things like this:
701 if( $^O =~ m/MSWin/ ) {
702 print "# Yay, we're under $^O\n";
703 ok foo($bar), baz($quux);
704 ok thing($whatever), baz($stuff);
705 ok blorp($quux, $whatever);
706 ok foo($barzbarz), thang($quux);
708 print "# Feh, we're under $^O. Watch me skip some tests...\n";
709 for(1 .. 4) { skip "Skip unless under MSWin" }
712 But be quite sure that C<ok> is called exactly as many times in the
713 first block as C<skip> is called in the second block.
719 A past developer of this module once said that it was no longer being
720 actively developed. However, rumors of its demise were greatly
721 exaggerated. Feedback and suggestions are quite welcome.
723 Be aware that the main value of this module is its simplicity. Note
724 that there are already more ambitious modules out there, such as
725 L<Test::More> and L<Test::Unit>.
732 L<Test::Simple>, L<Test::More>, L<Devel::Cover>
734 L<Test::Builder> for building your own testing library.
736 L<Test::Unit> is an interesting XUnit-style testing library.
738 L<Test::Inline> and L<SelfTest> let you embed tests in code.
743 Copyright (c) 1998-2000 Joshua Nathaniel Pritikin. All rights reserved.
745 Copyright (c) 2001-2002 Michael G. Schwern.
747 Copyright (c) 2002-2003 Sean M. Burke.
749 Current maintainer: Sean M. Burke. E<lt>sburke@cpan.orgE<gt>
751 This package is free software and is provided "as is" without express
752 or implied warranty. It may be used, redistributed and/or modified
753 under the same terms as Perl itself.
757 # "Your mistake was a hidden intention."
758 # -- /Oblique Strategies/, Brian Eno and Peter Schmidt