Commit | Line | Data |
7b13a3f5 |
1 | use strict; |
2 | package Test; |
3 | use Test::Harness 1.1601 (); |
4 | use Carp; |
5 | use vars qw($VERSION @ISA @EXPORT $ntest %todo); |
6 | $VERSION = '0.06'; |
7 | require Exporter; |
8 | @ISA=('Exporter'); |
9 | @EXPORT= qw(&plan &ok &skip $ntest); |
10 | |
11 | $|=1; |
12 | #$^W=1; ? |
13 | $ntest=1; |
14 | |
15 | # Use of this variable is strongly discouraged. It is set |
16 | # exclusively for test coverage analyzers. |
17 | $ENV{REGRESSION_TEST} = $0; |
18 | |
19 | sub plan { |
20 | croak "Test::plan(%args): odd number of arguments" if @_ & 1; |
21 | my $max=0; |
22 | for (my $x=0; $x < @_; $x+=2) { |
23 | my ($k,$v) = @_[$x,$x+1]; |
24 | if ($k =~ /^test(s)?$/) { $max = $v; } |
25 | elsif ($k eq 'todo' or |
26 | $k eq 'failok') { for (@$v) { $todo{$_}=1; }; } |
27 | else { carp "Test::plan(): skipping unrecognized directive '$k'" } |
28 | } |
29 | my @todo = sort { $a <=> $b } keys %todo; |
30 | if (@todo) { |
31 | print "1..$max todo ".join(' ', @todo).";\n"; |
32 | } else { |
33 | print "1..$max\n"; |
34 | } |
35 | } |
36 | |
37 | sub ok { |
38 | my ($ok, $guess) = @_; |
39 | carp "(this is ok $ntest)" if defined $guess && $guess != $ntest; |
40 | $ok = $ok->() if (ref $ok or '') eq 'CODE'; |
41 | if ($ok) { |
42 | if ($todo{$ntest}) { |
43 | print("ok $ntest # Wow!\n"); |
44 | } else { |
45 | print("ok $ntest # (failure expected)\n"); |
46 | } |
47 | } else { |
48 | print("not ok $ntest\n"); |
49 | } |
50 | ++ $ntest; |
51 | $ok; |
52 | } |
53 | |
54 | sub skip { |
55 | my ($toskip, $ok, $guess) = @_; |
56 | carp "(this is skip $ntest)" if defined $guess && $guess != $ntest; |
57 | $toskip = $toskip->() if (ref $toskip or '') eq 'CODE'; |
58 | if ($toskip) { |
59 | print "ok $ntest # skip\n"; |
60 | ++ $ntest; |
61 | 1; |
62 | } else { |
63 | ok($ok); |
64 | } |
65 | } |
66 | |
67 | 1; |
68 | __END__ |
69 | |
70 | =head1 NAME |
71 | |
72 | Test - provides a simple framework for writing test scripts |
73 | |
74 | =head1 SYNOPSIS |
75 | |
76 | use strict; |
77 | use Test; |
78 | BEGIN { plan tests => 5, todo => [3,4] } |
79 | |
80 | ok(0); #failure |
81 | ok(1); #success |
82 | |
83 | ok(0); #ok, expected failure (see todo above) |
84 | ok(1); #surprise success! |
85 | |
86 | skip($feature_is_missing, sub {...}); #do platform specific test |
87 | |
88 | =head1 DESCRIPTION |
89 | |
90 | Test::Harness expects to see particular output when it executes test |
91 | scripts. This module tries to make conforming just a little bit |
92 | easier (and less error prone). |
93 | |
94 | =head1 TEST CATEGORIES |
95 | |
96 | =over 4 |
97 | |
98 | =item * NORMAL TESTS |
99 | |
100 | These tests are expected to succeed. If they don't, something is |
101 | wrong! |
102 | |
103 | =item * SKIPPED TESTS |
104 | |
105 | C<skip> should be used to skip tests for which a platform specific |
106 | feature isn't available. |
107 | |
108 | =item * TODO TESTS |
109 | |
110 | TODO tests are designed for the purpose of maintaining an executable |
111 | TODO list. These tests are expected NOT to succeed (otherwise the |
112 | feature they test would be on the new feature list, not the TODO |
113 | list). |
114 | |
115 | Packages should NOT be released with successful TODO tests. As soon |
116 | as a TODO test starts working, it should be promoted to a normal test |
117 | and the new feature should be documented in the release notes. |
118 | |
119 | =back |
120 | |
121 | =head1 SEE ALSO |
122 | |
123 | L<Test::Harness> and various test coverage analysis tools. |
124 | |
125 | =head1 AUTHOR |
126 | |
127 | Copyright © 1998 Joshua Nathaniel Pritikin. All rights reserved. |
128 | |
129 | This package is free software and is provided "as is" without express |
130 | or implied warranty. It may be used, redistributed and/or modified |
131 | under the terms of the Perl Artistic License (see |
132 | http://www.perl.com/perl/misc/Artistic.html) |
133 | |
134 | =cut |