Fix paths on new pod2usage2 tests to work in the core.
[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
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));
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
229is ($exit, 0, "Exit status pod2usage with Pod::Find");
230ok (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#
256EOT
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
263is ($exit, 0, "Exit status pod2usage with nested headings");
264ok (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#
272EOT
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
279is ($exit, 0, "Exit status pod2usage with over/back");
280ok (compare ($text, <<'EOT'), "Output test pod2usage with over/back") or diag "Got:\n$text\n";
281# BugHeader2:
282# More
283# Still More
284#
285EOT
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
292is ($exit, 0, "Exit status pod2usage with -sections => []");
293ok (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#
301EOT
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
309is ($exit, 0, "Exit status pod2usage with subheadings in OPTIONS");
310ok (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#
323EOT
324} # end SKIP
7b47f8ec 325
326__END__
327
328=head1 NAME
329
330frobnicate - do what I mean
331
332=head1 SYNOPSIS
333
334B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]>
ce6e48f3 335 file ...
7b47f8ec 336
337=head1 DESCRIPTION
338
339B<frobnicate> does foo and bar and what not.
340
341=head1 OPTIONS
342
343=over 4
344
345=item B<-r> | B<--recursive>
346
347Run recursively.
348
349=item B<-f> | B<--force>
350
351Just do it!
352
ce6e48f3 353=item B<-n> number
7b47f8ec 354
355Specify number of frobs, default is 42.
356
357=back
358
359=cut
360