1
2use strict;
3use warnings;
4use bytes;
5
6use Test::More ;
7use CompTestUtils;
8
9BEGIN
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 ;  Test::NoWarnings->import; 1; };
23    $extra = 1
24        if $st ;
25
26    plan(tests => 29 + $extra) ;
27}
28
29sub 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}\x80";
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 = LexFile->new( 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 = IO::File->new( "<$name" );
57#        }
58
59        for my $to ( qw(filehandle buffer))
60        {
61            title "OO Mode: To $to, Encode by hand";
62
63            my $lex2 = LexFile->new( 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 = IO::File->new( ">$name2" );
76            }
77
78
79            my $out ;
80            my $cs = $CompressClass->can('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 = $UncompressClass->can('new')->( $UncompressClass, $input, Append => 1);
93            my $got;
94            1 while $ucs->read($got) > 0 ;
95
96            is  $got, $encString, "  Expected output";
97
98            my $decode = Encode::decode_utf8($got);
99
100
101            is $decode, $string, "  Expected output";
102
103
104        }
105    }
106
107    {
108        title "Catch wide characters";
109
110        my $out;
111        my $cs = $CompressClass->can('new')->( $CompressClass, \$out);
112        my $a = "a\xFF\x{100}";
113        eval { $cs->syswrite($a) };
114        like($@, qr/Wide character in ${CompressClass}::write/,
115                 "  wide characters in ${CompressClass}::write");
116
117    }
118
119    {
120        title "Unknown encoding";
121        my $output;
122        eval { my $cs = $CompressClass->can('new')->( $CompressClass, \$output, Encode => 'fred'); } ;
123        like($@, qr/${CompressClass}: Encoding 'fred' is not available/,
124                 "  Encoding 'fred' is not available");
125    }
126
127    {
128        title "Encode option";
129
130        for my $to ( qw(filehandle filename buffer))
131        {
132            title "Encode: To $to, Encode option";
133
134            my $lex2 = LexFile->new( my $name2 );
135            my $output;
136            my $buffer;
137
138            if ($to eq 'buffer')
139            {
140                $output = \$buffer
141            }
142            elsif ($to eq 'filename')
143            {
144                $output = $name2 ;
145            }
146            elsif ($to eq 'filehandle')
147            {
148                $output = IO::File->new( ">$name2" );
149            }
150
151            my $out ;
152            my $cs = $CompressClass->can('new')->( $CompressClass, $output, AutoClose =>1, Encode => 'utf8');
153            ok $cs->print($string);
154            ok $cs->close();
155
156            my $input;
157            if ($to eq 'buffer')
158            {
159                $input = \$buffer
160            }
161            elsif ($to eq 'filename')
162            {
163                $input = $name2 ;
164            }
165            else
166            {
167                $input = IO::File->new( "<$name2" );
168            }
169
170            {
171                my $ucs = $UncompressClass->can('new')->( $UncompressClass, $input, AutoClose =>1, Append => 1);
172                my $got;
173                1 while $ucs->read($got) > 0 ;
174                ok length($got) > 0;
175                is  $got, $encString, "  Expected output";
176
177                my $decode = Encode::decode_utf8($got);
178
179                is  $decode, $string, "  Expected output";
180            }
181
182
183#            {
184#                my $ucs = $UncompressClass->can('new')->( $UncompressClass, $input, Append => 1, Decode => 'utf8');
185#                my $got;
186#                1 while $ucs->read($got) > 0 ;
187#                ok length($got) > 0;
188#                is  $got, $string, "  Expected output";
189#            }
190        }
191    }
192
193}
194
195
196
1971;
198