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