sync t/pod/pod2usage2.t with CPAN (trivial whitespace change)
[p5sagit/p5-mst-13.2.git] / t / pod / pod2usage2.t
CommitLineData
7b47f8ec 1#!/usr/bin/perl -w
2
12f8b801 3use Test::More;
222046ef 4use strict;
7b47f8ec 5
6BEGIN {
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 16sub 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
41sub 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 51SKIP: {
52if('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 56my ($exit, $text) = getoutput( sub { pod2usage() } );
12f8b801 57is ($exit, 2, "Exit status pod2usage ()");
58ok (compare ($text, <<'EOT'), "Output test pod2usage ()");
59#Usage:
ce6e48f3 60# frobnicate [ -r | --recursive ] [ -f | --force ] file ...
12f8b801 61#
7b47f8ec 62EOT
63
7b47f8ec 64($exit, $text) = getoutput( sub { pod2usage(
65 -message => 'You naughty person, what did you say?',
12f8b801 66 -verbose => 1 ) });
67is ($exit, 1, "Exit status pod2usage (-message => '...', -verbose => 1)");
1bc4b319 68ok (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 83EOT
84
7b47f8ec 85($exit, $text) = getoutput( sub { pod2usage(
86 -verbose => 2, -exit => 42 ) } );
12f8b801 87is ($exit, 42, "Exit status pod2usage (-verbose => 2, -exit => 42)");
88ok (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 108EOT
109
7b47f8ec 110($exit, $text) = getoutput( sub { pod2usage(0) } );
12f8b801 111is ($exit, 0, "Exit status pod2usage (0)");
112ok (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 126EOT
127
7b47f8ec 128($exit, $text) = getoutput( sub { pod2usage(42) } );
12f8b801 129is ($exit, 42, "Exit status pod2usage (42)");
130ok (compare ($text, <<'EOT'), "Output test pod2usage (42)");
131#Usage:
ce6e48f3 132# frobnicate [ -r | --recursive ] [ -f | --force ] file ...
12f8b801 133#
7b47f8ec 134EOT
135
7b47f8ec 136($exit, $text) = getoutput( sub { pod2usage(-verbose => 0, -exit => 'NOEXIT') } );
12f8b801 137is ($exit, 0, "Exit status pod2usage (-verbose => 0, -exit => 'NOEXIT')");
138ok (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 143EOT
144
7b47f8ec 145($exit, $text) = getoutput( sub { pod2usage(-verbose => 99, -sections => 'DESCRIPTION') } );
12f8b801 146is ($exit, 1, "Exit status pod2usage (-verbose => 99, -sections => 'DESCRIPTION')");
147ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 99, -sections => 'DESCRIPTION')");
148#Description:
149# frobnicate does foo and bar and what not.
150#
7b47f8ec 151EOT
152
1bc4b319 153# does the __DATA__ work ok as input
222046ef 154my ($blib, $test_script, $pod_file1, , $pod_file2);
155if ($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
8b2bdce6 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
169is ($exit, 17, "Exit status pod2usage (-verbose => 2, -input => \*DATA)");
170ok (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#
180EOT
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
186is ($exit, 0, "Exit status pod2usage with USAGE");
187ok (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#
194EOT
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
200is ($exit, 0, "Exit status pod2usage with USAGE and verbose=1");
201ok (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#
211EOT
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
217is ($exit, 0, "Exit status pod2usage with USAGE and verbose=99");
218ok (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#
222EOT
223
224# test with pod_where
225use_ok('Pod::Find', qw(pod_where));
767c16ab 226# Exclude current dir when testing in CORE under Cygwin
227my @NO_CURDIR = ($^O eq 'cygwin' && $ENV{PERL_CORE})
228 ? ('-dirs' => [])
229 : ();
66c07212 230
767c16ab 231($exit, $text) = getoutput( sub { pod2usage( -input => pod_where({-inc => 1, @NO_CURDIR}, 'Pod::Usage'),
1bc4b319 232 -exitval => 0, -verbose => 0) } );
233$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
234is ($exit, 0, "Exit status pod2usage with Pod::Find");
235ok (compare ($text, <<'EOT'), "Output test pod2usage with Pod::Find") or diag "Got:\n$text\n";
236#Usage:
237# use Pod::Usage
238#
239# my $message_text = "This text precedes the usage message.";
240# my $exit_status = 2; ## The exit status to use
241# my $verbose_level = 0; ## The verbose level to use
242# my $filehandle = \*STDERR; ## The filehandle to write to
243#
244# pod2usage($message_text);
245#
246# pod2usage($exit_status);
247#
248# pod2usage( { -message => $message_text ,
249# -exitval => $exit_status ,
250# -verbose => $verbose_level,
251# -output => $filehandle } );
252#
253# pod2usage( -msg => $message_text ,
254# -exitval => $exit_status ,
255# -verbose => $verbose_level,
256# -output => $filehandle );
257#
258# pod2usage( -verbose => 2,
259# -noperldoc => 1 )
260#
261EOT
262
263# verify that sections are correctly found after nested headings
222046ef 264($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file2,
1bc4b319 265 -exitval => 0, -verbose => 99,
266 -sections => [qw(BugHeader BugHeader/.*')]) });
267$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
268is ($exit, 0, "Exit status pod2usage with nested headings");
269ok (compare ($text, <<'EOT'), "Output test pod2usage with nested headings") or diag "Got:\n$text\n";
270#BugHeader:
271# Some text
272#
273# BugHeader2:
274# More
275# Still More
276#
277EOT
278
279# Verify that =over =back work OK
280($exit, $text) = getoutput( sub {
222046ef 281 pod2usage(-input => $pod_file2,
1bc4b319 282 -exitval => 0, -verbose => 99, -sections => 'BugHeader/BugHeader2') } );
283$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
284is ($exit, 0, "Exit status pod2usage with over/back");
285ok (compare ($text, <<'EOT'), "Output test pod2usage with over/back") or diag "Got:\n$text\n";
286# BugHeader2:
287# More
288# Still More
289#
290EOT
291
292# new array API for -sections
293($exit, $text) = getoutput( sub {
222046ef 294 pod2usage(-input => $pod_file2,
1bc4b319 295 -exitval => 0, -verbose => 99, -sections => [qw(Heading-1/!.+ Heading-2/.+)]) } );
296$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
297is ($exit, 0, "Exit status pod2usage with -sections => []");
298ok (compare ($text, <<'EOT'), "Output test pod2usage with -sections => []") or diag "Got:\n$text\n";
299#Heading-1:
300# One
301# Two
302#
303# Heading-2.2:
304# More text.
305#
306EOT
307
308# allow subheadings in OPTIONS and ARGUMENTS
309($exit, $text) = getoutput( sub {
222046ef 310 pod2usage(-input => $pod_file2,
1bc4b319 311 -exitval => 0, -verbose => 1) } );
312$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
313$text =~ s{[*](destination|files)[*]}{$1}g; # strip * chars
314is ($exit, 0, "Exit status pod2usage with subheadings in OPTIONS");
315ok (compare ($text, <<'EOT'), "Output test pod2usage with subheadings in OPTIONS") or diag "Got:\n$text\n";
316#Options and Arguments:
317# Arguments:
318# The required arguments (which typically follow any options on the
319# command line) are:
320#
321# destination
322# files
323#
324# Options:
325# Options may be abbreviated. Options which take values may be separated
326# from the values by whitespace or the "=" character.
327#
328EOT
329} # end SKIP
7b47f8ec 330
331__END__
332
333=head1 NAME
334
335frobnicate - do what I mean
336
337=head1 SYNOPSIS
338
339B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]>
ce6e48f3 340 file ...
7b47f8ec 341
342=head1 DESCRIPTION
343
344B<frobnicate> does foo and bar and what not.
345
346=head1 OPTIONS
347
348=over 4
349
350=item B<-r> | B<--recursive>
351
352Run recursively.
353
354=item B<-f> | B<--force>
355
356Just do it!
357
ce6e48f3 358=item B<-n> number
7b47f8ec 359
360Specify number of frobs, default is 42.
361
362=back
363
364=cut
365