ext/IO-Compress/t/cz-08encoding.t

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = ("../lib", "lib/compress");
   5     }
   6 }
   7
   8 use lib qw(t t/compress);
   9 use strict;
  10 use warnings;
  11 use bytes;
  12
  13 use Test::More ;
  14 use CompTestUtils;
  15
  16 BEGIN
  17 {
  18     plan skip_all => "Encode is not available"
  19         if $] < 5.006 ;
  20
  21     eval { require Encode; Encode->import(); };
  22
  23     plan skip_all => "Encode is not available"
  24         if $@ ;
  25
  26     # use Test::NoWarnings, if available
  27     my $extra = 0 ;
  28     $extra = 1
  29         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  30
  31     plan tests => 29 + $extra ;
  32
  33     use_ok('Compress::Zlib', 2);
  34 }
  35
  36
  37
  38
  39 # Check zlib_version and ZLIB_VERSION are the same.
  40 is Compress::Zlib::zlib_version, ZLIB_VERSION,
  41     "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
  42
  43
  44 {
  45     title "memGzip" ;
  46     # length of this string is 2 characters
  47     my $s = "\x{df}\x{100}";
  48
  49     my $cs = Compress::Zlib::memGzip(Encode::encode_utf8($s));
  50
  51     # length stored at end of gzip file should be 4
  52     my ($crc, $len) = unpack ("VV", substr($cs, -8, 8));
  53
  54     is $len, 4, "  length is 4";
  55 }
  56
  57 {
  58     title "memGunzip when compressed gzip has been encoded" ;
  59     my $s = "hello world" ;
  60
  61     my $co = Compress::Zlib::memGzip($s);
  62     is Compress::Zlib::memGunzip(my $x = $co), $s, "  match uncompressed";
  63
  64     utf8::upgrade($co);
  65
  66     my $un = Compress::Zlib::memGunzip($co);
  67     ok $un, "  got uncompressed";
  68
  69     is $un, $s, "  uncompressed matched original";
  70 }
  71
  72 {
  73     title "compress/uncompress";
  74
  75     my $s = "\x{df}\x{100}";
  76     my $s_copy = $s ;
  77
  78     my $ces = compress(Encode::encode_utf8($s_copy));
  79
  80     ok $ces, "  compressed ok" ;
  81
  82     my $un = Encode::decode_utf8(uncompress($ces));
  83     is $un, $s, "  decode_utf8 ok";
  84
  85     utf8::upgrade($ces);
  86     $un = Encode::decode_utf8(uncompress($ces));
  87     is $un, $s, "  decode_utf8 ok";
  88
  89 }
  90
  91 {
  92     title "gzopen" ;
  93
  94     my $s = "\x{df}\x{100}";
  95     my $byte_len = length( Encode::encode_utf8($s) );
  96     my ($uncomp) ;
  97
  98     my $lex = new LexFile my $name ;
  99     ok my $fil = gzopen($name, "wb"), "  gzopen for write ok" ;
 100
 101     is $fil->gzwrite(Encode::encode_utf8($s)), $byte_len, "  wrote $byte_len bytes" ;
 102
 103     ok ! $fil->gzclose, "  gzclose ok" ;
 104
 105     ok $fil = gzopen($name, "rb"), "  gzopen for read ok" ;
 106
 107     is $fil->gzread($uncomp), $byte_len, "  read $byte_len bytes" ;
 108     is length($uncomp), $byte_len, "  uncompress is $byte_len bytes";
 109
 110     ok ! $fil->gzclose, "gzclose ok" ;
 111
 112     is $s, Encode::decode_utf8($uncomp), "  decode_utf8 ok" ;
 113 }
 114
 115 {
 116     title "Catch wide characters";
 117
 118     my $a = "a\xFF\x{100}";
 119     eval { Compress::Zlib::memGzip($a) };
 120     like($@, qr/Wide character in memGzip/, "  wide characters in memGzip");
 121
 122     eval { Compress::Zlib::memGunzip($a) };
 123     like($@, qr/Wide character in memGunzip/, "  wide characters in memGunzip");
 124
 125     eval { Compress::Zlib::compress($a) };
 126     like($@, qr/Wide character in compress/, "  wide characters in compress");
 127
 128     eval { Compress::Zlib::uncompress($a) };
 129     like($@, qr/Wide character in uncompress/, "  wide characters in uncompress");
 130
 131     my $lex = new LexFile my $name ;
 132     ok my $fil = gzopen($name, "wb"), "  gzopen for write ok" ;
 133
 134     eval { $fil->gzwrite($a); } ;
 135     like($@, qr/Wide character in gzwrite/, "  wide characters in gzwrite");
 136
 137     ok ! $fil->gzclose, "  gzclose ok" ;
 138 }
 139