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 124