[p5sagit/p5-mst-13.2.git] / ext / Compress / Zlib / t / 20tied.t


use lib 't';
use strict;
use warnings;
use bytes;

use Test::More ;
use ZlibTestUtils;

our ($BadPerl);
 
BEGIN 
{ 
    plan(skip_all => "Tied Filehandle needs Perl 5.005 or better" )
        if $] < 5.005 ;

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

    my $tests ;
    $BadPerl = ($] >= 5.006 or $] <= 5.008) ;

    if ($BadPerl) {
        $tests = 731 ;
    }
    else {
        $tests = 771 ;
    }

    plan tests => $tests + $extra ;

    use_ok('Compress::Zlib', 2) ;

    use_ok('IO::Compress::Gzip', qw($GzipError)) ;
    use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ;

    use_ok('IO::Compress::Deflate', qw($DeflateError)) ;
    use_ok('IO::Uncompress::Inflate', qw($InflateError)) ;
     
    use_ok('IO::Compress::RawDeflate', qw($RawDeflateError)) ;
    use_ok('IO::Uncompress::RawInflate', qw($RawInflateError)) ;
}
 
 
use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
 

our ($UncompressClass);


sub myGZreadFile
{
    my $filename = shift ;
    my $init = shift ;


    my $fil = new $UncompressClass $filename,
                                    -Strict   => 1,
                                    -Append   => 1
                                    ;

    my $data ;
    $data = $init if defined $init ;
    1 while $fil->read($data) > 0;

    $fil->close ;
    return $data ;
}

# Check zlib_version and ZLIB_VERSION are the same.
is Compress::Zlib::zlib_version, ZLIB_VERSION, 
    "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;


foreach my $CompressClass ('IO::Compress::Gzip',     
                           'IO::Compress::Deflate', 
                           'IO::Compress::RawDeflate')
{
    next if $BadPerl ;


    title "Testing $CompressClass";

        
    my $x ;
    my $gz = new $CompressClass(\$x); 

    my $buff ;

    eval { getc($gz) } ;
    like $@, mkErr("^getc Not Available: File opened only for output");

    eval { read($gz, $buff, 1) } ;
    like $@, mkErr("^read Not Available: File opened only for output");

    eval { <$gz>  } ;
    like $@, mkErr("^readline Not Available: File opened only for output");

}

foreach my $CompressClass ('IO::Compress::Gzip',     
                           'IO::Compress::Deflate', 
                           'IO::Compress::RawDeflate')
{
    next if $BadPerl;
    $UncompressClass = getInverse($CompressClass);

    title "Testing $UncompressClass";

    my $gc ;
    my $guz = new $CompressClass(\$gc); 
    $guz->write("abc") ;
    $guz->close();

    my $x ;
    my $gz = new $UncompressClass(\$gc); 

    my $buff ;

    eval { print $gz "abc" } ;
    like $@, mkErr("^print Not Available: File opened only for intput");

    eval { printf $gz "fmt", "abc" } ;
    like $@, mkErr("^printf Not Available: File opened only for intput");

    #eval { write($gz, $buff, 1) } ;
    #like $@, mkErr("^write Not Available: File opened only for intput");

}

foreach my $CompressClass ('IO::Compress::Gzip',     
                           'IO::Compress::Deflate', 
                           'IO::Compress::RawDeflate')
{
    $UncompressClass = getInverse($CompressClass);

    title "Testing $CompressClass and $UncompressClass";


    {
        # Write
        # these tests come almost 100% from IO::String

        my $name = "test.gz" ;
        my $lex = new LexFile $name ;

        my $io = $CompressClass->new($name);

        is $io->tell(), 0 ;

        my $heisan = "Heisan\n";
        print $io $heisan ;

        ok ! $io->eof;

        is $io->tell(), length($heisan) ;

        print($io "a", "b", "c");

        {
            local($\) = "\n";
            print $io "d", "e";
            local($,) = ",";
            print $io "f", "g", "h";
        }

        my $foo = "1234567890";
        
        ok syswrite($io, $foo, length($foo)) == length($foo) ;
        if ( $[ < 5.6 )
          { is $io->syswrite($foo, length $foo), length $foo }
        else
          { is $io->syswrite($foo), length $foo }
        ok $io->syswrite($foo, length($foo)) == length $foo;
        ok $io->write($foo, length($foo), 5) == 5;
        ok $io->write("xxx\n", 100, -1) == 1;

        for (1..3) {
            printf $io "i(%d)", $_;
            $io->printf("[%d]\n", $_);
        }
        select $io;
        print "\n";
        select STDOUT;

        close $io ;

        ok $io->eof;

        is myGZreadFile($name), "Heisan\nabcde\nf,g,h\n" .
                                ("1234567890" x 3) . "67890\n" .
                                    "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n";


    }

    {
        # Read
        my $str = <<EOT;
This is an example
of a paragraph


and a single line.

EOT

        my $name = "test.gz" ;
        my $lex = new LexFile $name ;

        my $iow = new $CompressClass $name ;
        print $iow $str ;
        close $iow;

        my @tmp;
        my $buf;
        {
            my $io = new $UncompressClass $name ;
        
            ok ! $io->eof;
            is $io->tell(), 0 ;
            my @lines = <$io>;
            is @lines, 6
                or print "# Got " . scalar(@lines) . " lines, expected 6\n" ;
            is $lines[1], "of a paragraph\n" ;
            is join('', @lines), $str ;
            is $., 6; 
            is $io->tell(), length($str) ;
        
            ok $io->eof;

            ok ! ( defined($io->getline)  ||
                      (@tmp = $io->getlines) ||
                      defined(<$io>)         ||
                      defined($io->getc)     ||
                      read($io, $buf, 100)   != 0) ;
        }
        
        
        {
            local $/;  # slurp mode
            my $io = $UncompressClass->new($name);
            ok !$io->eof;
            my @lines = $io->getlines;
            ok $io->eof;
            ok @lines == 1 && $lines[0] eq $str;
        
            $io = $UncompressClass->new($name);
            ok ! $io->eof;
            my $line = <$io>;
            ok $line eq $str;
            ok $io->eof;
        }
        
        {
            local $/ = "";  # paragraph mode
            my $io = $UncompressClass->new($name);
            ok ! $io->eof;
            my @lines = <$io>;
            ok $io->eof;
            ok @lines == 2 
                or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
            ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
                or print "# $lines[0]\n";
            ok $lines[1] eq "and a single line.\n\n";
        }
        
        {
            local $/ = "is";
            my $io = $UncompressClass->new($name);
            my @lines = ();
            my $no = 0;
            my $err = 0;
            ok ! $io->eof;
            while (<$io>) {
                push(@lines, $_);
                $err++ if $. != ++$no;
            }
        
            ok $err == 0 ;
            ok $io->eof;
        
            ok @lines == 3 
                or print "# Got " . scalar(@lines) . " lines, expected 3\n" ;
            ok join("-", @lines) eq
                             "This- is- an example\n" .
                            "of a paragraph\n\n\n" .
                            "and a single line.\n\n";
        }
        
        
        # Test read
        
        {
            my $io = $UncompressClass->new($name);
        

            if (! $BadPerl) {
                eval { read($io, $buf, -1) } ;
                like $@, mkErr("length parameter is negative");
            }

            is read($io, $buf, 0), 0, "Requested 0 bytes" ;

            ok read($io, $buf, 3) == 3 ;
            ok $buf eq "Thi";
        
            ok sysread($io, $buf, 3, 2) == 3 ;
            ok $buf eq "Ths i"
                or print "# [$buf]\n" ;;
            ok ! $io->eof;
        
    #        $io->seek(-4, 2);
    #    
    #        ok ! $io->eof;
    #    
    #        ok read($io, $buf, 20) == 4 ;
    #        ok $buf eq "e.\n\n";
    #    
    #        ok read($io, $buf, 20) == 0 ;
    #        ok $buf eq "";
    #   
    #        ok ! $io->eof;
        }

    }

    {
        # Read from non-compressed file

        my $str = <<EOT;
This is an example
of a paragraph


and a single line.

EOT

        my $name = "test.gz" ;
        my $lex = new LexFile $name ;

        writeFile($name, $str);
        my @tmp;
        my $buf;
        {
            my $io = new $UncompressClass $name, -Transparent => 1 ;
        
            ok defined $io;
            ok ! $io->eof;
            ok $io->tell() == 0 ;
            my @lines = <$io>;
            ok @lines == 6; 
            ok $lines[1] eq "of a paragraph\n" ;
            ok join('', @lines) eq $str ;
            ok $. == 6; 
            ok $io->tell() == length($str) ;
        
            ok $io->eof;

            ok ! ( defined($io->getline)  ||
                      (@tmp = $io->getlines) ||
                      defined(<$io>)         ||
                      defined($io->getc)     ||
                      read($io, $buf, 100)   != 0) ;
        }
        
        
        {
            local $/;  # slurp mode
            my $io = $UncompressClass->new($name);
            ok ! $io->eof;
            my @lines = $io->getlines;
            ok $io->eof;
            ok @lines == 1 && $lines[0] eq $str;
        
            $io = $UncompressClass->new($name);
            ok ! $io->eof;
            my $line = <$io>;
            ok $line eq $str;
            ok $io->eof;
        }
        
        {
            local $/ = "";  # paragraph mode
            my $io = $UncompressClass->new($name);
            ok ! $io->eof;
            my @lines = <$io>;
            ok $io->eof;
            ok @lines == 2 
                or print "# exected 2 lines, got " . scalar(@lines) . "\n";
            ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
                or print "# [$lines[0]]\n" ;
            ok $lines[1] eq "and a single line.\n\n";
        }
        
        {
            local $/ = "is";
            my $io = $UncompressClass->new($name);
            my @lines = ();
            my $no = 0;
            my $err = 0;
            ok ! $io->eof;
            while (<$io>) {
                push(@lines, $_);
                $err++ if $. != ++$no;
            }
        
            ok $err == 0 ;
            ok $io->eof;
        
            ok @lines == 3 ;
            ok join("-", @lines) eq
                             "This- is- an example\n" .
                            "of a paragraph\n\n\n" .
                            "and a single line.\n\n";
        }
        
        
        # Test read
        
        {
            my $io = $UncompressClass->new($name);
        
            ok read($io, $buf, 3) == 3 ;
            ok $buf eq "Thi";
        
            ok sysread($io, $buf, 3, 2) == 3 ;
            ok $buf eq "Ths i";
            ok ! $io->eof;
        
    #        $io->seek(-4, 2);
    #    
    #        ok ! $io->eof;
    #    
    #        ok read($io, $buf, 20) == 4 ;
    #        ok $buf eq "e.\n\n";
    #    
    #        ok read($io, $buf, 20) == 0 ;
    #        ok $buf eq "";
    #    
    #        ok ! $io->eof;
        }


    }

    {
        # Vary the length parameter in a read

        my $str = <<EOT;
x
x
This is an example
of a paragraph


and a single line.

EOT
        $str = $str x 100 ;


        foreach my $bufsize (1, 3, 512, 4096, length($str)-1, length($str), length($str)+1)
        {
            foreach my $trans (0, 1)
            {
                foreach my $append (0, 1)
                {
                    title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ;

                    my $name = "testz.gz" ;
                    my $lex = new LexFile $name ;

                    if ($trans) {
                        writeFile($name, $str) ;
                    }
                    else {
                        my $iow = new $CompressClass $name ;
                        print $iow $str ;
                        close $iow;
                    }

                    
                    my $io = $UncompressClass->new($name, 
                                                   -Append => $append,
                                                   -Transparent  => $trans);
                
                    my $buf;
                    
                    is $io->tell(), 0;

                    if ($append) {
                        1 while $io->read($buf, $bufsize) > 0;
                    }
                    else {
                        my $tmp ;
                        $buf .= $tmp while $io->read($tmp, $bufsize) > 0 ;
                    }
                    is length $buf, length $str;
                    ok $buf eq $str ;
                    ok ! $io->error() ;
                    ok $io->eof;
                }
            }
        }
    }

}
Commit	Line	Data
642e522c	1
	2	use lib 't';
	3	use strict;
	4	use warnings;
	5	use bytes;
	6
	7	use Test::More ;
	8	use ZlibTestUtils;
	9
	10	our ($BadPerl);
	11
	12	BEGIN
	13	{
	14	plan(skip_all => "Tied Filehandle needs Perl 5.005 or better" )
	15	if $] < 5.005 ;
	16
	17	# use Test::NoWarnings, if available
	18	my $extra = 0 ;
	19	$extra = 1
	20	if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
	21
	22	my $tests ;
	23	$BadPerl = ($] >= 5.006 or $] <= 5.008) ;
	24
	25	if ($BadPerl) {
	26	$tests = 731 ;
	27	}
	28	else {
	29	$tests = 771 ;
	30	}
	31
	32	plan tests => $tests + $extra ;
	33
	34	use_ok('Compress::Zlib', 2) ;
	35
	36	use_ok('IO::Compress::Gzip', qw($GzipError)) ;
	37	use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ;
	38
	39	use_ok('IO::Compress::Deflate', qw($DeflateError)) ;
	40	use_ok('IO::Uncompress::Inflate', qw($InflateError)) ;
	41
	42	use_ok('IO::Compress::RawDeflate', qw($RawDeflateError)) ;
	43	use_ok('IO::Uncompress::RawInflate', qw($RawInflateError)) ;
	44	}
	45
	46
	47	use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
	48
	49
	50
	51
	52	our ($UncompressClass);
	53
	54
	55	sub myGZreadFile
	56	{
	57	my $filename = shift ;
	58	my $init = shift ;
	59
	60
	61	my $fil = new $UncompressClass $filename,
	62	-Strict => 1,
	63	-Append => 1
	64	;
65
66	my $data ;
67	$data = $init if defined $init ;
68	1 while $fil->read($data) > 0;
69
70	$fil->close ;
71	return $data ;
72	}
73
74	# Check zlib_version and ZLIB_VERSION are the same.
75	is Compress::Zlib::zlib_version, ZLIB_VERSION,
76	"ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
77
78
79
80	foreach my $CompressClass ('IO::Compress::Gzip',
81	'IO::Compress::Deflate',
82	'IO::Compress::RawDeflate')
83	{
84	next if $BadPerl ;
85
86
87	title "Testing $CompressClass";
88
89
90	my $x ;
91	my $gz = new $CompressClass(\$x);
92
93	my $buff ;
94
95	eval { getc($gz) } ;
96	like $@, mkErr("^getc Not Available: File opened only for output");
97
98	eval { read($gz, $buff, 1) } ;
99	like $@, mkErr("^read Not Available: File opened only for output");
100
101	eval { <$gz> } ;
102	like $@, mkErr("^readline Not Available: File opened only for output");
103
104	}
105
106	foreach my $CompressClass ('IO::Compress::Gzip',
107	'IO::Compress::Deflate',
108	'IO::Compress::RawDeflate')
109	{
110	next if $BadPerl;
111	$UncompressClass = getInverse($CompressClass);
112
113	title "Testing $UncompressClass";
114
115	my $gc ;
116	my $guz = new $CompressClass(\$gc);
117	$guz->write("abc") ;
118	$guz->close();
119
120	my $x ;
121	my $gz = new $UncompressClass(\$gc);
122
123	my $buff ;
124
125	eval { print $gz "abc" } ;
126	like $@, mkErr("^print Not Available: File opened only for intput");
127
128	eval { printf $gz "fmt", "abc" } ;
129	like $@, mkErr("^printf Not Available: File opened only for intput");
130
131	#eval { write($gz, $buff, 1) } ;
132	#like $@, mkErr("^write Not Available: File opened only for intput");
133
134	}
135
136	foreach my $CompressClass ('IO::Compress::Gzip',
137	'IO::Compress::Deflate',
138	'IO::Compress::RawDeflate')
139	{
140	$UncompressClass = getInverse($CompressClass);
141
142	title "Testing $CompressClass and $UncompressClass";
143
144
145	{
146	# Write
147	# these tests come almost 100% from IO::String
148
149	my $name = "test.gz" ;
150	my $lex = new LexFile $name ;
151
152	my $io = $CompressClass->new($name);
153
154	is $io->tell(), 0 ;
155
156	my $heisan = "Heisan\n";
157	print $io $heisan ;
158
159	ok ! $io->eof;
160
161	is $io->tell(), length($heisan) ;
162
163	print($io "a", "b", "c");
164
165	{
166	local($\) = "\n";
167	print $io "d", "e";
168	local($,) = ",";
169	print $io "f", "g", "h";
170	}
171
172	my $foo = "1234567890";
173
174	ok syswrite($io, $foo, length($foo)) == length($foo) ;
175	if ( $[ < 5.6 )
176	{ is $io->syswrite($foo, length $foo), length $foo }
177	else
178	{ is $io->syswrite($foo), length $foo }
179	ok $io->syswrite($foo, length($foo)) == length $foo;
180	ok $io->write($foo, length($foo), 5) == 5;
181	ok $io->write("xxx\n", 100, -1) == 1;
182
183	for (1..3) {
184	printf $io "i(%d)", $_;
185	$io->printf("[%d]\n", $_);
186	}
187	select $io;
188	print "\n";
189	select STDOUT;
190
191	close $io ;
192
193	ok $io->eof;
194
195	is myGZreadFile($name), "Heisan\nabcde\nf,g,h\n" .
196	("1234567890" x 3) . "67890\n" .
197	"i(1)[1]\ni(2)[2]\ni(3)[3]\n\n";
198
199
200	}
201
202	{
203	# Read
204	my $str = <<EOT;
205	This is an example
206	of a paragraph
207
208
209	and a single line.
210
211	EOT
212
213	my $name = "test.gz" ;
214	my $lex = new LexFile $name ;
215
216	my $iow = new $CompressClass $name ;
217	print $iow $str ;
218	close $iow;
219
220	my @tmp;
221	my $buf;
222	{
223	my $io = new $UncompressClass $name ;
224
225	ok ! $io->eof;
226	is $io->tell(), 0 ;
227	my @lines = <$io>;
228	is @lines, 6
229	or print "# Got " . scalar(@lines) . " lines, expected 6\n" ;
230	is $lines[1], "of a paragraph\n" ;
231	is join('', @lines), $str ;
232	is $., 6;
233	is $io->tell(), length($str) ;
234
235	ok $io->eof;
236
237	ok ! ( defined($io->getline) \|\|
238	(@tmp = $io->getlines) \|\|
239	defined(<$io>) \|\|
240	defined($io->getc) \|\|
241	read($io, $buf, 100) != 0) ;
242	}
243
244
245	{
246	local $/; # slurp mode
247	my $io = $UncompressClass->new($name);
248	ok !$io->eof;
249	my @lines = $io->getlines;
250	ok $io->eof;
251	ok @lines == 1 && $lines[0] eq $str;
252
253	$io = $UncompressClass->new($name);
254	ok ! $io->eof;
255	my $line = <$io>;
256	ok $line eq $str;
257	ok $io->eof;
258	}
259
260	{
261	local $/ = ""; # paragraph mode
262	my $io = $UncompressClass->new($name);
263	ok ! $io->eof;
264	my @lines = <$io>;
265	ok $io->eof;
266	ok @lines == 2
267	or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
268	ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
269	or print "# $lines[0]\n";
270	ok $lines[1] eq "and a single line.\n\n";
271	}
272
273	{
274	local $/ = "is";
275	my $io = $UncompressClass->new($name);
276	my @lines = ();
277	my $no = 0;
278	my $err = 0;
279	ok ! $io->eof;
280	while (<$io>) {
281	push(@lines, $_);
282	$err++ if $. != ++$no;
283	}
284
285	ok $err == 0 ;
286	ok $io->eof;
287
288	ok @lines == 3
289	or print "# Got " . scalar(@lines) . " lines, expected 3\n" ;
290	ok join("-", @lines) eq
291	"This- is- an example\n" .
292	"of a paragraph\n\n\n" .
293	"and a single line.\n\n";
294	}
295
296
297	# Test read
298
299	{
300	my $io = $UncompressClass->new($name);
301
302
303	if (! $BadPerl) {
304	eval { read($io, $buf, -1) } ;
305	like $@, mkErr("length parameter is negative");
306	}
307
308	is read($io, $buf, 0), 0, "Requested 0 bytes" ;
309
310	ok read($io, $buf, 3) == 3 ;
311	ok $buf eq "Thi";
312
313	ok sysread($io, $buf, 3, 2) == 3 ;
314	ok $buf eq "Ths i"
315	or print "# [$buf]\n" ;;
316	ok ! $io->eof;
317
318	# $io->seek(-4, 2);
319	#
320	# ok ! $io->eof;
321	#
322	# ok read($io, $buf, 20) == 4 ;
323	# ok $buf eq "e.\n\n";
324	#
325	# ok read($io, $buf, 20) == 0 ;
326	# ok $buf eq "";
327	#
328	# ok ! $io->eof;
329	}
330
331	}
332
333	{
334	# Read from non-compressed file
335
336	my $str = <<EOT;
337	This is an example
338	of a paragraph
339
340
341	and a single line.
342
343	EOT
344
345	my $name = "test.gz" ;
346	my $lex = new LexFile $name ;
347
348	writeFile($name, $str);
349	my @tmp;
350	my $buf;
351	{
352	my $io = new $UncompressClass $name, -Transparent => 1 ;
353
354	ok defined $io;
355	ok ! $io->eof;
356	ok $io->tell() == 0 ;
357	my @lines = <$io>;
358	ok @lines == 6;
359	ok $lines[1] eq "of a paragraph\n" ;
360	ok join('', @lines) eq $str ;
361	ok $. == 6;
362	ok $io->tell() == length($str) ;
363
364	ok $io->eof;
365
366	ok ! ( defined($io->getline) \|\|
367	(@tmp = $io->getlines) \|\|
368	defined(<$io>) \|\|
369	defined($io->getc) \|\|
370	read($io, $buf, 100) != 0) ;
371	}
372
373
374	{
375	local $/; # slurp mode
376	my $io = $UncompressClass->new($name);
377	ok ! $io->eof;
378	my @lines = $io->getlines;
379	ok $io->eof;
380	ok @lines == 1 && $lines[0] eq $str;
381
382	$io = $UncompressClass->new($name);
383	ok ! $io->eof;
384	my $line = <$io>;
385	ok $line eq $str;
386	ok $io->eof;
387	}
388
389	{
390	local $/ = ""; # paragraph mode
391	my $io = $UncompressClass->new($name);
392	ok ! $io->eof;
393	my @lines = <$io>;
394	ok $io->eof;
395	ok @lines == 2
396	or print "# exected 2 lines, got " . scalar(@lines) . "\n";
397	ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
398	or print "# [$lines[0]]\n" ;
399	ok $lines[1] eq "and a single line.\n\n";
400	}
401
402	{
403	local $/ = "is";
404	my $io = $UncompressClass->new($name);
405	my @lines = ();
406	my $no = 0;
407	my $err = 0;
408	ok ! $io->eof;
409	while (<$io>) {
410	push(@lines, $_);
411	$err++ if $. != ++$no;
412	}
413
414	ok $err == 0 ;
415	ok $io->eof;
416
417	ok @lines == 3 ;
418	ok join("-", @lines) eq
419	"This- is- an example\n" .
420	"of a paragraph\n\n\n" .
421	"and a single line.\n\n";
422	}
423
424
425	# Test read
426
427	{
428	my $io = $UncompressClass->new($name);
429
430	ok read($io, $buf, 3) == 3 ;
431	ok $buf eq "Thi";
432
433	ok sysread($io, $buf, 3, 2) == 3 ;
434	ok $buf eq "Ths i";
435	ok ! $io->eof;
436
437	# $io->seek(-4, 2);
438	#
439	# ok ! $io->eof;
440	#
441	# ok read($io, $buf, 20) == 4 ;
442	# ok $buf eq "e.\n\n";
443	#
444	# ok read($io, $buf, 20) == 0 ;
445	# ok $buf eq "";
446	#
447	# ok ! $io->eof;
448	}
449
450
451	}
452
453	{
454	# Vary the length parameter in a read
455
456	my $str = <<EOT;
457	x
458	x
459	This is an example
460	of a paragraph
461
462
463	and a single line.
464
465	EOT
466	$str = $str x 100 ;
467
468
469	foreach my $bufsize (1, 3, 512, 4096, length($str)-1, length($str), length($str)+1)
470	{
471	foreach my $trans (0, 1)
472	{
473	foreach my $append (0, 1)
474	{
475	title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ;
476
477	my $name = "testz.gz" ;
478	my $lex = new LexFile $name ;
479
480	if ($trans) {
481	writeFile($name, $str) ;
482	}
483	else {
484	my $iow = new $CompressClass $name ;
485	print $iow $str ;
486	close $iow;
487	}
488
489
490	my $io = $UncompressClass->new($name,
491	-Append => $append,
492	-Transparent => $trans);
493
494	my $buf;
495
496	is $io->tell(), 0;
497
498	if ($append) {
499	1 while $io->read($buf, $bufsize) > 0;
500	}
501	else {
502	my $tmp ;
503	$buf .= $tmp while $io->read($tmp, $bufsize) > 0 ;
504	}
505	is length $buf, length $str;
506	ok $buf eq $str ;
507	ok ! $io->error() ;
508	ok $io->eof;
509	}
510	}
511	}
512	}
513
514	}