Commit | Line | Data |
69026470 |
1 | # |
2 | # t/test.pl - most of Test::More functionality without the fuss |
3 | # |
4 | |
5 | my $test = 1; |
6 | my $planned; |
7 | |
8 | sub plan { |
9 | my $n; |
10 | if (@_ == 1) { |
11 | $n = shift; |
12 | } else { |
13 | my %plan = @_; |
14 | $n = $plan{tests}; |
15 | } |
16 | print "1..$n\n"; |
17 | $planned = $n; |
18 | } |
19 | |
20 | END { |
21 | my $ran = $test - 1; |
22 | if (defined $planned && $planned != $ran) { |
23 | print "# Looks like you planned $planned tests but ran $ran.\n"; |
24 | } |
25 | } |
26 | |
27 | sub skip_all { |
28 | if (@_) { |
29 | print "1..0 - @_\n"; |
30 | } else { |
31 | print "1..0\n"; |
32 | } |
33 | exit(0); |
34 | } |
35 | |
36 | sub _ok { |
37 | my ($pass, $where, @mess) = @_; |
38 | # Do not try to microoptimize by factoring out the "not ". |
39 | # VMS will avenge. |
40 | if (@mess) { |
41 | print $pass ? "ok $test - @mess\n" : "not ok $test - @mess\n"; |
42 | } else { |
43 | print $pass ? "ok $test\n" : "not ok $test\n"; |
44 | } |
45 | unless ($pass) { |
46 | print "# Failed $where\n"; |
47 | } |
48 | $test++; |
1577bb16 |
49 | |
50 | return $pass; |
69026470 |
51 | } |
52 | |
53 | sub _where { |
54 | my @caller = caller(1); |
55 | return "at $caller[1] line $caller[2]"; |
56 | } |
57 | |
58 | sub ok { |
59 | my ($pass, @mess) = @_; |
60 | _ok($pass, _where(), @mess); |
61 | } |
62 | |
69026470 |
63 | sub is { |
64 | my ($got, $expected, @mess) = @_; |
65 | my $pass = $got eq $expected; |
66 | unless ($pass) { |
67 | unshift(@mess, "\n", |
68 | "# got '$got'\n", |
69 | "# expected '$expected'\n"); |
70 | } |
1577bb16 |
71 | _ok($pass, _where(), @mess); |
69026470 |
72 | } |
73 | |
3e90d5a3 |
74 | sub isnt { |
75 | my ($got, $isnt, $name, @mess) = @_; |
76 | my $pass = $got ne $isnt; |
77 | unless( $pass ) { |
78 | unshift(@mess, "# It should not be " . |
79 | ( defined $got ? $got : "undef" ) . "\n", |
80 | "# but it is.\n"); |
81 | } |
82 | _ok($pass, _where(), $name, @mess); |
83 | } |
84 | |
69026470 |
85 | # Note: this isn't quite as fancy as Test::More::like(). |
86 | sub like { |
87 | my ($got, $expected, @mess) = @_; |
88 | my $pass; |
89 | if (ref $expected eq 'Regexp') { |
90 | $pass = $got =~ $expected; |
91 | unless ($pass) { |
92 | unshift(@mess, "\n", |
93 | "# got '$got'\n"); |
94 | } |
95 | } else { |
96 | $pass = $got =~ /$expected/; |
97 | unless ($pass) { |
98 | unshift(@mess, "\n", |
99 | "# got '$got'\n", |
100 | "# expected /$expected/\n"); |
101 | } |
102 | } |
1577bb16 |
103 | _ok($pass, _where(), @mess); |
69026470 |
104 | } |
105 | |
106 | sub pass { |
107 | _ok(1, '', @_); |
108 | } |
109 | |
110 | sub fail { |
111 | _ok(0, _where(), @_); |
112 | } |
113 | |
3e90d5a3 |
114 | sub next_test { |
115 | $test++ |
116 | } |
117 | |
69026470 |
118 | # Note: can't pass multipart messages since we try to |
119 | # be compatible with Test::More::skip(). |
120 | sub skip { |
982b7cb7 |
121 | my $mess = shift; |
122 | my $n = @_ ? shift : 1; |
69026470 |
123 | for (1..$n) { |
124 | ok(1, "# skip:", $mess); |
125 | } |
126 | local $^W = 0; |
127 | last SKIP; |
128 | } |
129 | |
130 | sub eq_array { |
131 | my ($ra, $rb) = @_; |
132 | return 0 unless $#$ra == $#$rb; |
133 | for my $i (0..$#$ra) { |
134 | return 0 unless $ra->[$i] eq $rb->[$i]; |
135 | } |
136 | return 1; |
137 | } |
138 | |
139 | sub require_ok { |
140 | my ($require) = @_; |
141 | eval <<REQUIRE_OK; |
142 | require $require; |
143 | REQUIRE_OK |
1577bb16 |
144 | _ok(!$@, _where(), "require $require"); |
69026470 |
145 | } |
146 | |
147 | sub use_ok { |
148 | my ($use) = @_; |
149 | eval <<USE_OK; |
150 | use $use; |
151 | USE_OK |
1577bb16 |
152 | _ok(!$@, _where(), "use $use"); |
69026470 |
153 | } |
154 | |
155 | 1; |