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

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

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