t/lib/compress/encode.pl

   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