Upgrade to ExtUtils-MakeMaker-6.50
[p5sagit/p5-mst-13.2.git] / 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 = '-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); } );
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
183 ($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file1,
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
195
196 # test that SYNOPSIS and USAGE are printed with options
197 ($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file1,
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
214 ($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file1,
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 # Exclude current dir when testing in CORE under Cygwin
227 my @NO_CURDIR = ($^O eq 'cygwin' && $ENV{PERL_CORE})
228                     ? ('-dirs' => [])
229                     : ();
230 ($exit, $text) = getoutput( sub { pod2usage( -input => pod_where({-inc => 1, @NO_CURDIR}, 'Pod::Usage'),
231                                              -exitval => 0, -verbose => 0) } );
232 $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
233 is ($exit, 0,                 "Exit status pod2usage with Pod::Find");
234 ok (compare ($text, <<'EOT'), "Output test pod2usage with Pod::Find") or diag "Got:\n$text\n";
235 #Usage:
236 #      use Pod::Usage
237 #
238 #      my $message_text  = "This text precedes the usage message.";
239 #      my $exit_status   = 2;          ## The exit status to use
240 #      my $verbose_level = 0;          ## The verbose level to use
241 #      my $filehandle    = \*STDERR;   ## The filehandle to write to
242 #
243 #      pod2usage($message_text);
244 #
245 #      pod2usage($exit_status);
246 #
247 #      pod2usage( { -message => $message_text ,
248 #                   -exitval => $exit_status  ,  
249 #                   -verbose => $verbose_level,  
250 #                   -output  => $filehandle } );
251 #
252 #      pod2usage(   -msg     => $message_text ,
253 #                   -exitval => $exit_status  ,  
254 #                   -verbose => $verbose_level,  
255 #                   -output  => $filehandle   );
256 #
257 #      pod2usage(   -verbose => 2,
258 #                   -noperldoc => 1  )
259 #
260 EOT
261
262 # verify that sections are correctly found after nested headings
263 ($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file2,
264                                             -exitval => 0, -verbose => 99,
265                                             -sections => [qw(BugHeader BugHeader/.*')]) });
266 $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
267 is ($exit, 0,                 "Exit status pod2usage with nested headings");
268 ok (compare ($text, <<'EOT'), "Output test pod2usage with nested headings") or diag "Got:\n$text\n";
269 #BugHeader:
270 #    Some text
271 #
272 #  BugHeader2:
273 #    More
274 #    Still More
275 #
276 EOT
277
278 # Verify that =over =back work OK
279 ($exit, $text) = getoutput( sub {
280   pod2usage(-input => $pod_file2,
281             -exitval => 0, -verbose => 99, -sections => 'BugHeader/BugHeader2') } );
282 $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
283 is ($exit, 0,                 "Exit status pod2usage with over/back");
284 ok (compare ($text, <<'EOT'), "Output test pod2usage with over/back") or diag "Got:\n$text\n";
285 #  BugHeader2:
286 #    More
287 #    Still More
288 #
289 EOT
290
291 # new array API for -sections
292 ($exit, $text) = getoutput( sub {
293   pod2usage(-input => $pod_file2,
294             -exitval => 0, -verbose => 99, -sections => [qw(Heading-1/!.+ Heading-2/.+)]) } );
295 $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
296 is ($exit, 0,                 "Exit status pod2usage with -sections => []");
297 ok (compare ($text, <<'EOT'), "Output test pod2usage with -sections => []") or diag "Got:\n$text\n";
298 #Heading-1:
299 #    One
300 #    Two
301 #
302 #  Heading-2.2:
303 #    More text.
304 #
305 EOT
306
307 # allow subheadings in OPTIONS and ARGUMENTS
308 ($exit, $text) = getoutput( sub {
309   pod2usage(-input => $pod_file2,
310             -exitval => 0, -verbose => 1) } );
311 $text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
312 $text =~ s{[*](destination|files)[*]}{$1}g; # strip * chars
313 is ($exit, 0,                 "Exit status pod2usage with subheadings in OPTIONS");
314 ok (compare ($text, <<'EOT'), "Output test pod2usage with subheadings in OPTIONS") or diag "Got:\n$text\n";
315 #Options and Arguments:
316 #  Arguments:
317 #    The required arguments (which typically follow any options on the
318 #    command line) are:
319 #
320 #    destination
321 #    files
322 #
323 #  Options:
324 #    Options may be abbreviated. Options which take values may be separated
325 #    from the values by whitespace or the "=" character.
326 #
327 EOT
328 } # end SKIP
329
330 __END__
331
332 =head1 NAME
333
334 frobnicate - do what I mean
335
336 =head1 SYNOPSIS
337
338 B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]>
339   file ...
340
341 =head1 DESCRIPTION
342
343 B<frobnicate> does foo and bar and what not.
344
345 =head1 OPTIONS
346
347 =over 4
348
349 =item B<-r> | B<--recursive>
350
351 Run recursively.
352
353 =item B<-f> | B<--force>
354
355 Just do it!
356
357 =item B<-n> number
358
359 Specify number of frobs, default is 42.
360
361 =back
362
363 =cut
364