Commit | Line | Data |
93d092e2 |
1 | |
2 | use strict; |
3 | use warnings; |
4 | use bytes; |
5 | |
6 | use Test::More ; |
7 | use CompTestUtils; |
8 | |
9 | BEGIN |
10 | { |
11 | plan skip_all => "Encode is not available" |
12 | if $] < 5.006 ; |
13 | |
14 | eval { require Encode; Encode->import(); }; |
15 | |
16 | plan skip_all => "Encode is not available" |
17 | if $@ ; |
18 | |
19 | # use Test::NoWarnings, if available |
20 | my $extra = 0 ; |
21 | |
22 | my $st = eval { require Test::NoWarnings ; import Test::NoWarnings; 1; }; |
23 | $extra = 1 |
24 | if $st ; |
25 | |
26 | plan(tests => 7 + $extra) ; |
27 | } |
28 | |
29 | sub run |
30 | { |
31 | my $CompressClass = identify(); |
32 | my $UncompressClass = getInverse($CompressClass); |
33 | my $Error = getErrorRef($CompressClass); |
34 | my $UnError = getErrorRef($UncompressClass); |
35 | |
36 | |
37 | my $string = "\x{df}\x{100}"; |
38 | my $encString = Encode::encode_utf8($string); |
39 | my $buffer = $encString; |
40 | |
41 | #for my $from ( qw(filename filehandle buffer) ) |
42 | { |
43 | # my $input ; |
44 | # my $lex = new LexFile my $name ; |
45 | # |
46 | # |
47 | # if ($from eq 'buffer') |
48 | # { $input = \$buffer } |
49 | # elsif ($from eq 'filename') |
50 | # { |
51 | # $input = $name ; |
52 | # writeFile($name, $buffer); |
53 | # } |
54 | # elsif ($from eq 'filehandle') |
55 | # { |
56 | # $input = new IO::File "<$name" ; |
57 | # } |
58 | |
59 | for my $to ( qw(filehandle buffer)) |
60 | { |
61 | title "OO Mode: To $to, Encode by hand"; |
62 | |
63 | my $lex2 = new LexFile my $name2 ; |
64 | my $output; |
65 | my $buffer; |
66 | |
67 | if ($to eq 'buffer') |
68 | { $output = \$buffer } |
69 | elsif ($to eq 'filename') |
70 | { |
71 | $output = $name2 ; |
72 | } |
73 | elsif ($to eq 'filehandle') |
74 | { |
75 | $output = new IO::File ">$name2" ; |
76 | } |
77 | |
78 | |
79 | my $out ; |
80 | my $cs = new $CompressClass($output, AutoClose =>1); |
81 | $cs->print($encString); |
82 | $cs->close(); |
83 | |
84 | my $input; |
85 | if ($to eq 'buffer') |
86 | { $input = \$buffer } |
87 | else |
88 | { |
89 | $input = $name2 ; |
90 | } |
91 | |
92 | my $ucs = new $UncompressClass($input, Append => 1); |
93 | my $got; |
94 | 1 while $ucs->read($got) > 0 ; |
95 | my $decode = Encode::decode_utf8($got); |
96 | |
97 | |
98 | is $string, $decode, " Expected output"; |
99 | |
100 | |
101 | } |
102 | } |
103 | |
104 | { |
105 | title "Catch wide characters"; |
106 | |
107 | my $out; |
108 | my $cs = new $CompressClass(\$out); |
109 | my $a = "a\xFF\x{100}"; |
110 | eval { $cs->syswrite($a) }; |
111 | like($@, qr/Wide character in ${CompressClass}::write/, |
112 | " wide characters in ${CompressClass}::write"); |
113 | eval { syswrite($cs, $a) }; |
114 | like($@, qr/Wide character in ${CompressClass}::write/, |
115 | " wide characters in ${CompressClass}::write"); |
116 | } |
117 | |
118 | } |
119 | |
120 | |
121 | |
122 | 1; |
123 | |