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

BEGIN {
    if ($ENV{PERL_CORE}) {
	chdir 't' if -d 't';
	@INC = ("../lib", "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 $lex = new LexFile my $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 $lex = new LexFile my $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 $lex = new LexFile my $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 $lex = new LexFile my $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 {
d695c1a1	2	if ($ENV{PERL_CORE}) {
16816334	3	chdir 't' if -d 't';
0ecadccd	4	@INC = ("../lib", "lib");
16816334	5	}
16816334	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
9f2e3514	155	my $lex = new LexFile my $name ;
642e522c	156
	157	my $io = $CompressClass->new($name);
	158
	159	is $io->tell(), 0 ;
	160
	161	my $heisan = "Heisan\n";
	162	print $io $heisan ;
	163
	164	ok ! $io->eof;
	165
	166	is $io->tell(), length($heisan) ;
	167
	168	print($io "a", "b", "c");
	169
	170	{
	171	local($\) = "\n";
	172	print $io "d", "e";
	173	local($,) = ",";
	174	print $io "f", "g", "h";
	175	}
	176
	177	my $foo = "1234567890";
	178
	179	ok syswrite($io, $foo, length($foo)) == length($foo) ;
	180	if ( $[ < 5.6 )
	181	{ is $io->syswrite($foo, length $foo), length $foo }
	182	else
	183	{ is $io->syswrite($foo), length $foo }
	184	ok $io->syswrite($foo, length($foo)) == length $foo;
	185	ok $io->write($foo, length($foo), 5) == 5;
	186	ok $io->write("xxx\n", 100, -1) == 1;
	187
	188	for (1..3) {
	189	printf $io "i(%d)", $_;
	190	$io->printf("[%d]\n", $_);
	191	}
	192	select $io;
	193	print "\n";
	194	select STDOUT;
	195
	196	close $io ;
	197
	198	ok $io->eof;
	199
	200	is myGZreadFile($name), "Heisan\nabcde\nf,g,h\n" .
	201	("1234567890" x 3) . "67890\n" .
	202	"i(1)[1]\ni(2)[2]\ni(3)[3]\n\n";
	203
	204
	205	}
	206
	207	{
	208	# Read
	209	my $str = <<EOT;
	210	This is an example
	211	of a paragraph
	212
	213
	214	and a single line.
	215
	216	EOT
	217
9f2e3514	218	my $lex = new LexFile my $name ;
642e522c	219
	220	my $iow = new $CompressClass $name ;
	221	print $iow $str ;
	222	close $iow;
	223
	224	my @tmp;
	225	my $buf;
	226	{
	227	my $io = new $UncompressClass $name ;
	228
	229	ok ! $io->eof;
	230	is $io->tell(), 0 ;
	231	my @lines = <$io>;
	232	is @lines, 6
	233	or print "# Got " . scalar(@lines) . " lines, expected 6\n" ;
	234	is $lines[1], "of a paragraph\n" ;
	235	is join('', @lines), $str ;
	236	is $., 6;
	237	is $io->tell(), length($str) ;
	238
	239	ok $io->eof;
	240
	241	ok ! ( defined($io->getline) \|\|
	242	(@tmp = $io->getlines) \|\|
	243	defined(<$io>) \|\|
	244	defined($io->getc) \|\|
	245	read($io, $buf, 100) != 0) ;
	246	}
	247
	248
	249	{
	250	local $/; # slurp mode
	251	my $io = $UncompressClass->new($name);
	252	ok !$io->eof;
	253	my @lines = $io->getlines;
	254	ok $io->eof;
	255	ok @lines == 1 && $lines[0] eq $str;
	256
	257	$io = $UncompressClass->new($name);
	258	ok ! $io->eof;
	259	my $line = <$io>;
	260	ok $line eq $str;
	261	ok $io->eof;
	262	}
	263
	264	{
	265	local $/ = ""; # paragraph mode
	266	my $io = $UncompressClass->new($name);
	267	ok ! $io->eof;
	268	my @lines = <$io>;
	269	ok $io->eof;
	270	ok @lines == 2
	271	or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
	272	ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
	273	or print "# $lines[0]\n";
	274	ok $lines[1] eq "and a single line.\n\n";
	275	}
	276
	277	{
	278	local $/ = "is";
	279	my $io = $UncompressClass->new($name);
	280	my @lines = ();
	281	my $no = 0;
	282	my $err = 0;
283	ok ! $io->eof;
284	while (<$io>) {
285	push(@lines, $_);
286	$err++ if $. != ++$no;
287	}
288
289	ok $err == 0 ;
290	ok $io->eof;
291
292	ok @lines == 3
293	or print "# Got " . scalar(@lines) . " lines, expected 3\n" ;
294	ok join("-", @lines) eq
295	"This- is- an example\n" .
296	"of a paragraph\n\n\n" .
297	"and a single line.\n\n";
298	}
299
300
301	# Test read
302
303	{
304	my $io = $UncompressClass->new($name);
305
306
307	if (! $BadPerl) {
308	eval { read($io, $buf, -1) } ;
309	like $@, mkErr("length parameter is negative");
310	}
311
312	is read($io, $buf, 0), 0, "Requested 0 bytes" ;
313
314	ok read($io, $buf, 3) == 3 ;
315	ok $buf eq "Thi";
316
317	ok sysread($io, $buf, 3, 2) == 3 ;
318	ok $buf eq "Ths i"
319	or print "# [$buf]\n" ;;
320	ok ! $io->eof;
321
322	# $io->seek(-4, 2);
323	#
324	# ok ! $io->eof;
325	#
326	# ok read($io, $buf, 20) == 4 ;
327	# ok $buf eq "e.\n\n";
328	#
329	# ok read($io, $buf, 20) == 0 ;
330	# ok $buf eq "";
331	#
332	# ok ! $io->eof;
333	}
334
335	}
336
337	{
338	# Read from non-compressed file
339
340	my $str = <<EOT;
341	This is an example
342	of a paragraph
343
344
345	and a single line.
346
347	EOT
348
9f2e3514	349	my $lex = new LexFile my $name ;
642e522c	350
	351	writeFile($name, $str);
	352	my @tmp;
	353	my $buf;
	354	{
	355	my $io = new $UncompressClass $name, -Transparent => 1 ;
	356
	357	ok defined $io;
	358	ok ! $io->eof;
	359	ok $io->tell() == 0 ;
	360	my @lines = <$io>;
	361	ok @lines == 6;
	362	ok $lines[1] eq "of a paragraph\n" ;
	363	ok join('', @lines) eq $str ;
	364	ok $. == 6;
	365	ok $io->tell() == length($str) ;
	366
	367	ok $io->eof;
	368
	369	ok ! ( defined($io->getline) \|\|
	370	(@tmp = $io->getlines) \|\|
	371	defined(<$io>) \|\|
	372	defined($io->getc) \|\|
	373	read($io, $buf, 100) != 0) ;
	374	}
	375
	376
	377	{
	378	local $/; # slurp mode
	379	my $io = $UncompressClass->new($name);
	380	ok ! $io->eof;
	381	my @lines = $io->getlines;
	382	ok $io->eof;
	383	ok @lines == 1 && $lines[0] eq $str;
	384
	385	$io = $UncompressClass->new($name);
	386	ok ! $io->eof;
	387	my $line = <$io>;
	388	ok $line eq $str;
	389	ok $io->eof;
	390	}
	391
	392	{
	393	local $/ = ""; # paragraph mode
	394	my $io = $UncompressClass->new($name);
	395	ok ! $io->eof;
	396	my @lines = <$io>;
	397	ok $io->eof;
	398	ok @lines == 2
	399	or print "# exected 2 lines, got " . scalar(@lines) . "\n";
	400	ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
	401	or print "# [$lines[0]]\n" ;
	402	ok $lines[1] eq "and a single line.\n\n";
	403	}
	404
	405	{
	406	local $/ = "is";
	407	my $io = $UncompressClass->new($name);
	408	my @lines = ();
	409	my $no = 0;
	410	my $err = 0;
	411	ok ! $io->eof;
	412	while (<$io>) {
	413	push(@lines, $_);
414	$err++ if $. != ++$no;
415	}
416
417	ok $err == 0 ;
418	ok $io->eof;
419
420	ok @lines == 3 ;
421	ok join("-", @lines) eq
422	"This- is- an example\n" .
423	"of a paragraph\n\n\n" .
424	"and a single line.\n\n";
425	}
426
427
428	# Test read
429
430	{
431	my $io = $UncompressClass->new($name);
432
433	ok read($io, $buf, 3) == 3 ;
434	ok $buf eq "Thi";
435
436	ok sysread($io, $buf, 3, 2) == 3 ;
437	ok $buf eq "Ths i";
438	ok ! $io->eof;
439
440	# $io->seek(-4, 2);
441	#
442	# ok ! $io->eof;
443	#
444	# ok read($io, $buf, 20) == 4 ;
445	# ok $buf eq "e.\n\n";
446	#
447	# ok read($io, $buf, 20) == 0 ;
448	# ok $buf eq "";
449	#
450	# ok ! $io->eof;
451	}
452
453
454	}
455
456	{
457	# Vary the length parameter in a read
458
459	my $str = <<EOT;
460	x
461	x
462	This is an example
463	of a paragraph
464
465
466	and a single line.
467
468	EOT
469	$str = $str x 100 ;
470
471
472	foreach my $bufsize (1, 3, 512, 4096, length($str)-1, length($str), length($str)+1)
473	{
474	foreach my $trans (0, 1)
475	{
476	foreach my $append (0, 1)
477	{
478	title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ;
479
9f2e3514	480	my $lex = new LexFile my $name ;
642e522c	481
	482	if ($trans) {
	483	writeFile($name, $str) ;
	484	}
	485	else {
	486	my $iow = new $CompressClass $name ;
	487	print $iow $str ;
	488	close $iow;
	489	}
	490
	491
	492	my $io = $UncompressClass->new($name,
	493	-Append => $append,
	494	-Transparent => $trans);
	495
	496	my $buf;
	497
	498	is $io->tell(), 0;
	499
	500	if ($append) {
	501	1 while $io->read($buf, $bufsize) > 0;
	502	}
	503	else {
	504	my $tmp ;
	505	$buf .= $tmp while $io->read($tmp, $bufsize) > 0 ;
	506	}
	507	is length $buf, length $str;
	508	ok $buf eq $str ;
	509	ok ! $io->error() ;
	510	ok $io->eof;
	511	}
	512	}
	513	}
	514	}
	515
	516	}