This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pod2usage2.t is not readily portable to VMS either
[perl5.git] / t / pod / pod2usage2.t
CommitLineData
7b47f8ec
RGS
1#!/usr/bin/perl -w
2
12f8b801 3use Test::More;
7b47f8ec
RGS
4
5BEGIN {
81f61c1a
CB
6 if ($^O eq 'MSWin32' || $^O eq 'VMS') {
7 plan skip_all => "Not portable on Win32 or VMS\n";
12f8b801
MB
8 }
9 else {
10 plan tests => 15;
11 }
12 use_ok ("Pod::Usage");
7b47f8ec
RGS
13}
14
7b47f8ec
RGS
15sub getoutput
16{
17 my ($code) = @_;
18 my $pid = open(IN, "-|");
19 unless(defined $pid) {
20 die "Cannot fork: $!";
21 }
22 if($pid) {
23 # parent
24 my @out = <IN>;
25 close(IN);
26 my $exit = $?>>8;
12f8b801
MB
27 s/^/#/ for @out;
28 local $" = "";
29 print "#EXIT=$exit OUTPUT=+++#@out#+++\n";
7b47f8ec
RGS
30 return($exit, join("",@out));
31 }
32 # child
33 open(STDERR, ">&STDOUT");
34 &$code;
35 print "--NORMAL-RETURN--\n";
36 exit 0;
37}
38
39sub compare
40{
41 my ($left,$right) = @_;
12f8b801
MB
42 $left =~ s/^#\s+/#/gm;
43 $right =~ s/^#\s+/#/gm;
44 $left =~ s/\s+/ /gm;
7b47f8ec
RGS
45 $right =~ s/\s+/ /gm;
46 $left eq $right;
47}
48
7b47f8ec 49my ($exit, $text) = getoutput( sub { pod2usage() } );
12f8b801
MB
50is ($exit, 2, "Exit status pod2usage ()");
51ok (compare ($text, <<'EOT'), "Output test pod2usage ()");
52#Usage:
ce6e48f3 53# frobnicate [ -r | --recursive ] [ -f | --force ] file ...
12f8b801 54#
7b47f8ec
RGS
55EOT
56
7b47f8ec
RGS
57($exit, $text) = getoutput( sub { pod2usage(
58 -message => 'You naughty person, what did you say?',
12f8b801
MB
59 -verbose => 1 ) });
60is ($exit, 1, "Exit status pod2usage (-message => '...', -verbose => 1)");
61ok (compare ($text, <<'EOT'), "Output test pod2usage (-message => '...', -verbose => 1)");
62#You naughty person, what did you say?
63# Usage:
ce6e48f3 64# frobnicate [ -r | --recursive ] [ -f | --force ] file ...
12f8b801
MB
65#
66# Options:
67# -r | --recursive
68# Run recursively.
69#
70# -f | --force
71# Just do it!
72#
73# -n number
74# Specify number of frobs, default is 42.
75#
7b47f8ec
RGS
76EOT
77
7b47f8ec
RGS
78($exit, $text) = getoutput( sub { pod2usage(
79 -verbose => 2, -exit => 42 ) } );
12f8b801
MB
80is ($exit, 42, "Exit status pod2usage (-verbose => 2, -exit => 42)");
81ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 2, -exit => 42)");
82#NAME
83# frobnicate - do what I mean
84#
85# SYNOPSIS
ce6e48f3 86# frobnicate [ -r | --recursive ] [ -f | --force ] file ...
12f8b801
MB
87#
88# DESCRIPTION
89# frobnicate does foo and bar and what not.
90#
91# OPTIONS
92# -r | --recursive
93# Run recursively.
94#
95# -f | --force
96# Just do it!
97#
98# -n number
99# Specify number of frobs, default is 42.
100#
7b47f8ec
RGS
101EOT
102
7b47f8ec 103($exit, $text) = getoutput( sub { pod2usage(0) } );
12f8b801
MB
104is ($exit, 0, "Exit status pod2usage (0)");
105ok (compare ($text, <<'EOT'), "Output test pod2usage (0)");
106#Usage:
ce6e48f3 107# frobnicate [ -r | --recursive ] [ -f | --force ] file ...
12f8b801
MB
108#
109# Options:
110# -r | --recursive
111# Run recursively.
112#
113# -f | --force
114# Just do it!
115#
116# -n number
117# Specify number of frobs, default is 42.
118#
7b47f8ec
RGS
119EOT
120
7b47f8ec 121($exit, $text) = getoutput( sub { pod2usage(42) } );
12f8b801
MB
122is ($exit, 42, "Exit status pod2usage (42)");
123ok (compare ($text, <<'EOT'), "Output test pod2usage (42)");
124#Usage:
ce6e48f3 125# frobnicate [ -r | --recursive ] [ -f | --force ] file ...
12f8b801 126#
7b47f8ec
RGS
127EOT
128
7b47f8ec 129($exit, $text) = getoutput( sub { pod2usage(-verbose => 0, -exit => 'NOEXIT') } );
12f8b801
MB
130is ($exit, 0, "Exit status pod2usage (-verbose => 0, -exit => 'NOEXIT')");
131ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 0, -exit => 'NOEXIT')");
132#Usage:
ce6e48f3 133# frobnicate [ -r | --recursive ] [ -f | --force ] file ...
12f8b801
MB
134#
135# --NORMAL-RETURN--
7b47f8ec
RGS
136EOT
137
7b47f8ec 138($exit, $text) = getoutput( sub { pod2usage(-verbose => 99, -sections => 'DESCRIPTION') } );
12f8b801
MB
139is ($exit, 1, "Exit status pod2usage (-verbose => 99, -sections => 'DESCRIPTION')");
140ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 99, -sections => 'DESCRIPTION')");
141#Description:
142# frobnicate does foo and bar and what not.
143#
7b47f8ec
RGS
144EOT
145
146
147
148__END__
149
150=head1 NAME
151
152frobnicate - do what I mean
153
154=head1 SYNOPSIS
155
156B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]>
ce6e48f3 157 file ...
7b47f8ec
RGS
158
159=head1 DESCRIPTION
160
161B<frobnicate> does foo and bar and what not.
162
163=head1 OPTIONS
164
165=over 4
166
167=item B<-r> | B<--recursive>
168
169Run recursively.
170
171=item B<-f> | B<--force>
172
173Just do it!
174
ce6e48f3 175=item B<-n> number
7b47f8ec
RGS
176
177Specify number of frobs, default is 42.
178
179=back
180
181=cut
182