e6aad3aeeb289d7f42247f8b28fab4a4b18c05d6
[perl.git] / cpan / podlators / t / man-perlio.t
1 #!/usr/bin/perl -w
2 #
3 # man-perlio.t -- Test Pod::Man with a PerlIO UTF-8 encoding layer.
4 #
5 # Copyright 2002, 2004, 2006, 2008, 2009, 2010, 2012
6 #     Russ Allbery <rra@stanford.edu>
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 BEGIN {
12     chdir 't' if -d 't';
13     if ($ENV{PERL_CORE}) {
14         @INC = '../lib';
15     }
16     unshift (@INC, '../blib/lib');
17     $| = 1;
18 }
19
20 use strict;
21
22 use Test::More;
23
24 # UTF-8 support requires Perl 5.8 or later.
25 BEGIN {
26     if ($] < 5.008) {
27         plan skip_all => 'Perl 5.8 required for UTF-8 support';
28     } else {
29         plan tests => 7;
30     }
31 }
32 BEGIN { use_ok ('Pod::Man') }
33
34 # Force UTF-8 on all relevant file handles.  Do this inside eval in case the
35 # encoding parameter doesn't work.
36 eval { binmode (\*DATA, ':encoding(utf-8)') };
37 eval { binmode (\*STDOUT, ':encoding(utf-8)') };
38 my $builder = Test::More->builder;
39 eval { binmode ($builder->output, ':encoding(utf-8)') };
40 eval { binmode ($builder->failure_output, ':encoding(utf-8)') };
41
42 my $n = 1;
43 while (<DATA>) {
44     my %options;
45     next until $_ eq "###\n";
46     while (<DATA>) {
47         last if $_ eq "###\n";
48         my ($option, $value) = split;
49         $options{$option} = $value;
50     }
51     open (TMP, "> tmp$$.pod") or die "Cannot create tmp$$.pod: $!\n";
52     eval { binmode (\*TMP, ':encoding(utf-8)') };
53     print TMP "=encoding utf-8\n\n";
54     while (<DATA>) {
55         last if $_ eq "###\n";
56         print TMP $_;
57     }
58     close TMP;
59     my $parser = Pod::Man->new (%options);
60     isa_ok ($parser, 'Pod::Man', 'Parser object');
61     open (OUT, "> out$$.tmp") or die "Cannot create out$$.tmp: $!\n";
62     eval { binmode (\*OUT, ':encoding(utf-8)') };
63     $parser->parse_from_file ("tmp$$.pod", \*OUT);
64     close OUT;
65     my $accents = 0;
66     open (TMP, "out$$.tmp") or die "Cannot open out$$.tmp: $!\n";
67     eval { binmode (\*TMP, ':encoding(utf-8)') };
68     while (<TMP>) {
69         $accents = 1 if /Accent mark definitions/;
70         last if /^\.nh/;
71     }
72     my $output;
73     {
74         local $/;
75         $output = <TMP>;
76     }
77     close TMP;
78     1 while unlink ("tmp$$.pod", "out$$.tmp");
79     if ($options{utf8}) {
80         ok (!$accents, "Saw no accent definitions for test $n");
81     } else {
82         ok ($accents, "Saw accent definitions for test $n");
83     }
84     my $expected = '';
85     while (<DATA>) {
86         last if $_ eq "###\n";
87         $expected .= $_;
88     }
89     is ($output, $expected, "Output correct for test $n");
90     $n++;
91 }
92
93 # Below the marker are bits of POD and corresponding expected text output.
94 # This is used to test specific features or problems with Pod::Man.  The
95 # input and output are separated by lines containing only ###.
96
97 __DATA__
98
99 ###
100 utf8 1
101 ###
102 =head1 BEYONCÉ
103
104 Beyoncé!  Beyoncé!  Beyoncé!!
105
106     Beyoncé!  Beyoncé!
107       Beyoncé!  Beyoncé!
108         Beyoncé!  Beyoncé!
109
110 Older versions did not convert Beyoncé in verbatim.
111 ###
112 .SH "BEYONCÉ"
113 .IX Header "BEYONCÉ"
114 Beyoncé!  Beyoncé!  Beyoncé!!
115 .PP
116 .Vb 3
117 \&    Beyoncé!  Beyoncé!
118 \&      Beyoncé!  Beyoncé!
119 \&        Beyoncé!  Beyoncé!
120 .Ve
121 .PP
122 Older versions did not convert Beyoncé in verbatim.
123 ###
124
125 ###
126 utf8 1
127 ###
128 =head1 SE<lt>E<gt> output with UTF-8
129
130 This is S<non-breaking output>.
131 ###
132 .SH "S<> output with UTF\-8"
133 .IX Header "S<> output with UTF-8"
134 This is non-breaking output.
135 ###