Upgrade to ExtUtils-MakeMaker-6.50
[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 : ();
230($exit, $text) = getoutput( sub { pod2usage( -input => pod_where({-inc => 1, @NO_CURDIR}, 'Pod::Usage'),
1bc4b319 231 -exitval => 0, -verbose => 0) } );
232$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
233is ($exit, 0, "Exit status pod2usage with Pod::Find");
234ok (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#
260EOT
261
262# verify that sections are correctly found after nested headings
222046ef 263($exit, $text) = getoutput( sub { pod2usage(-input => $pod_file2,
1bc4b319 264 -exitval => 0, -verbose => 99,
265 -sections => [qw(BugHeader BugHeader/.*')]) });
266$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
267is ($exit, 0, "Exit status pod2usage with nested headings");
268ok (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#
276EOT
277
278# Verify that =over =back work OK
279($exit, $text) = getoutput( sub {
222046ef 280 pod2usage(-input => $pod_file2,
1bc4b319 281 -exitval => 0, -verbose => 99, -sections => 'BugHeader/BugHeader2') } );
282$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
283is ($exit, 0, "Exit status pod2usage with over/back");
284ok (compare ($text, <<'EOT'), "Output test pod2usage with over/back") or diag "Got:\n$text\n";
285# BugHeader2:
286# More
287# Still More
288#
289EOT
290
291# new array API for -sections
292($exit, $text) = getoutput( sub {
222046ef 293 pod2usage(-input => $pod_file2,
1bc4b319 294 -exitval => 0, -verbose => 99, -sections => [qw(Heading-1/!.+ Heading-2/.+)]) } );
295$text =~ s{#Using.*/blib.*\n}{}; # older blib's emit something to STDERR
296is ($exit, 0, "Exit status pod2usage with -sections => []");
297ok (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#
305EOT
306
307# allow subheadings in OPTIONS and ARGUMENTS
308($exit, $text) = getoutput( sub {
222046ef 309 pod2usage(-input => $pod_file2,
1bc4b319 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
313is ($exit, 0, "Exit status pod2usage with subheadings in OPTIONS");
314ok (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#
327EOT
328} # end SKIP
7b47f8ec 329
330__END__
331
332=head1 NAME
333
334frobnicate - do what I mean
335
336=head1 SYNOPSIS
337
338B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]>
ce6e48f3 339 file ...
7b47f8ec 340
341=head1 DESCRIPTION
342
343B<frobnicate> does foo and bar and what not.
344
345=head1 OPTIONS
346
347=over 4
348
349=item B<-r> | B<--recursive>
350
351Run recursively.
352
353=item B<-f> | B<--force>
354
355Just do it!
356
ce6e48f3 357=item B<-n> number
7b47f8ec 358
359Specify number of frobs, default is 42.
360
361=back
362
363=cut
364