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