Commit | Line | Data |
---|---|---|
7b47f8ec RGS |
1 | #!/usr/bin/perl -w |
2 | ||
12f8b801 | 3 | use Test::More; |
7b47f8ec RGS |
4 | |
5 | BEGIN { | |
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 |
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; | |
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 | ||
39 | sub 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 | 49 | my ($exit, $text) = getoutput( sub { pod2usage() } ); |
12f8b801 MB |
50 | is ($exit, 2, "Exit status pod2usage ()"); |
51 | ok (compare ($text, <<'EOT'), "Output test pod2usage ()"); | |
52 | #Usage: | |
ce6e48f3 | 53 | # frobnicate [ -r | --recursive ] [ -f | --force ] file ... |
12f8b801 | 54 | # |
7b47f8ec RGS |
55 | EOT |
56 | ||
7b47f8ec RGS |
57 | ($exit, $text) = getoutput( sub { pod2usage( |
58 | -message => 'You naughty person, what did you say?', | |
12f8b801 MB |
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: | |
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 |
76 | EOT |
77 | ||
7b47f8ec RGS |
78 | ($exit, $text) = getoutput( sub { pod2usage( |
79 | -verbose => 2, -exit => 42 ) } ); | |
12f8b801 MB |
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 | |
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 |
101 | EOT |
102 | ||
7b47f8ec | 103 | ($exit, $text) = getoutput( sub { pod2usage(0) } ); |
12f8b801 MB |
104 | is ($exit, 0, "Exit status pod2usage (0)"); |
105 | ok (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 |
119 | EOT |
120 | ||
7b47f8ec | 121 | ($exit, $text) = getoutput( sub { pod2usage(42) } ); |
12f8b801 MB |
122 | is ($exit, 42, "Exit status pod2usage (42)"); |
123 | ok (compare ($text, <<'EOT'), "Output test pod2usage (42)"); | |
124 | #Usage: | |
ce6e48f3 | 125 | # frobnicate [ -r | --recursive ] [ -f | --force ] file ... |
12f8b801 | 126 | # |
7b47f8ec RGS |
127 | EOT |
128 | ||
7b47f8ec | 129 | ($exit, $text) = getoutput( sub { pod2usage(-verbose => 0, -exit => 'NOEXIT') } ); |
12f8b801 MB |
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: | |
ce6e48f3 | 133 | # frobnicate [ -r | --recursive ] [ -f | --force ] file ... |
12f8b801 MB |
134 | # |
135 | # --NORMAL-RETURN-- | |
7b47f8ec RGS |
136 | EOT |
137 | ||
7b47f8ec | 138 | ($exit, $text) = getoutput( sub { pod2usage(-verbose => 99, -sections => 'DESCRIPTION') } ); |
12f8b801 MB |
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 | # | |
7b47f8ec RGS |
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> ]> | |
ce6e48f3 | 157 | file ... |
7b47f8ec RGS |
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 | ||
ce6e48f3 | 175 | =item B<-n> number |
7b47f8ec RGS |
176 | |
177 | Specify number of frobs, default is 42. | |
178 | ||
179 | =back | |
180 | ||
181 | =cut | |
182 |