Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
CompTestUtils.pm	18.11 KB	-r--r--r--	2014-12-27 11:48
any.pl	2.97 KB	-r--r--r--	2014-12-27 11:48
anyunc.pl	2.59 KB	-r--r--r--	2014-12-27 11:48
destroy.pl	2.28 KB	-r--r--r--	2014-12-27 11:48
encode.pl	4.74 KB	-r--r--r--	2014-12-27 11:48
generic.pl	50.95 KB	-r--r--r--	2014-12-27 11:48
merge.pl	9.24 KB	-r--r--r--	2014-12-27 11:48
multi.pl	9.4 KB	-r--r--r--	2014-12-27 11:48
newtied.pl	9.71 KB	-r--r--r--	2014-12-27 11:48
oneshot.pl	53.35 KB	-r--r--r--	2014-12-27 11:49
prime.pl	2.29 KB	-r--r--r--	2014-12-27 11:49
tied.pl	13.02 KB	-r--r--r--	2014-12-27 11:48
truncate.pl	10.03 KB	-r--r--r--	2014-12-27 11:48
zlib-generic.pl	4.68 KB	-r--r--r--	2014-12-27 11:48

Rename

use strict;
use warnings;
use bytes;

use Test::More ;
use CompTestUtils;

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

plan tests => 49 + $extra ;
}

my $CompressClass   = identify();
my $UncompressClass = getInverse($CompressClass);
my $Error           = getErrorRef($CompressClass);
my $UnError         = getErrorRef($UncompressClass);

use Compress::Raw::Zlib;
use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);

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 ;
}

{

title "Testing $CompressClass Errors";

}

{
    title "Testing $UncompressClass Errors";

}

{
    title "Testing $CompressClass and $UncompressClass";

{
        title "flush" ;

my $lex = new LexFile my $name ;

my $hello = <<EOM ;
hello world
this is a test
EOM

{
          my $x ;
          ok $x = new $CompressClass $name  ;

ok $x->write($hello), "write" ;
          ok $x->flush(Z_FINISH), "flush";
          ok $x->close, "close" ;
        }

{
          my $uncomp;
          ok my $x = new $UncompressClass $name, -Append => 1  ;

my $len ;
          1 while ($len = $x->read($uncomp)) > 0 ;

is $len, 0, "read returned 0";

ok $x->close ;
          is $uncomp, $hello ;
        }
    }

if ($CompressClass ne 'RawDeflate')
    {
        # write empty file
        #========================================

my $buffer = '';
        {
          my $x ;
          ok $x = new $CompressClass(\$buffer) ;
          ok $x->close ;
      
        }

my $keep = $buffer ;
        my $uncomp= '';
        {
          my $x ;
          ok $x = new $UncompressClass(\$buffer, Append => 1)  ;

1 while $x->read($uncomp) > 0  ;

ok $x->close ;
        }

ok $uncomp eq '' ;
        ok $buffer eq $keep ;

}

{
        title "inflateSync on plain file";

my $hello = "I am a HAL 9000 computer" x 2001 ;

my $k = new $UncompressClass(\$hello, Transparent => 1);
        ok $k ;
     
        # Skip to the flush point -- no-op for plain file
        my $status = $k->inflateSync();
        is $status, 1 
            or diag $k->error() ;
     
        my $rest; 
        is $k->read($rest, length($hello)), length($hello)
            or diag $k->error() ;
        ok $rest eq $hello ;

ok $k->close();
    }

{
        title "$CompressClass: inflateSync for real";

# create a deflate stream with flush points

my $hello = "I am a HAL 9000 computer" x 2001 ;
        my $goodbye = "Will I dream?" x 2010;
        my ($x, $err, $answer, $X, $Z, $status);
        my $Answer ;
     
        ok ($x = new $CompressClass(\$Answer));
        ok $x ;
     
        is $x->write($hello), length($hello);
    
        # create a flush point
        ok $x->flush(Z_FULL_FLUSH) ;
         
        is $x->write($goodbye), length($goodbye);
    
        ok $x->close() ;
     
        my $k;
        $k = new $UncompressClass(\$Answer, BlockSize => 1);
        ok $k ;
     
        my $initial;
        is $k->read($initial, 1), 1 ;
        is $initial, substr($hello, 0, 1);

# Skip to the flush point
        $status = $k->inflateSync();
        is $status, 1, "   inflateSync returned 1"
            or diag $k->error() ;
     
        my $rest; 
        is $k->read($rest, length($hello) + length($goodbye)), 
                length($goodbye)
            or diag $k->error() ;
        ok $rest eq $goodbye, " got expected output" ;

ok $k->close();
    }

{
        title "$CompressClass: inflateSync no FLUSH point";

# create a deflate stream with flush points

my $hello = "I am a HAL 9000 computer" x 2001 ;
        my ($x, $err, $answer, $X, $Z, $status);
        my $Answer ;
     
        ok ($x = new $CompressClass(\$Answer));
        ok $x ;
     
        is $x->write($hello), length($hello);
    
        ok $x->close() ;
     
        my $k = new $UncompressClass(\$Answer, BlockSize => 1);
        ok $k ;
     
        my $initial;
        is $k->read($initial, 1), 1 ;
        is $initial, substr($hello, 0, 1);

# Skip to the flush point
        $status = $k->inflateSync();
        is $status, 0 
            or diag $k->error() ;
     
        ok $k->close();
        is $k->inflateSync(), 0 ;
    }

}