line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Pod::Tests; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=pod |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
Pod::Tests - Extracts embedded tests and code examples from POD |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 SYNOPSIS |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use Pod::Tests; |
12
|
|
|
|
|
|
|
$p = Pod::Tests->new; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
$p->parse_file($file); |
15
|
|
|
|
|
|
|
$p->parse_fh($fh); |
16
|
|
|
|
|
|
|
$p->parse(@code); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
my @examples = $p->examples; |
19
|
|
|
|
|
|
|
my @tests = $p->tests; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
foreach my $example (@examples) { |
22
|
|
|
|
|
|
|
print "The example: '$example->{code}' was on line ". |
23
|
|
|
|
|
|
|
"$example->{line}\n"; |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
my @test_code = $p->build_tests(@tests); |
27
|
|
|
|
|
|
|
my @example_test_code = $p->build_examples(@examples); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head1 DESCRIPTION |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
This is a specialized POD viewer to extract embedded tests and code |
32
|
|
|
|
|
|
|
examples from POD. It doesn't do much more than that. pod2test does |
33
|
|
|
|
|
|
|
the useful work. |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head2 Parsing |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
After creating a Pod::Tests object, you parse the POD by calling one |
38
|
|
|
|
|
|
|
of the available parsing methods documented below. You can call parse |
39
|
|
|
|
|
|
|
as many times as you'd like, all examples and tests found will stack |
40
|
|
|
|
|
|
|
up inside the object. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head2 Testing |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
Once extracted, the tests can be built into stand-alone testing code |
45
|
|
|
|
|
|
|
using the build_tests() and build_examples() methods. However, it is |
46
|
|
|
|
|
|
|
recommended that you first look at the pod2test program before |
47
|
|
|
|
|
|
|
embarking on this. |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head2 Methods |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=cut |
52
|
|
|
|
|
|
|
|
53
|
1
|
|
|
1
|
|
20994
|
use 5.004; |
|
1
|
|
|
|
|
4
|
|
54
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
37
|
|
55
|
1
|
|
|
1
|
|
5
|
use vars qw($VERSION); |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
73
|
|
56
|
|
|
|
|
|
|
BEGIN { |
57
|
1
|
|
|
1
|
|
1965
|
$VERSION = '0.17_01'; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
##################################################################### |
65
|
|
|
|
|
|
|
# Constructor |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=pod |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head2 new |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
$parser = Pod::Tests->new; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
Returns a new Pod::Tests object which lets you read tests and examples |
74
|
|
|
|
|
|
|
out of a POD document. |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=cut |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub new { |
79
|
1
|
|
|
1
|
1
|
22
|
my($proto) = shift; |
80
|
1
|
|
33
|
|
|
9
|
my($class) = ref $proto || $proto; |
81
|
|
|
|
|
|
|
|
82
|
1
|
|
|
|
|
3
|
my $self = bless {}, $class; |
83
|
1
|
|
|
|
|
4
|
$self->_init; |
84
|
1
|
|
|
|
|
3
|
$self->{example} = []; |
85
|
1
|
|
|
|
|
2
|
$self->{testing} = []; |
86
|
|
|
|
|
|
|
|
87
|
1
|
|
|
|
|
3
|
return $self; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
##################################################################### |
95
|
|
|
|
|
|
|
# Pod::Tests Methods |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=pod |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=head2 parse |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
$parser->parse(@code); |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
Finds the examples and tests in a bunch of lines of Perl @code. Once |
104
|
|
|
|
|
|
|
run they're available via examples() and testing(). |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=cut |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub parse { |
109
|
2
|
|
|
2
|
1
|
3
|
my($self) = shift; |
110
|
|
|
|
|
|
|
|
111
|
2
|
|
|
|
|
7
|
$self->_init; |
112
|
2
|
|
|
|
|
9
|
foreach (@_) { |
113
|
240
|
100
|
66
|
|
|
813
|
if( /^=(\w.*)/ and $self->{_sawblank} and !$self->{_inblock}) { |
|
|
100
|
66
|
|
|
|
|
114
|
42
|
|
|
|
|
42
|
$self->{_inpod} = 1; |
115
|
|
|
|
|
|
|
|
116
|
42
|
|
|
|
|
198
|
my($tag, $for, $pod) = split /\s+/, $1, 3; |
117
|
|
|
|
|
|
|
|
118
|
42
|
100
|
|
|
|
88
|
if( $tag eq 'also' ) { |
119
|
4
|
|
|
|
|
6
|
$tag = $for; |
120
|
4
|
|
|
|
|
9
|
($for, $pod) = split /\s+/, $pod, 2; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
42
|
100
|
|
|
|
71
|
if( $tag eq 'for' ) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
124
|
28
|
|
|
|
|
44
|
$self->_beginfor($for, $pod); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
elsif( $tag eq 'begin' ) { |
127
|
6
|
|
|
|
|
13
|
$self->_beginblock($for); |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
elsif( $tag eq 'cut' ) { |
130
|
4
|
|
|
|
|
6
|
$self->{_inpod} = 0; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
42
|
|
|
|
|
38
|
$self->{_sawblank} = 0; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
elsif( $self->{_inpod} ) { |
136
|
184
|
100
|
100
|
|
|
738
|
if( (/^=(?:also )?end (\S+)/ or /^=for (\S+) end\b/) |
|
|
|
66
|
|
|
|
|
137
|
|
|
|
|
|
|
and $self->{_inblock} eq $1 |
138
|
|
|
|
|
|
|
) |
139
|
|
|
|
|
|
|
{ |
140
|
16
|
|
|
|
|
45
|
$self->_endblock; |
141
|
16
|
|
|
|
|
14
|
$self->{_sawblank} = 0; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
else { |
144
|
168
|
100
|
100
|
|
|
549
|
if( /^\s*$/ ) { |
|
|
100
|
|
|
|
|
|
145
|
86
|
100
|
|
|
|
155
|
$self->_endfor() if $self->{_infor}; |
146
|
86
|
|
|
|
|
78
|
$self->{_sawblank} = 1; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
elsif( !$self->{_inblock} and !$self->{_infor} ) { |
149
|
18
|
|
|
|
|
26
|
$self->_sawsomethingelse; |
150
|
18
|
|
|
|
|
33
|
$self->{_sawblank} = 0; |
151
|
|
|
|
|
|
|
} |
152
|
168
|
|
|
|
|
195
|
$self->{_currpod} .= $_; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
else { |
156
|
14
|
100
|
|
|
|
37
|
if( /^\s*$/ ) { |
157
|
8
|
|
|
|
|
9
|
$self->{_sawblank} = 1; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
else { |
160
|
6
|
|
|
|
|
39
|
$self->_sawsomethingelse; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
240
|
|
|
|
|
236
|
$self->{_linenum}++; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
|
167
|
2
|
|
|
|
|
4
|
$self->_endfor; |
168
|
|
|
|
|
|
|
|
169
|
2
|
|
|
|
|
2
|
push @{$self->{example}}, @{$self->{_for}{example}}; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
6
|
|
170
|
2
|
|
|
|
|
2
|
push @{$self->{testing}}, @{$self->{_for}{testing}}; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
4
|
|
171
|
2
|
|
|
|
|
3
|
push @{$self->{example_testing}}, @{$self->{_for}{example_testing}}; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
8
|
|
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
#=head2 _init |
175
|
|
|
|
|
|
|
# |
176
|
|
|
|
|
|
|
# $parser->_init; |
177
|
|
|
|
|
|
|
# |
178
|
|
|
|
|
|
|
#Initializes the state of the parser, but not the rest of the object. |
179
|
|
|
|
|
|
|
#Should be called before each parse of new POD. |
180
|
|
|
|
|
|
|
sub _init { |
181
|
3
|
|
|
3
|
|
4
|
my ($self) = shift; |
182
|
3
|
|
|
|
|
9
|
$self->{_sawblank} = 1; |
183
|
3
|
|
|
|
|
4
|
$self->{_inblock} = 0; |
184
|
3
|
|
|
|
|
5
|
$self->{_infor} = 0; |
185
|
3
|
|
|
|
|
3
|
$self->{_inpod} = 0; |
186
|
3
|
|
|
|
|
4
|
$self->{_linenum} = 1; |
187
|
|
|
|
|
|
|
$self->{_for} = { |
188
|
3
|
|
|
|
|
24
|
example => [], |
189
|
|
|
|
|
|
|
testing => [], |
190
|
|
|
|
|
|
|
example_testing => [], |
191
|
|
|
|
|
|
|
}; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub _sawsomethingelse { |
195
|
24
|
|
|
24
|
|
107
|
my ($self) = shift; |
196
|
24
|
|
|
|
|
33
|
$self->{_lasttype} = 0; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
#=head2 _beginfor |
200
|
|
|
|
|
|
|
# |
201
|
|
|
|
|
|
|
# $parser->_beginfor($format, $pod); |
202
|
|
|
|
|
|
|
# |
203
|
|
|
|
|
|
|
#Indicates that a =for tag has been seen. $format (what immediately |
204
|
|
|
|
|
|
|
#follows '=for'), and $pod is the rest of the POD on that line. |
205
|
|
|
|
|
|
|
sub _beginfor { |
206
|
28
|
|
|
28
|
|
33
|
my($self, $for, $pod) = @_; |
207
|
|
|
|
|
|
|
|
208
|
28
|
100
|
100
|
|
|
78
|
if( $for eq 'example' and defined $pod ) { |
209
|
10
|
50
|
|
|
|
12
|
if( $pod eq 'begin' ) { |
|
|
0
|
|
|
|
|
|
210
|
10
|
|
|
|
|
14
|
return $self->_beginblock($for); |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
elsif( $pod eq 'end' ) { |
213
|
0
|
|
|
|
|
0
|
return $self->_endlblock; |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
18
|
|
|
|
|
15
|
$self->{_infor} = $for; |
218
|
18
|
|
|
|
|
20
|
$self->{_currpod} = $pod; |
219
|
18
|
|
|
|
|
26
|
$self->{_forstart} = $self->{_linenum}; |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
#=head2 _endfor |
223
|
|
|
|
|
|
|
# |
224
|
|
|
|
|
|
|
# $parser->endfor; |
225
|
|
|
|
|
|
|
# |
226
|
|
|
|
|
|
|
#Indicates that the current =for block has ended. |
227
|
|
|
|
|
|
|
sub _endfor { |
228
|
20
|
|
|
20
|
|
21
|
my($self) = shift; |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
my $pod = { |
231
|
|
|
|
|
|
|
code => $self->{_currpod}, |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
# Skip over the "=for" line |
234
|
20
|
|
|
|
|
82
|
line => $self->{_forstart} + 1, |
235
|
|
|
|
|
|
|
}; |
236
|
|
|
|
|
|
|
|
237
|
20
|
100
|
|
|
|
37
|
if( $self->{_infor} ) { |
238
|
|
|
|
|
|
|
$self->_example_testing($pod) |
239
|
18
|
100
|
|
|
|
32
|
if $self->{_infor} eq 'example_testing'; |
240
|
|
|
|
|
|
|
|
241
|
18
|
100
|
|
|
|
35
|
if( $self->{_infor} eq $self->{_lasttype}) { |
242
|
4
|
|
|
|
|
2
|
my $last_for = ${$self->{_for}{$self->{_infor}}}[-1]; |
|
4
|
|
|
|
|
9
|
|
243
|
|
|
|
|
|
|
$last_for->{code} .= "\n" x ($pod->{line} - |
244
|
|
|
|
|
|
|
($last_for->{line} + |
245
|
4
|
|
|
|
|
24
|
$last_for->{code} =~ tr/\n//) |
246
|
|
|
|
|
|
|
); |
247
|
4
|
|
|
|
|
8
|
$last_for->{code} .= $self->{_currpod}; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
else { |
250
|
14
|
|
|
|
|
14
|
push @{$self->{_for}{$self->{_infor}}}, $pod; |
|
14
|
|
|
|
|
40
|
|
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
20
|
|
|
|
|
41
|
$self->{_lasttype} = $self->{_infor}; |
255
|
20
|
|
|
|
|
33
|
$self->{_infor} = 0; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
#=head2 _beginblock |
259
|
|
|
|
|
|
|
# |
260
|
|
|
|
|
|
|
# $parser->_beginblock($format); |
261
|
|
|
|
|
|
|
# |
262
|
|
|
|
|
|
|
#Indicates that the parser saw a =begin tag. $format is the word |
263
|
|
|
|
|
|
|
#immediately following =begin. |
264
|
|
|
|
|
|
|
sub _beginblock { |
265
|
16
|
|
|
16
|
|
18
|
my($self, $for) = @_; |
266
|
|
|
|
|
|
|
|
267
|
16
|
|
|
|
|
18
|
$self->{_inblock} = $for; |
268
|
16
|
|
|
|
|
16
|
$self->{_currpod} = ''; |
269
|
16
|
|
|
|
|
24
|
$self->{_blockstart} = $self->{_linenum}; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
#=head2 _endblock |
273
|
|
|
|
|
|
|
# |
274
|
|
|
|
|
|
|
# $parser->_endblock |
275
|
|
|
|
|
|
|
# |
276
|
|
|
|
|
|
|
#Indicates that the parser saw an =end tag for the current block. |
277
|
|
|
|
|
|
|
sub _endblock { |
278
|
16
|
|
|
16
|
|
19
|
my($self) = shift; |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
my $pod = { |
281
|
|
|
|
|
|
|
code => $self->{_currpod}, |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
# Skip over the "=begin" |
284
|
16
|
|
|
|
|
67
|
line => $self->{_blockstart} + 1, |
285
|
|
|
|
|
|
|
}; |
286
|
|
|
|
|
|
|
|
287
|
16
|
50
|
|
|
|
34
|
if( $self->{_inblock} ) { |
288
|
|
|
|
|
|
|
$self->_example_testing($self->{_currpod}) |
289
|
16
|
50
|
|
|
|
24
|
if $self->{_inblock} eq 'example_testing'; |
290
|
|
|
|
|
|
|
|
291
|
16
|
100
|
|
|
|
27
|
if( $self->{_inblock} eq $self->{_lasttype}) { |
292
|
2
|
|
|
|
|
2
|
my $last_for = ${$self->{_for}{$self->{_inblock}}}[-1]; |
|
2
|
|
|
|
|
5
|
|
293
|
|
|
|
|
|
|
$last_for->{code} .= "\n" x ($pod->{line} - |
294
|
|
|
|
|
|
|
($last_for->{line} + |
295
|
2
|
|
|
|
|
14
|
$last_for->{code} =~ tr/\n//) |
296
|
|
|
|
|
|
|
); |
297
|
2
|
|
|
|
|
6
|
$last_for->{code} .= $self->{_currpod}; |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
else { |
300
|
14
|
|
|
|
|
10
|
push @{$self->{_for}{$self->{_inblock}}}, $pod; |
|
14
|
|
|
|
|
26
|
|
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
16
|
|
|
|
|
20
|
$self->{_lasttype} = $self->{_inblock}; |
305
|
16
|
|
|
|
|
24
|
$self->{_inblock} = 0; |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
sub _example_testing { |
309
|
4
|
|
|
4
|
|
5
|
my($self, $test) = @_; |
310
|
|
|
|
|
|
|
|
311
|
4
|
|
|
|
|
5
|
my $last_example = ${$self->{_for}{example}}[-1]; |
|
4
|
|
|
|
|
9
|
|
312
|
|
|
|
|
|
|
$last_example->{code} .= "\n" x ($test->{line} - |
313
|
|
|
|
|
|
|
($last_example->{line} + |
314
|
4
|
|
|
|
|
18
|
$last_example->{code} =~ tr/\n//) |
315
|
|
|
|
|
|
|
); |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
|
318
|
4
|
|
|
|
|
13
|
$last_example->{testing} = $test->{code}; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=pod |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
=head2 parse_file $file |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
$parser->parse_file($filename); |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
Just like parse() except it works on a file. |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=cut |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
sub parse_file { |
332
|
0
|
|
|
0
|
1
|
0
|
my($self, $file) = @_; |
333
|
|
|
|
|
|
|
|
334
|
0
|
0
|
|
|
|
0
|
unless( open(POD, $file) ) { |
335
|
0
|
|
|
|
|
0
|
warn "Couldn't open POD file $file: $!\n"; |
336
|
0
|
|
|
|
|
0
|
return; |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
0
|
|
|
|
|
0
|
return $self->parse_fh(\*POD); |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
=pod |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=head2 parse_fh $fh |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
$parser->parse_fh($fh); |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
Just like parse() except it works on a filehandle. |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=cut |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
sub parse_fh { |
353
|
2
|
|
|
2
|
1
|
2988
|
my($self, $fh) = @_; |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
# Yeah, this is inefficient. Sue me. |
356
|
2
|
|
|
|
|
97
|
return $self->parse(<$fh>); |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=pod |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
=head2 tests |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
@testing = $parser->tests; |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
Returns the tests found in the parsed POD documents. Each element of |
366
|
|
|
|
|
|
|
@testing is a hash representing an individual testing block and contains |
367
|
|
|
|
|
|
|
information about that block. |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
$test->{code} actual testing code |
370
|
|
|
|
|
|
|
$test->{line} line from where the test was taken |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
=cut |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
sub tests { |
375
|
2
|
|
|
2
|
1
|
25
|
my($self) = shift; |
376
|
2
|
|
|
|
|
2
|
return @{$self->{testing}}; |
|
2
|
|
|
|
|
9
|
|
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
=pod |
380
|
|
|
|
|
|
|
|
381
|
|
|
|
|
|
|
=head2 examples |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
@examples = $parser->examples; |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
Returns the examples found in the parsed POD documents. Each element of |
386
|
|
|
|
|
|
|
@examples is a hash representing an individual testing block and contains |
387
|
|
|
|
|
|
|
information about that block. |
388
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
$test->{code} actual testing code |
390
|
|
|
|
|
|
|
$test->{line} line from where the test was taken |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=cut |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
sub examples { |
395
|
2
|
|
|
2
|
1
|
7
|
my($self) = shift; |
396
|
2
|
|
|
|
|
2
|
return @{$self->{example}}; |
|
2
|
|
|
|
|
10
|
|
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
=pod |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=head2 build_tests |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
my @code = $p->build_tests(@tests); |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
Returns a code fragment based on the given embedded @tests. This |
406
|
|
|
|
|
|
|
fragment is expected to print the usual "ok/not ok" (or something |
407
|
|
|
|
|
|
|
Test::Harness can read) or nothing at all. |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
Typical usage might be: |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
my @code = $p->build_tests($p->tests); |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
This fragment is suitable for placing into a larger test script. |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
B Look at pod2test before embarking on your own test building. |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
=cut |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
sub build_tests { |
420
|
0
|
|
|
0
|
1
|
|
my ($self, @tests) = @_; |
421
|
|
|
|
|
|
|
|
422
|
0
|
|
|
|
|
|
my @code = (); |
423
|
|
|
|
|
|
|
|
424
|
0
|
|
|
|
|
|
foreach my $test (@tests) { |
425
|
0
|
|
0
|
|
|
|
my $file = $self->{file} || ''; |
426
|
0
|
|
|
|
|
|
push @code, <
|
427
|
|
|
|
|
|
|
{ |
428
|
|
|
|
|
|
|
undef \$main::_STDOUT_; |
429
|
|
|
|
|
|
|
undef \$main::_STDERR_; |
430
|
|
|
|
|
|
|
#line $test->{line} $file |
431
|
|
|
|
|
|
|
$test->{code} |
432
|
|
|
|
|
|
|
undef \$main::_STDOUT_; |
433
|
|
|
|
|
|
|
undef \$main::_STDERR_; |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
CODE |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
} |
438
|
|
|
|
|
|
|
|
439
|
0
|
|
|
|
|
|
return @code; |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=pod |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=head2 build_examples |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
my @code = $p->build_examples(@examples); |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
Similar to build_tests(), it creates a code fragment which tests the |
449
|
|
|
|
|
|
|
basic validity of your example code. Essentially, it just makes sure |
450
|
|
|
|
|
|
|
it compiles. |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
If your example has an "example testing" block associated with it it |
453
|
|
|
|
|
|
|
will run the the example code and the example testing block. |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
=cut |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
sub build_examples { |
458
|
0
|
|
|
0
|
1
|
|
my($self, @examples) = @_; |
459
|
|
|
|
|
|
|
|
460
|
0
|
|
|
|
|
|
my @code = (); |
461
|
0
|
|
|
|
|
|
foreach my $example (@examples) { |
462
|
0
|
|
0
|
|
|
|
my $file = $self->{file} || ''; |
463
|
0
|
|
|
|
|
|
push @code, <
|
464
|
|
|
|
|
|
|
undef \$main::_STDOUT_; |
465
|
|
|
|
|
|
|
undef \$main::_STDERR_; |
466
|
|
|
|
|
|
|
eval q{ |
467
|
|
|
|
|
|
|
my \$example = sub { |
468
|
|
|
|
|
|
|
local \$^W = 0; |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
#line $example->{line} $file |
471
|
|
|
|
|
|
|
$example->{code}; |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
} |
474
|
|
|
|
|
|
|
}; |
475
|
|
|
|
|
|
|
is(\$@, '', "example from line $example->{line}"); |
476
|
|
|
|
|
|
|
CODE |
477
|
|
|
|
|
|
|
|
478
|
0
|
0
|
|
|
|
|
if( $example->{testing} ) { |
479
|
0
|
|
|
|
|
|
$example->{code} .= $example->{testing}; |
480
|
0
|
|
|
|
|
|
push @code, $self->build_tests($example); |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
|
483
|
0
|
|
|
|
|
|
push @code, <
|
484
|
|
|
|
|
|
|
undef \$main::_STDOUT_; |
485
|
|
|
|
|
|
|
undef \$main::_STDERR_; |
486
|
|
|
|
|
|
|
CODE |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
|
489
|
0
|
|
|
|
|
|
return @code; |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
=pod |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
=head1 EXAMPLES |
495
|
|
|
|
|
|
|
|
496
|
|
|
|
|
|
|
Here's the simplest example, just finding the tests and examples in a |
497
|
|
|
|
|
|
|
single module. |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
my $p = Pod::Tests->new; |
500
|
|
|
|
|
|
|
$p->parse_file("path/to/Some.pm"); |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
And one to find all the tests and examples in a directory of files. This |
503
|
|
|
|
|
|
|
illustrates building a set of examples and tests through multiple calls |
504
|
|
|
|
|
|
|
to parse_file(). |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
my $p = Pod::Tests->new; |
507
|
|
|
|
|
|
|
opendir(PODS, "path/to/some/lib/") || die $!; |
508
|
|
|
|
|
|
|
while( my $file = readdir PODS ) { |
509
|
|
|
|
|
|
|
$p->parse_file($file); |
510
|
|
|
|
|
|
|
} |
511
|
|
|
|
|
|
|
printf "Found %d examples and %d tests in path/to/some/lib\n", |
512
|
|
|
|
|
|
|
scalar $p->examples, scalar $p->tests; |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
Finally, an example of parsing your own POD using the DATA filehandle. |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
use Fcntl qw(:seek); |
517
|
|
|
|
|
|
|
my $p = Pod::Tests->new; |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
# Seek to the beginning of the current code. |
520
|
|
|
|
|
|
|
seek(DATA, 0, SEEK_SET) || die $!; |
521
|
|
|
|
|
|
|
$p->parse_fh(\*DATA); |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
=head2 SUPPORT |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
This module has been replaced by the newer L 2. Most testing |
526
|
|
|
|
|
|
|
code that currently works with C should continue to work with |
527
|
|
|
|
|
|
|
the new version. The most notable exceptions are C<=for begin> and |
528
|
|
|
|
|
|
|
C<=for end>, which are deprecated. |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
After upgrading, Pod::Tests and C were split out to provide |
531
|
|
|
|
|
|
|
a compatibility package for legacy code. |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
C will stay in CPAN, but should remain unchanged indefinately, |
534
|
|
|
|
|
|
|
with the exception of any minor bugs that will require squishing. |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
Bugs in this dist should be reported via the following URL. Feature requests |
537
|
|
|
|
|
|
|
should not be submitted, as further development is now occuring in |
538
|
|
|
|
|
|
|
L. |
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
L |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
=head1 AUTHOR |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
Michael G Schwern Eschwern@pobox.comE |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
Repackaged by Adam Kennedy Ecpan@ali.asE |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
=head1 SEE ALSO |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
L |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
L, Perl 6 RFC 183 http://dev.perl.org/rfc183.pod |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
Short set of slides on Pod::Tests |
555
|
|
|
|
|
|
|
http://www.pobox.com/~schwern/talks/Embedded_Testing/ |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
Similar schemes can be found in L and L. |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
=head1 COPYRIGHT |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
Copyright 2001 - 2003 Michael G Schwern. All rights reserved. |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
Some parts copyright 2005 Adam Kennedy. All rights reserved. |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
This program is free software; you can redistribute |
566
|
|
|
|
|
|
|
it and/or modify it under the same terms as Perl itself. |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
The full text of the license can be found in the |
569
|
|
|
|
|
|
|
LICENSE file included with this module. |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
=cut |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
1; |