perl-5.16.2/cpan/IO-Compress/t/cz-08encoding.t

BEGIN {
    if ($ENV{PERL_CORE}) {
	chdir 't' if -d 't';
	@INC = ("../lib", "lib/compress");
    }
}

use lib qw(t t/compress);
use strict;
use warnings;
use bytes;

use Test::More ;
use CompTestUtils;

BEGIN
{
    plan skip_all => "Encode is not available"
        if $] < 5.006 ;

    eval { require Encode; Encode->import(); };

    plan skip_all => "Encode is not available"
        if $@ ;

    # use Test::NoWarnings, if available
    my $extra = 0 ;
    $extra = 1
        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };

    plan tests => 29 + $extra ;

    use_ok('Compress::Zlib', qw(:ALL zlib_version memGunzip memGzip));
}




# Check zlib_version and ZLIB_VERSION are the same.
SKIP: {
    skip "TEST_SKIP_VERSION_CHECK is set", 1 
        if $ENV{TEST_SKIP_VERSION_CHECK};
    is Compress::Zlib::zlib_version, ZLIB_VERSION,
        "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
}

{
    title "memGzip" ;
    # length of this string is 2 characters
    my $s = "\x{df}\x{100}"; 

    my $cs = memGzip(Encode::encode_utf8($s));

    # length stored at end of gzip file should be 4
    my ($crc, $len) = unpack ("VV", substr($cs, -8, 8));
    
    is $len, 4, "  length is 4";
}

{
    title "memGunzip when compressed gzip has been encoded" ;
    my $s = "hello world" ;

    my $co = memGzip($s);
    is memGunzip(my $x = $co), $s, "  match uncompressed";

    utf8::upgrade($co);
     
    my $un = memGunzip($co);
    ok $un, "  got uncompressed";

    is $un, $s, "  uncompressed matched original";
}

{
    title "compress/uncompress";

    my $s = "\x{df}\x{100}";                                   
    my $s_copy = $s ;

    my $ces = compress(Encode::encode_utf8($s_copy));

    ok $ces, "  compressed ok" ;

    my $un = Encode::decode_utf8(uncompress($ces));
    is $un, $s, "  decode_utf8 ok";
 
    utf8::upgrade($ces);
    $un = Encode::decode_utf8(uncompress($ces));
    is $un, $s, "  decode_utf8 ok";
 
}

{
    title "gzopen" ;

    my $s = "\x{df}\x{100}";                                   
    my $byte_len = length( Encode::encode_utf8($s) );
    my ($uncomp) ;

    my $lex = new LexFile my $name ;
    ok my $fil = gzopen($name, "wb"), "  gzopen for write ok" ;

    is $fil->gzwrite(Encode::encode_utf8($s)), $byte_len, "  wrote $byte_len bytes" ;

    ok ! $fil->gzclose, "  gzclose ok" ;

    ok $fil = gzopen($name, "rb"), "  gzopen for read ok" ;

    is $fil->gzread($uncomp), $byte_len, "  read $byte_len bytes" ;
    is length($uncomp), $byte_len, "  uncompress is $byte_len bytes";

    ok ! $fil->gzclose, "gzclose ok" ;

    is $s, Encode::decode_utf8($uncomp), "  decode_utf8 ok" ;
}

{
    title "Catch wide characters";

    my $a = "a\xFF\x{100}";
    eval { memGzip($a) };
    like($@, qr/Wide character in memGzip/, "  wide characters in memGzip");

    eval { memGunzip($a) };
    like($@, qr/Wide character in memGunzip/, "  wide characters in memGunzip");

    eval { compress($a) };
    like($@, qr/Wide character in compress/, "  wide characters in compress");

    eval { uncompress($a) };
    like($@, qr/Wide character in uncompress/, "  wide characters in uncompress");

    my $lex = new LexFile my $name ;
    ok my $fil = gzopen($name, "wb"), "  gzopen for write ok" ;

    eval { $fil->gzwrite($a); } ;
    like($@, qr/Wide character in gzwrite/, "  wide characters in gzwrite");

    ok ! $fil->gzclose, "  gzclose ok" ;
}