Move IO::Compress from ext/ to cpan/
[p5sagit/p5-mst-13.2.git] / cpan / IO-Compress / t / compress / encode.pl
CommitLineData
93d092e2 1
2use strict;
3use warnings;
4use bytes;
5
6use Test::More ;
7use CompTestUtils;
8
9BEGIN
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
29sub 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
1221;
123