xref: /openbsd-src/gnu/usr.bin/perl/cpan/IO-Compress/t/cz-08encoding.t (revision 4c1e55dc91edd6e69ccc60ce855900fbc12cf34f) 
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.
40is zlib_version, ZLIB_VERSION,
41    "ZLIB_VERSION matches 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 = 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 = memGzip($s);
62    is memGunzip(my $x = $co), $s, "  match uncompressed";
63
64    utf8::upgrade($co);
65
66    my $un = 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 { memGzip($a) };
120    like($@, qr/Wide character in memGzip/, "  wide characters in memGzip");
121
122    eval { memGunzip($a) };
123    like($@, qr/Wide character in memGunzip/, "  wide characters in memGunzip");
124
125    eval { compress($a) };
126    like($@, qr/Wide character in compress/, "  wide characters in compress");
127
128    eval { 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
140