3 use Test::Harness 1.1601 ();
5 use vars (qw($VERSION @ISA @EXPORT @EXPORT_OK $ntest $TestLevel), #public-ish
6 qw($TESTOUT $ONFAIL %todo %history $planned @FAILDETAIL)); #private-ish
10 @EXPORT=qw(&plan &ok &skip);
11 @EXPORT_OK=qw($ntest $TESTOUT);
13 $TestLevel = 0; # how many extra stack frames to skip
17 $TESTOUT = *STDOUT{IO};
19 # Use of this variable is strongly discouraged. It is set mainly to
20 # help test coverage analyzers know which test is running.
21 $ENV{REGRESSION_TEST} = $0;
24 croak "Test::plan(%args): odd number of arguments" if @_ & 1;
25 croak "Test::plan(): should not be called more than once" if $planned;
27 for (my $x=0; $x < @_; $x+=2) {
28 my ($k,$v) = @_[$x,$x+1];
29 if ($k =~ /^test(s)?$/) { $max = $v; }
30 elsif ($k eq 'todo' or
31 $k eq 'failok') { for (@$v) { $todo{$_}=1; }; }
32 elsif ($k eq 'onfail') {
33 ref $v eq 'CODE' or croak "Test::plan(onfail => $v): must be CODE";
36 else { carp "Test::plan(): skipping unrecognized directive '$k'" }
38 my @todo = sort { $a <=> $b } keys %todo;
40 print $TESTOUT "1..$max todo ".join(' ', @todo).";\n";
42 print $TESTOUT "1..$max\n";
49 (ref $v or '') eq 'CODE' ? $v->() : $v;
53 croak "ok: plan before you test!" if !$planned;
54 my ($pkg,$file,$line) = caller($TestLevel);
55 my $repetition = ++$history{"$file:$line"};
56 my $context = ("$file at line $line".
57 ($repetition > 1 ? " fail \#$repetition" : ''));
59 my $result = to_value(shift);
64 $expected = to_value(shift);
66 if ((ref($expected)||'') eq 'Regexp') {
67 $ok = $result =~ /$expected/;
68 } elsif (($regex) = ($expected =~ m,^ / (.+) / $,sx) or
69 ($ignore, $regex) = ($expected =~ m,^ m([^\w\s]) (.+) \1 $,sx)) {
70 $ok = $result =~ /$regex/;
72 $ok = $result eq $expected;
75 my $todo = $todo{$ntest};
77 $context .= ' TODO?!' if $todo;
78 print $TESTOUT "ok $ntest # ($context)\n";
80 print $TESTOUT "not " if !$ok;
81 print $TESTOUT "ok $ntest\n";
84 my $detail = { 'repetition' => $repetition, 'package' => $pkg,
85 'result' => $result, 'todo' => $todo };
86 $$detail{expected} = $expected if defined $expected;
87 $diag = $$detail{diagnostic} = to_value(shift) if @_;
88 $context .= ' *TODO*' if $todo;
89 if (!defined $expected) {
91 print $TESTOUT "# Failed test $ntest in $context\n";
93 print $TESTOUT "# Failed test $ntest in $context: $diag\n";
96 my $prefix = "Test $ntest";
97 print $TESTOUT "# $prefix got: '$result' ($context)\n";
98 $prefix = ' ' x (length($prefix) - 5);
99 if ((ref($expected)||'') eq 'Regexp') {
100 $expected = 'qr/'.$expected.'/'
102 $expected = "'$expected'";
105 print $TESTOUT "# $prefix Expected: $expected\n";
107 print $TESTOUT "# $prefix Expected: $expected ($diag)\n";
110 push @FAILDETAIL, $detail;
118 my $whyskip = to_value(shift);
120 $whyskip = 'skip' if $whyskip =~ m/^\d+$/;
121 print $TESTOUT "ok $ntest # $whyskip\n";
125 local($TestLevel) = $TestLevel+1; #ignore this stack frame
131 $ONFAIL->(\@FAILDETAIL) if @FAILDETAIL && $ONFAIL;
139 Test - provides a simple framework for writing test scripts
146 # use a BEGIN block so we print our plan before MyModule is loaded
147 BEGIN { plan tests => 14, todo => [3,4] }
149 # load your module...
155 ok(0); # ok, expected failure (see todo list, above)
156 ok(1); # surprise success!
158 ok(0,1); # failure: '0' ne '1'
159 ok('broke','fixed'); # failure: 'broke' ne 'fixed'
160 ok('fixed','fixed'); # success: 'fixed' eq 'fixed'
161 ok('fixed',qr/x/); # success: 'fixed' =~ qr/x/
163 ok(sub { 1+1 }, 2); # success: '2' eq '2'
164 ok(sub { 1+1 }, 3); # failure: '2' ne '3'
165 ok(0, int(rand(2)); # (just kidding! :-)
168 ok @list, 3, "\@list=".join(',',@list); #extra diagnostics
169 ok 'segmentation fault', '/(?i)success/'; #regex match
171 skip($feature_is_missing, ...); #do platform specific test
175 L<Test::Harness> expects to see particular output when it executes
176 tests. This module aims to make writing proper test scripts just a
177 little bit easier (and less error prone :-).
185 These tests are expected to succeed. If they don't something's
188 =item * SKIPPED TESTS
190 Skip is for tests that might or might not be possible to run depending
191 on the availability of platform specific features. The first argument
192 should evaluate to true (think "yes, please skip") if the required
193 feature is not available. After the first argument, skip works
194 exactly the same way as do normal tests.
198 TODO tests are designed for maintaining an B<executable TODO list>.
199 These tests are expected NOT to succeed. If a TODO test does succeed,
200 the feature in question should not be on the TODO list, now should it?
202 Packages should NOT be released with succeeding TODO tests. As soon
203 as a TODO test starts working, it should be promoted to a normal test
204 and the newly working feature should be documented in the release
211 Both C<ok> and C<skip> return true if their test succeeds and false
212 otherwise in a scalar context.
216 BEGIN { plan test => 4, onfail => sub { warn "CALL 911!" } }
218 While test failures should be enough, extra diagnostics can be
219 triggered at the end of a test run. C<onfail> is passed an array ref
220 of hash refs that describe each test failure. Each hash will contain
221 at least the following fields: C<package>, C<repetition>, and
222 C<result>. (The file, line, and test number are not included because
223 their correspondance to a particular test is tenuous.) If the test
224 had an expected value or a diagnostic string, these will also be
227 The B<optional> C<onfail> hook might be used simply to print out the
228 version of your package and/or how to report problems. It might also
229 be used to generate extremely sophisticated diagnostics for a
230 particularly bizarre test failure. However it's not a panacea. Core
231 dumps or other unrecoverable errors prevent the C<onfail> hook from
232 running. (It is run inside an C<END> block.) Besides, C<onfail> is
233 probably over-kill in most cases. (Your test code should be simpler
234 than the code it is testing, yes?)
238 L<Test::Harness> and, perhaps, test coverage analysis tools.
242 Copyright (C) 1998 Joshua Nathaniel Pritikin. All rights reserved.
244 This package is free software and is provided "as is" without express
245 or implied warranty. It may be used, redistributed and/or modified
246 under the terms of the Perl Artistic License (see
247 http://www.perl.com/perl/misc/Artistic.html)