1 | #!/usr/bin/perl -w
|
---|
2 |
|
---|
3 | use Test::More;
|
---|
4 |
|
---|
5 | BEGIN {
|
---|
6 | if ($^O eq 'MSWin32' || $^O eq 'VMS') {
|
---|
7 | plan skip_all => "Not portable on Win32 or VMS\n";
|
---|
8 | }
|
---|
9 | else {
|
---|
10 | plan tests => 15;
|
---|
11 | }
|
---|
12 | use_ok ("Pod::Usage");
|
---|
13 | }
|
---|
14 |
|
---|
15 | sub 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;
|
---|
27 | s/^/#/ for @out;
|
---|
28 | local $" = "";
|
---|
29 | print "#EXIT=$exit OUTPUT=+++#@out#+++\n";
|
---|
30 | return($exit, join("",@out));
|
---|
31 | }
|
---|
32 | # child
|
---|
33 | open(STDERR, ">&STDOUT");
|
---|
34 | &$code;
|
---|
35 | print "--NORMAL-RETURN--\n";
|
---|
36 | exit 0;
|
---|
37 | }
|
---|
38 |
|
---|
39 | sub compare
|
---|
40 | {
|
---|
41 | my ($left,$right) = @_;
|
---|
42 | $left =~ s/^#\s+/#/gm;
|
---|
43 | $right =~ s/^#\s+/#/gm;
|
---|
44 | $left =~ s/\s+/ /gm;
|
---|
45 | $right =~ s/\s+/ /gm;
|
---|
46 | $left eq $right;
|
---|
47 | }
|
---|
48 |
|
---|
49 | my ($exit, $text) = getoutput( sub { pod2usage() } );
|
---|
50 | is ($exit, 2, "Exit status pod2usage ()");
|
---|
51 | ok (compare ($text, <<'EOT'), "Output test pod2usage ()");
|
---|
52 | #Usage:
|
---|
53 | # frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
|
---|
54 | #
|
---|
55 | EOT
|
---|
56 |
|
---|
57 | ($exit, $text) = getoutput( sub { pod2usage(
|
---|
58 | -message => 'You naughty person, what did you say?',
|
---|
59 | -verbose => 1 ) });
|
---|
60 | is ($exit, 1, "Exit status pod2usage (-message => '...', -verbose => 1)");
|
---|
61 | ok (compare ($text, <<'EOT'), "Output test pod2usage (-message => '...', -verbose => 1)");
|
---|
62 | #You naughty person, what did you say?
|
---|
63 | # Usage:
|
---|
64 | # frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
|
---|
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 | #
|
---|
76 | EOT
|
---|
77 |
|
---|
78 | ($exit, $text) = getoutput( sub { pod2usage(
|
---|
79 | -verbose => 2, -exit => 42 ) } );
|
---|
80 | is ($exit, 42, "Exit status pod2usage (-verbose => 2, -exit => 42)");
|
---|
81 | ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 2, -exit => 42)");
|
---|
82 | #NAME
|
---|
83 | # frobnicate - do what I mean
|
---|
84 | #
|
---|
85 | # SYNOPSIS
|
---|
86 | # frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
|
---|
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 | #
|
---|
101 | EOT
|
---|
102 |
|
---|
103 | ($exit, $text) = getoutput( sub { pod2usage(0) } );
|
---|
104 | is ($exit, 0, "Exit status pod2usage (0)");
|
---|
105 | ok (compare ($text, <<'EOT'), "Output test pod2usage (0)");
|
---|
106 | #Usage:
|
---|
107 | # frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
|
---|
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 | #
|
---|
119 | EOT
|
---|
120 |
|
---|
121 | ($exit, $text) = getoutput( sub { pod2usage(42) } );
|
---|
122 | is ($exit, 42, "Exit status pod2usage (42)");
|
---|
123 | ok (compare ($text, <<'EOT'), "Output test pod2usage (42)");
|
---|
124 | #Usage:
|
---|
125 | # frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
|
---|
126 | #
|
---|
127 | EOT
|
---|
128 |
|
---|
129 | ($exit, $text) = getoutput( sub { pod2usage(-verbose => 0, -exit => 'NOEXIT') } );
|
---|
130 | is ($exit, 0, "Exit status pod2usage (-verbose => 0, -exit => 'NOEXIT')");
|
---|
131 | ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 0, -exit => 'NOEXIT')");
|
---|
132 | #Usage:
|
---|
133 | # frobnicate [ -r | --recursive ] [ -f | --force ] [ -n number ] file ...
|
---|
134 | #
|
---|
135 | # --NORMAL-RETURN--
|
---|
136 | EOT
|
---|
137 |
|
---|
138 | ($exit, $text) = getoutput( sub { pod2usage(-verbose => 99, -sections => 'DESCRIPTION') } );
|
---|
139 | is ($exit, 1, "Exit status pod2usage (-verbose => 99, -sections => 'DESCRIPTION')");
|
---|
140 | ok (compare ($text, <<'EOT'), "Output test pod2usage (-verbose => 99, -sections => 'DESCRIPTION')");
|
---|
141 | #Description:
|
---|
142 | # frobnicate does foo and bar and what not.
|
---|
143 | #
|
---|
144 | EOT
|
---|
145 |
|
---|
146 |
|
---|
147 |
|
---|
148 | __END__
|
---|
149 |
|
---|
150 | =head1 NAME
|
---|
151 |
|
---|
152 | frobnicate - do what I mean
|
---|
153 |
|
---|
154 | =head1 SYNOPSIS
|
---|
155 |
|
---|
156 | B<frobnicate> S<[ B<-r> | B<--recursive> ]> S<[ B<-f> | B<--force> ]>
|
---|
157 | S<[ B<-n> I<number> ]> I<file> ...
|
---|
158 |
|
---|
159 | =head1 DESCRIPTION
|
---|
160 |
|
---|
161 | B<frobnicate> does foo and bar and what not.
|
---|
162 |
|
---|
163 | =head1 OPTIONS
|
---|
164 |
|
---|
165 | =over 4
|
---|
166 |
|
---|
167 | =item B<-r> | B<--recursive>
|
---|
168 |
|
---|
169 | Run recursively.
|
---|
170 |
|
---|
171 | =item B<-f> | B<--force>
|
---|
172 |
|
---|
173 | Just do it!
|
---|
174 |
|
---|
175 | =item B<-n> I<number>
|
---|
176 |
|
---|
177 | Specify number of frobs, default is 42.
|
---|
178 |
|
---|
179 | =back
|
---|
180 |
|
---|
181 | =cut
|
---|
182 |
|
---|