Commit | Line | Data |
2504ae52 |
1 | #!/usr/bin/perl -w |
2 | # |
3 | # man-options.t -- Additional tests for Pod::Man options. |
4 | # |
5 | # Copyright 2002, 2004, 2006, 2008 Russ Allbery <rra@stanford.edu> |
6 | # |
7 | # This program is free software; you may redistribute it and/or modify it |
8 | # under the same terms as Perl itself. |
9 | |
10 | BEGIN { |
11 | chdir 't' if -d 't'; |
12 | if ($ENV{PERL_CORE}) { |
13 | @INC = '../lib'; |
14 | } else { |
15 | unshift (@INC, '../blib/lib'); |
16 | } |
17 | unshift (@INC, '../blib/lib'); |
18 | $| = 1; |
19 | print "1..5\n"; |
20 | |
21 | # UTF-8 support requires Perl 5.8 or later. |
22 | if ($] < 5.008) { |
23 | my $n; |
24 | for $n (1..5) { |
25 | print "ok $n # skip -- Perl 5.8 required for UTF-8 support\n"; |
26 | } |
27 | exit; |
28 | } |
29 | } |
30 | |
31 | END { |
32 | print "not ok 1\n" unless $loaded; |
33 | } |
34 | |
35 | use Pod::Man; |
36 | |
37 | $loaded = 1; |
38 | print "ok 1\n"; |
39 | |
40 | my $n = 2; |
41 | eval { binmode (\*DATA, ':encoding(utf-8)') }; |
42 | while (<DATA>) { |
43 | my %options; |
44 | next until $_ eq "###\n"; |
45 | while (<DATA>) { |
46 | last if $_ eq "###\n"; |
47 | my ($option, $value) = split; |
48 | $options{$option} = $value; |
49 | } |
50 | open (TMP, '> tmp.pod') or die "Cannot create tmp.pod: $!\n"; |
51 | eval { binmode (\*TMP, ':encoding(utf-8)') }; |
52 | print TMP "=encoding utf-8\n\n"; |
53 | while (<DATA>) { |
54 | last if $_ eq "###\n"; |
55 | print TMP $_; |
56 | } |
57 | close TMP; |
58 | my $parser = Pod::Man->new (%options) or die "Cannot create parser\n"; |
59 | open (OUT, '> out.tmp') or die "Cannot create out.tmp: $!\n"; |
60 | eval { binmode (\*OUT, ':encoding(utf-8)') }; |
61 | $parser->parse_from_file ('tmp.pod', \*OUT); |
62 | close OUT; |
63 | my $accents = 0; |
64 | open (TMP, 'out.tmp') or die "Cannot open out.tmp: $!\n"; |
65 | eval { binmode (\*TMP, ':encoding(utf-8)') }; |
66 | while (<TMP>) { |
67 | $accents = 1 if /Accent mark definitions/; |
68 | last if /^\.nh/; |
69 | } |
70 | my $output; |
71 | { |
72 | local $/; |
73 | $output = <TMP>; |
74 | } |
75 | close TMP; |
76 | unlink ('tmp.pod', 'out.tmp'); |
77 | if (($options{utf8} && !$accents) || (!$options{utf8} && $accents)) { |
78 | print "ok $n\n"; |
79 | } else { |
80 | print "not ok $n\n"; |
81 | print ($accents ? "Saw accents\n" : "Saw no accents\n"); |
82 | print ($options{utf8} ? "Wanted no accents\n" : "Wanted accents\n"); |
83 | } |
84 | $n++; |
85 | my $expected = ''; |
86 | while (<DATA>) { |
87 | last if $_ eq "###\n"; |
88 | $expected .= $_; |
89 | } |
90 | if ($output eq $expected) { |
91 | print "ok $n\n"; |
92 | } else { |
93 | print "not ok $n\n"; |
94 | print "Expected\n========\n$expected\nOutput\n======\n$output\n"; |
95 | } |
96 | $n++; |
97 | } |
98 | |
99 | # Below the marker are bits of POD and corresponding expected text output. |
100 | # This is used to test specific features or problems with Pod::Man. The |
101 | # input and output are separated by lines containing only ###. |
102 | |
103 | __DATA__ |
104 | |
105 | ### |
106 | utf8 1 |
107 | ### |
108 | =head1 BEYONCÉ |
109 | |
110 | Beyoncé! Beyoncé! Beyoncé!! |
111 | |
112 | Beyoncé! Beyoncé! |
113 | Beyoncé! Beyoncé! |
114 | Beyoncé! Beyoncé! |
115 | |
116 | Older versions did not convert Beyoncé in verbatim. |
117 | ### |
118 | .SH "BEYONCÉ" |
119 | .IX Header "BEYONCÉ" |
120 | Beyoncé! Beyoncé! Beyoncé!! |
121 | .PP |
122 | .Vb 3 |
123 | \& Beyoncé! Beyoncé! |
124 | \& Beyoncé! Beyoncé! |
125 | \& Beyoncé! Beyoncé! |
126 | .Ve |
127 | .PP |
128 | Older versions did not convert Beyoncé in verbatim. |
129 | ### |
130 | |
131 | ### |
132 | utf8 1 |
133 | ### |
134 | =head1 SE<lt>E<gt> output with UTF-8 |
135 | |
136 | This is S<non-breaking output>. |
137 | ### |
138 | .SH "S<> output with UTF\-8" |
139 | .IX Header "S<> output with UTF-8" |
140 | This is non-breaking output. |
141 | ### |