Commit | Line | Data |
7b47f8ec |
1 | #!/usr/bin/perl -w |
2 | |
12f8b801 |
3 | use Test::More; |
222046ef |
4 | use strict; |
7b47f8ec |
5 | |
6 | BEGIN { |
81f61c1a |
7 | if ($^O eq 'MSWin32' || $^O eq 'VMS') { |
8 | plan skip_all => "Not portable on Win32 or VMS\n"; |
12f8b801 |
9 | } |
10 | else { |
1bc4b319 |
11 | plan tests => 34; |
12f8b801 |
12 | } |
13 | use_ok ("Pod::Usage"); |
7b47f8ec |
14 | } |
15 | |
7b47f8ec |
16 | sub getoutput |
17 | { |
18 | my ($code) = @_; |
1bc4b319 |
19 | my $pid = open(TEST_IN, "-|"); |
7b47f8ec |
20 | unless(defined $pid) { |
21 | die "Cannot fork: $!"; |
22 | } |
23 | if($pid) { |
24 | # parent |
1bc4b319 |
25 | my @out = <TEST_IN>; |
26 | close(TEST_IN); |
7b47f8ec |
27 | my $exit = $?>>8; |
12f8b801 |
28 | s/^/#/ for @out; |
29 | local $" = ""; |
30 | print "#EXIT=$exit OUTPUT=+++#@out#+++\n"; |
7b47f8ec |
31 | return($exit, join("",@out)); |
32 | } |
33 | # child |
34 | open(STDERR, ">&STDOUT"); |
1bc4b319 |
35 | Test::More->builder->no_ending(1); |
7b47f8ec |
36 | &$code; |
37 | print "--NORMAL-RETURN--\n"; |
38 | exit 0; |
39 | } |
40 | |
41 | sub compare |
42 | { |
43 | my ($left,$right) = @_; |
12f8b801 |
44 | $left =~ s/^#\s+/#/gm; |
45 | $right =~ s/^#\s+/#/gm; |
46 | $left =~ s/\s+/ /gm; |
7b47f8ec |
47 | $right =~ s/\s+/ /gm; |
48 | $left eq $right; |
49 | } |
50 | |
1bc4b319 |
51 | SKIP: { |
52 | if('Pod::Usage'->isa('Pod::Text') && $Pod::Text::VERSION < 2.18) { |
53 | skip("Formatting with Pod::Text $Pod::Text::VERSION not reliable", 33); |
54 | } |
55 | |
7b47f8ec |
56 | my ($exit, $text) = getoutput( sub { pod2usage() } ); |
12f8b801 |
57 | is ($exit, 2, "Exit status pod2usage ()"); |
58 | ok (compare ($text, <<'EOT'), "Output test pod2usage ()"); |
59 | #Usage: |
ce6e48f3 |
60 | # frobnicate [ -r | --recursive ] [ -f | --force ] file ... |
12f8b801 |
61 | # |
7b47f8ec |
62 | EOT |
63 | |
7b47f8ec |
64 | ($exit, $text) = getoutput( sub { pod2usage( |
65 | -message => 'You naughty person, what did you say?', |
12f8b801 |
66 | -verbose => 1 ) }); |
67 | is ($exit, 1, "Exit status pod2usage (-message => '...', -verbose => 1)"); |
1bc4b319 |
68 | ok (compare ($text, <<'EOT'), "Output test pod2usage (-message => '...', -verbose => 1)") or diag("Got:\n$text\n"); |
12f8b801 |
69 | #You naughty person, what did you say? |
70 | # Usage: |
ce6e48f3 |
71 | # frobnicate [ -r | --recursive ] [ -f | --force ] file ... |
12f8b801 |
72 | # |
73 | # Options: |
74 | # -r | --recursive |
75 | # Run recursively. |
76 | # |
77 | # -f | --force |
78 | # Just do it! |
79 | # |
80 | # -n number |
81 | # Specify number of frobs, default is 42. |
82 | # |
7b47f8ec |
83 | EOT |
84 | |
7b47f8ec |
85 | ($exit, $text) = getoutput( sub { pod2usage( |
86 | -verbose => 2, -exit => 42 ) } ); |
12f8b801 |
87 | is ($exit, 42, "Exit status pod2usage (-verbose => 2, -exit => 42)"); |
88 | ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 2, -exit => 42)"); |
89 | #NAME |
90 | # frobnicate - do what I mean |
91 | # |
92 | # SYNOPSIS |
ce6e48f3 |
93 | # frobnicate [ -r | --recursive ] [ -f | --force ] file ... |
12f8b801 |
94 | # |
95 | # DESCRIPTION |
96 | # frobnicate does foo and bar and what not. |
97 | # |
98 | # OPTIONS |
99 | # -r | --recursive |
100 | # Run recursively. |
101 | # |
102 | # -f | --force |
103 | # Just do it! |
104 | # |
105 | # -n number |
106 | # Specify number of frobs, default is 42. |
107 | # |
7b47f8ec |
108 | EOT |
109 | |
7b47f8ec |
110 | ($exit, $text) = getoutput( sub { pod2usage(0) } ); |
12f8b801 |
111 | is ($exit, 0, "Exit status pod2usage (0)"); |
112 | ok (compare ($text, <<'EOT'), "Output test pod2usage (0)"); |
113 | #Usage: |
ce6e48f3 |
114 | # frobnicate [ -r | --recursive ] [ -f | --force ] file ... |
12f8b801 |
115 | # |
116 | # Options: |
117 | # -r | --recursive |
118 | # Run recursively. |
119 | # |
120 | # -f | --force |
121 | # Just do it! |
122 | # |
123 | # -n number |
124 | # Specify number of frobs, default is 42. |
125 | # |
7b47f8ec |
126 | EOT |
127 | |
7b47f8ec |
128 | ($exit, $text) = getoutput( sub { pod2usage(42) } ); |
12f8b801 |
129 | is ($exit, 42, "Exit status pod2usage (42)"); |
130 | ok (compare ($text, <<'EOT'), "Output test pod2usage (42)"); |
131 | #Usage: |
ce6e48f3 |
132 | # frobnicate [ -r | --recursive ] [ -f | --force ] file ... |
12f8b801 |
133 | # |
7b47f8ec |
134 | EOT |
135 | |
7b47f8ec |
136 | ($exit, $text) = getoutput( sub { pod2usage(-verbose => 0, -exit => 'NOEXIT') } ); |
12f8b801 |
137 | is ($exit, 0, "Exit status pod2usage (-verbose => 0, -exit => 'NOEXIT')"); |
138 | ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 0, -exit => 'NOEXIT')"); |
139 | #Usage: |
ce6e48f3 |
140 | # frobnicate [ -r | --recursive ] [ -f | --force ] file ... |
12f8b801 |
141 | # |
142 | # --NORMAL-RETURN-- |
7b47f8ec |
143 | EOT |
144 | |
7b47f8ec |
145 | ($exit, $text) = getoutput( sub { pod2usage(-verbose => 99, -sections => 'DESCRIPTION') } ); |
12f8b801 |
146 | is ($exit, 1, "Exit status pod2usage (-verbose => 99, -sections => 'DESCRIPTION')"); |
147 | ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 99, -sections => 'DESCRIPTION')"); |
148 | #Description: |
149 | # frobnicate does foo and bar and what not. |
150 | # |
7b47f8ec |
151 | EOT |
152 | |
1bc4b319 |
153 | # does the __DATA__ work ok as input |
222046ef |
154 | my ($blib, $test_script, $pod_file1, , $pod_file2); |
155 | if ($ENV{PERL_CORE}) { |
156 | $blib = '-I../lib'; |
157 | $test_script = File::Spec->catfile(qw(pod p2u_data.pl)); |
158 | $pod_file1 = File::Spec->catfile(qw(pod usage.pod)); |
159 | $pod_file2 = File::Spec->catfile(qw(pod usage2.pod)); |
160 | } else { |
161 | $blib = '-Mblib'; |
162 | $test_script = File::Spec->catfile(qw(t pod p2u_data.pl)); |
163 | $pod_file1 = File::Spec->catfile(qw(t pod usage.pod)); |
164 | $pod_file2 = File::Spec->catfile(qw(t pod usage2.pod)); |
165 | } |
166 | |
167 | ($exit, $text) = getoutput( sub { system($^X, $blib, $test_script); exit($? >> 8); } ); |
1bc4b319 |
168 | $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR |
169 | is ($exit, 17, "Exit status pod2usage (-verbose => 2, -input => \*DATA)"); |
170 | ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 2, -input => \*DATA)") or diag "Got:\n$text\n"; |
171 | #NAME |
172 | # Test |
173 | # |
174 | #SYNOPSIS |
175 | # perl podusagetest.pl |
176 | # |
177 | #DESCRIPTION |
178 | # This is a test. |
179 | # |
180 | EOT |
181 | |
182 | # test that SYNOPSIS and USAGE are printed |
222046ef |
183 | ($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file1, |
1bc4b319 |
184 | -exitval => 0, -verbose => 0); }); |
185 | $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR |
186 | is ($exit, 0, "Exit status pod2usage with USAGE"); |
187 | ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE") or diag "Got:\n$text\n"; |
188 | #Usage: |
189 | # This is a test for CPAN#33020 |
190 | # |
191 | #Usage: |
192 | # And this will be also printed. |
193 | # |
194 | EOT |
7b47f8ec |
195 | |
1bc4b319 |
196 | # test that SYNOPSIS and USAGE are printed with options |
222046ef |
197 | ($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file1, |
1bc4b319 |
198 | -exitval => 0, -verbose => 1); }); |
199 | $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR |
200 | is ($exit, 0, "Exit status pod2usage with USAGE and verbose=1"); |
201 | ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE and verbose=1") or diag "Got:\n$text\n"; |
202 | #Usage: |
203 | # This is a test for CPAN#33020 |
204 | # |
205 | #Usage: |
206 | # And this will be also printed. |
207 | # |
208 | #Options: |
209 | # And this with verbose == 1 |
210 | # |
211 | EOT |
212 | |
213 | # test that only USAGE is printed when requested |
222046ef |
214 | ($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file1, |
1bc4b319 |
215 | -exitval => 0, -verbose => 99, -sections => 'USAGE'); }); |
216 | $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR |
217 | is ($exit, 0, "Exit status pod2usage with USAGE and verbose=99"); |
218 | ok (compare ($text, <<'EOT'), "Output test pod2usage with USAGE and verbose=99") or diag "Got:\n$text\n"; |
219 | #Usage: |
220 | # This is a test for CPAN#33020 |
221 | # |
222 | EOT |
223 | |
224 | # test with pod_where |
225 | use_ok('Pod::Find', qw(pod_where)); |
226 | ($exit, $text) = getoutput( sub { pod2usage( -input => pod_where({-inc => 1}, 'Pod::Usage'), |
227 | -exitval => 0, -verbose => 0) } ); |
228 | $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR |
229 | is ($exit, 0, "Exit status pod2usage with Pod::Find"); |
230 | ok (compare ($text, <<'EOT'), "Output test pod2usage with Pod::Find") or diag "Got:\n$text\n"; |
231 | #Usage: |
232 | # use Pod::Usage |
233 | # |
234 | # my $message_text = "This text precedes the usage message."; |
235 | # my $exit_status = 2; ## The exit status to use |
236 | # my $verbose_level = 0; ## The verbose level to use |
237 | # my $filehandle = \*STDERR; ## The filehandle to write to |
238 | # |
239 | # pod2usage($message_text); |
240 | # |
241 | # pod2usage($exit_status); |
242 | # |
243 | # pod2usage( { -message => $message_text , |
244 | # -exitval => $exit_status , |
245 | # -verbose => $verbose_level, |
246 | # -output => $filehandle } ); |
247 | # |
248 | # pod2usage( -msg => $message_text , |
249 | # -exitval => $exit_status , |
250 | # -verbose => $verbose_level, |
251 | # -output => $filehandle ); |
252 | # |
253 | # pod2usage( -verbose => 2, |
254 | # -noperldoc => 1 ) |
255 | # |
256 | EOT |
257 | |
258 | # verify that sections are correctly found after nested headings |
222046ef |
259 | ($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file2, |
1bc4b319 |
260 | -exitval => 0, -verbose => 99, |
261 | -sections => [qw(BugHeader BugHeader/.*')]) }); |
262 | $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR |
263 | is ($exit, 0, "Exit status pod2usage with nested headings"); |
264 | ok (compare ($text, <<'EOT'), "Output test pod2usage with nested headings") or diag "Got:\n$text\n"; |
265 | #BugHeader: |
266 | # Some text |
267 | # |
268 | # BugHeader2: |
269 | # More |
270 | # Still More |
271 | # |
272 | EOT |
273 | |
274 | # Verify that =over =back work OK |
275 | ($exit, $text) = getoutput( sub { |
222046ef |
276 | pod2usage(-input => $pod_file2, |
1bc4b319 |
277 | -exitval => 0, -verbose => 99, -sections => 'BugHeader/BugHeader2') } ); |
278 | $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR |
279 | is ($exit, 0, "Exit status pod2usage with over/back"); |
280 | ok (compare ($text, <<'EOT'), "Output test pod2usage with over/back") or diag "Got:\n$text\n"; |
281 | # BugHeader2: |
282 | # More |
283 | # Still More |
284 | # |
285 | EOT |
286 | |
287 | # new array API for -sections |
288 | ($exit, $text) = getoutput( sub { |
222046ef |
289 | pod2usage(-input => $pod_file2, |
1bc4b319 |
290 | -exitval => 0, -verbose => 99, -sections => [qw(Heading-1/!.+ Heading-2/.+)]) } ); |
291 | $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR |
292 | is ($exit, 0, "Exit status pod2usage with -sections => []"); |
293 | ok (compare ($text, <<'EOT'), "Output test pod2usage with -sections => []") or diag "Got:\n$text\n"; |
294 | #Heading-1: |
295 | # One |
296 | # Two |
297 | # |
298 | # Heading-2.2: |
299 | # More text. |
300 | # |
301 | EOT |
302 | |
303 | # allow subheadings in OPTIONS and ARGUMENTS |
304 | ($exit, $text) = getoutput( sub { |
222046ef |
305 | pod2usage(-input => $pod_file2, |
1bc4b319 |
306 | -exitval => 0, -verbose => 1) } ); |
307 | $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR |
308 | $text =~ s{[*](destination|files)[*]}{$1}g; # strip * chars |
309 | is ($exit, 0, "Exit status pod2usage with subheadings in OPTIONS"); |
310 | ok (compare ($text, <<'EOT'), "Output test pod2usage with subheadings in OPTIONS") or diag "Got:\n$text\n"; |
311 | #Options and Arguments: |
312 | # Arguments: |
313 | # The required arguments (which typically follow any options on the |
314 | # command line) are: |
315 | # |
316 | # destination |
317 | # files |
318 | # |
319 | # Options: |
320 | # Options may be abbreviated. Options which take values may be separated |
321 | # from the values by whitespace or the "=" character. |
322 | # |
323 | EOT |
324 | } # end SKIP |
7b47f8ec |
325 | |
326 | __END__ |
327 | |
328 | =head1 NAME |
329 | |
330 | frobnicate - do what I mean |
331 | |
332 | =head1 SYNOPSIS |
333 | |
334 | B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]> |
ce6e48f3 |
335 | file ... |
7b47f8ec |
336 | |
337 | =head1 DESCRIPTION |
338 | |
339 | B<frobnicate> does foo and bar and what not. |
340 | |
341 | =head1 OPTIONS |
342 | |
343 | =over 4 |
344 | |
345 | =item B<-r> | B<--recursive> |
346 | |
347 | Run recursively. |
348 | |
349 | =item B<-f> | B<--force> |
350 | |
351 | Just do it! |
352 | |
ce6e48f3 |
353 | =item B<-n> number |
7b47f8ec |
354 | |
355 | Specify number of frobs, default is 42. |
356 | |
357 | =back |
358 | |
359 | =cut |
360 | |