Update podlators to version 4.03
[perl.git] / cpan / podlators / t / man / options.t
1 #!/usr/bin/perl -w
2 #
3 # Additional tests for Pod::Man options.
4 #
5 # Copyright 2002, 2004, 2006, 2008, 2009, 2012, 2013, 2015
6 #     Russ Allbery <rra@cpan.org>
7 #
8 # This program is free software; you may redistribute it and/or modify it
9 # under the same terms as Perl itself.
10
11 use 5.006;
12 use strict;
13 use warnings;
14
15 use lib 't/lib';
16
17 use Test::More tests => 31;
18 use Test::Podlators qw(read_test_data slurp);
19
20 BEGIN {
21     use_ok ('Pod::Man');
22 }
23
24 # Redirect stderr to a file.  Return the name of the file that stores standard
25 # error.
26 sub stderr_save {
27     open(OLDERR, '>&STDERR') or die "Can't dup STDERR: $!\n";
28     open(STDERR, "> out$$.err") or die "Can't redirect STDERR: $!\n";
29     return "out$$.err";
30 }
31
32 # Restore stderr.
33 sub stderr_restore {
34     close(STDERR);
35     open(STDERR, '>&OLDERR') or die "Can't dup STDERR: $!\n";
36     close(OLDERR);
37 }
38
39 # Loop through all the test data, generate output, and compare it to the
40 # desired output data.
41 my %options = (options => 1, errors => 1);
42 my $n = 1;
43 while (defined(my $data_ref = read_test_data(\*DATA, \%options))) {
44     my $parser = Pod::Man->new(%{ $data_ref->{options} }, name => 'TEST');
45     isa_ok($parser, 'Pod::Man', 'Parser object');
46
47     # Save stderr to a temporary file and then run the parser, storing the
48     # output into a Perl variable.
49     my $errors = stderr_save();
50     my $got;
51     $parser->output_string(\$got);
52     eval { $parser->parse_string_document($data_ref->{input}) };
53     my $exception = $@;
54     stderr_restore();
55
56     # Strip off everything prior to .nh from the output so that we aren't
57     # testing the generated header, and then check the output.
58     $got =~ s{ \A .* \n [.]nh \n }{}xms;
59     is($got, $data_ref->{output}, "Output for test $n");
60
61     # Collect the errors and add any exception, marking it with EXCEPTION.
62     # Then, compare that to the expected errors.  The "1 while" construct is
63     # for VMS, in case there are multiple versions of the file.
64     my $got_errors = slurp($errors);
65     1 while unlink($errors);
66     if ($exception) {
67         $exception =~ s{ [ ] at [ ] .* }{}xms;
68         $got_errors .= "EXCEPTION: $exception\n";
69     }
70     is($got_errors, $data_ref->{errors}, "Errors for test $n");
71     $n++;
72 }
73
74 # Below the marker are bits of POD and corresponding expected text output and
75 # error output.  The options, input, output, and errors are separated by lines
76 # containing only ###.
77
78 __DATA__
79
80 ###
81 fixed CR
82 fixedbold CY
83 fixeditalic CW
84 fixedbolditalic CX
85 ###
86 =head1 FIXED FONTS
87
88 C<foo B<bar I<baz>> I<bay>>
89 ###
90 .SH "FIXED FONTS"
91 .IX Header "FIXED FONTS"
92 \&\f(CR\*(C`foo \f(CYbar \f(CXbaz\f(CY\f(CR \f(CWbay\f(CR\*(C'\fR
93 ###
94 ###
95
96 ###
97 ###
98 =over 4
99
100 =item Foo
101
102 Bar.
103
104 =head1 NEXT
105 ###
106 .IP "Foo" 4
107 .IX Item "Foo"
108 Bar.
109 .SH "NEXT"
110 .IX Header "NEXT"
111 .SH "POD ERRORS"
112 .IX Header "POD ERRORS"
113 Hey! \fBThe above document had some coding errors, which are explained below:\fR
114 .IP "Around line 7:" 4
115 .IX Item "Around line 7:"
116 You forgot a '=back' before '=head1'
117 ###
118 ###
119
120 ###
121 stderr 1
122 ###
123 =over 4
124
125 =item Foo
126
127 Bar.
128
129 =head1 NEXT
130 ###
131 .IP "Foo" 4
132 .IX Item "Foo"
133 Bar.
134 .SH "NEXT"
135 .IX Header "NEXT"
136 ###
137 Pod input around line 7: You forgot a '=back' before '=head1'
138 ###
139
140 ###
141 nourls 1
142 ###
143 =head1 URL suppression
144
145 L<anchor|http://www.example.com/>
146 ###
147 .SH "URL suppression"
148 .IX Header "URL suppression"
149 anchor
150 ###
151 ###
152
153 ###
154 errors stderr
155 ###
156 =over 4
157
158 =item Foo
159
160 Bar.
161
162 =head1 NEXT
163 ###
164 .IP "Foo" 4
165 .IX Item "Foo"
166 Bar.
167 .SH "NEXT"
168 .IX Header "NEXT"
169 ###
170 Pod input around line 7: You forgot a '=back' before '=head1'
171 ###
172
173 ###
174 errors die
175 ###
176 =over 4
177
178 =item Foo
179
180 Bar.
181
182 =head1 NEXT
183 ###
184 .IP "Foo" 4
185 .IX Item "Foo"
186 Bar.
187 .SH "NEXT"
188 .IX Header "NEXT"
189 ###
190 Pod input around line 7: You forgot a '=back' before '=head1'
191 EXCEPTION: POD document had syntax errors
192 ###
193
194 ###
195 errors pod
196 ###
197 =over 4
198
199 =item Foo
200
201 Bar.
202
203 =head1 NEXT
204 ###
205 .IP "Foo" 4
206 .IX Item "Foo"
207 Bar.
208 .SH "NEXT"
209 .IX Header "NEXT"
210 .SH "POD ERRORS"
211 .IX Header "POD ERRORS"
212 Hey! \fBThe above document had some coding errors, which are explained below:\fR
213 .IP "Around line 7:" 4
214 .IX Item "Around line 7:"
215 You forgot a '=back' before '=head1'
216 ###
217 ###
218
219 ###
220 errors none
221 ###
222 =over 4
223
224 =item Foo
225
226 Bar.
227
228 =head1 NEXT
229 ###
230 .IP "Foo" 4
231 .IX Item "Foo"
232 Bar.
233 .SH "NEXT"
234 .IX Header "NEXT"
235 ###
236 ###
237
238 ###
239 errors none
240 ###
241 =over 4
242
243 =item foo
244
245 Not a bullet.
246
247 =item *
248
249 Also not a bullet.
250
251 =back
252 ###
253 .IP "foo" 4
254 .IX Item "foo"
255 Not a bullet.
256 .IP "*" 4
257 Also not a bullet.
258 ###
259 ###
260
261 ###
262 quotes \(lq"\(rq"
263 ###
264 =head1 FOO C<BAR> BAZ
265
266 Foo C<bar> baz.
267 ###
268 .ie n .SH "FOO \(lq""BAR\(rq"" BAZ"
269 .el .SH "FOO \f(CWBAR\fP BAZ"
270 .IX Header "FOO BAR BAZ"
271 Foo \f(CW\*(C`bar\*(C'\fR baz.
272 ###
273 ###