1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
use 5.008; # for utf8
use strict;
use warnings;
use utf8;
use Test::More;
use File::Temp;
use Pod::Spell;
use Pod::Wordlist;
my $builder = Test::More->builder;
binmode $builder->output, ":utf8";
binmode $builder->failure_output, ":utf8";
binmode $builder->todo_output, ":utf8";
binmode STDOUT, ":utf8";
my $podfile = File::Temp->new;
binmode($podfile, ":utf8");
print $podfile <<'ENDPOD';
=encoding utf8
=for :stopwords
virtE<ugrave> résumé
=head1 Testing virtE<ugrave> & résumé
Our virtE<ugrave> & virtù & résumé for Mengué in 日本
=cut
ENDPOD
my @cases = (
{
label => "wide chars allowed",
options => {},
expected => [ qw( Testing Our for Mengué in 日本 ) ],
},
{
label => "wide chars stripped",
options => { no_wide_chars => 1 },
expected => [ qw( Testing Our for Mengué in ) ],
},
);
for my $c ( @cases ) {
my $check = sub {
my ($name, $content) = @_;
my @words = split " ", $content;
my @expected = @{ $c->{expected} };
is scalar @words, scalar @expected, "$c->{label}: word count";
is_deeply [ sort @words ], [ sort @expected ], "$name - $c->{label}: words match"
or diag "@words";
};
my $parse = sub {
my $p = Pod::Spell->new( %{ $c->{options} });
$podfile->seek( 0, 0 );
$p->parse_from_filehandle( $podfile, @_ );
};
{
my $textfile = File::Temp->new( 'pod-spell-XXXXX', TMPDIR => 1, UNLINK => 1 );
$parse->($textfile);
$textfile->seek( 0, 0 );
my $content = do { local $/; <$textfile> };
$check->('temp file', Encode::decode_utf8($content));
}
{
my $textfile = File::Temp->new( 'pod-spell-XXXXX', TMPDIR => 1, UNLINK => 1 );
binmode $textfile, ':utf8';
$parse->($textfile);
$textfile->seek( 0, 0 );
my $content = do { local $/; <$textfile> };
$check->('temp file (utf8)', $content);
}
{
my $content = '';
open my $fh, '>', \$content;
$parse->($fh);
$check->('in memory', Encode::decode_utf8($content));
}
{
my $content = '';
open my $fh, '>:utf8', \$content;
$parse->($fh);
$check->('in memory (utf8)', Encode::decode_utf8($content));
}
{
open(my $oldout, '>&', \*STDOUT)
or die "Can't dup STDOUT: $!";
my ($fh, $file) = File::Temp::tempfile( 'pod-spell-XXXXX', TMPDIR => 1, UNLINK => 1 );
open(STDOUT, '>', $file)
or die "Can't redirect STDOUT: $!";
$parse->();
open(STDOUT, '>&', $oldout)
or die "Can't dup \$oldout: $!";
seek $fh, 0, 0;
my $content = do { local $/; <$fh> };
$check->('STDOUT', Encode::decode_utf8($content));
}
{
open(my $oldout, '>&', \*STDOUT)
or die "Can't dup STDOUT: $!";
my ($fh, $file) = File::Temp::tempfile( 'pod-spell-XXXXX', TMPDIR => 1, UNLINK => 1 );
open(STDOUT, '>:utf8', $file)
or die "Can't redirect STDOUT: $!";
$parse->();
close STDOUT;
open(STDOUT, '>&', $oldout)
or die "Can't dup \$oldout: $!";
seek $fh, 0, 0;
my $content = do { local $/; <$fh> };
$check->('STDOUT (utf8)', Encode::decode_utf8($content));
}
}
done_testing;
|
