02zlib.t

source of perl for linux application,

    foreach (@Answer)
    {
        $status = $k->inflate($_, $GOT) ;
        last if $status == Z_STREAM_END or $status != Z_OK ;
     
    }
     
    cmp_ok $status, '==', Z_STREAM_END ;
    is $GOT, $hello ;
    
}

{
    title 'inflateSync';

    # 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 ;
     
    #use Devel::Peek ;
    ok(($x, $err) = new Compress::Raw::Zlib::Deflate(AppendOutput => 1)) ;
    ok $x ;
    cmp_ok $err, '==', Z_OK ;
     
    cmp_ok $x->deflate($hello, $Answer), '==', Z_OK;
    
    # create a flush point
    cmp_ok $x->flush($Answer, Z_FULL_FLUSH), '==', Z_OK ;
     
    cmp_ok $x->deflate($goodbye, $Answer), '==', Z_OK;
    
    cmp_ok $x->flush($Answer), '==', Z_OK ;
     
    my ($first, @Answer) = split('', $Answer) ;
     
    my $k;
    ok(($k, $err) = new Compress::Raw::Zlib::Inflate()) ;
    ok $k ;
    cmp_ok $err, '==', Z_OK ;
     
    cmp_ok  $k->inflate($first, $Z), '==', Z_OK;

    # skip to the first flush point.
    while (@Answer)
    {
        my $byte = shift @Answer;
        $status = $k->inflateSync($byte) ;
        last unless $status == Z_DATA_ERROR;
    }

    cmp_ok $status, '==', Z_OK;
     
    my $GOT = '';
    foreach (@Answer)
    {
        my $Z = '';
        $status = $k->inflate($_, $Z) ;
        $GOT .= $Z if defined $Z ;
        # print "x $status\n";
        last if $status == Z_STREAM_END or $status != Z_OK ;
     
    }
     
    cmp_ok $status, '==', Z_DATA_ERROR ;
    is $GOT, $goodbye ;


    # Check inflateSync leaves good data in buffer
    my $rest = $Answer ;
    $rest =~ s/^(.)//;
    my $initial = $1 ;

    
    ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-ConsumeInput => 0)) ;
    ok $k ;
    cmp_ok $err, '==', Z_OK ;
     
    cmp_ok $k->inflate($initial, $Z), '==', Z_OK;

    # Skip to the flush point
    $status = $k->inflateSync($rest);
    cmp_ok $status, '==', Z_OK
     or diag "status '$status'\nlength rest is " . length($rest) . "\n" ;
     
    cmp_ok $k->inflate($rest, $GOT), '==', Z_DATA_ERROR;
    is $Z . $GOT, $goodbye ;
}

{
    title 'deflateParams';

    my $hello = "I am a HAL 9000 computer" x 2001 ;
    my $goodbye = "Will I dream?" x 2010;
    my ($x, $input, $err, $answer, $X, $status, $Answer);
     
    ok(($x, $err) = new Compress::Raw::Zlib::Deflate(
                       -AppendOutput   => 1,
                       -Level    => Z_DEFAULT_COMPRESSION,
                       -Strategy => Z_DEFAULT_STRATEGY)) ;
    ok $x ;
    cmp_ok $err, '==', Z_OK ;

    ok $x->get_Level()    == Z_DEFAULT_COMPRESSION;
    ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
     
    $status = $x->deflate($hello, $Answer) ;
    cmp_ok $status, '==', Z_OK ;
    $input .= $hello;
    
    # error cases
    eval { $x->deflateParams() };
    like $@, mkErr('^Compress::Raw::Zlib::deflateParams needs Level and\/or Strategy');

    eval { $x->deflateParams(-Bufsize => 0) };
    like $@, mkErr('^Compress::Raw::Zlib::Inflate::deflateParams: Bufsize must be >= 1, you specified 0');

    eval { $x->deflateParams(-Joe => 3) };
    like $@, mkErr('^Compress::Raw::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe');

    is $x->get_Level(),    Z_DEFAULT_COMPRESSION;
    is $x->get_Strategy(), Z_DEFAULT_STRATEGY;
     
    # change both Level & Strategy
    $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY, -Bufsize => 1234) ;
    cmp_ok $status, '==', Z_OK ;
    
    is $x->get_Level(),    Z_BEST_SPEED;
    is $x->get_Strategy(), Z_HUFFMAN_ONLY;
     
    $status = $x->deflate($goodbye, $Answer) ;
    cmp_ok $status, '==', Z_OK ;
    $input .= $goodbye;
    
    # change only Level 
    $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ;
    cmp_ok $status, '==', Z_OK ;
    
    is $x->get_Level(),    Z_NO_COMPRESSION;
    is $x->get_Strategy(), Z_HUFFMAN_ONLY;
     
    $status = $x->deflate($goodbye, $Answer) ;
    cmp_ok $status, '==', Z_OK ;
    $input .= $goodbye;
    
    # change only Strategy
    $status = $x->deflateParams(-Strategy => Z_FILTERED) ;
    cmp_ok $status, '==', Z_OK ;
    
    is $x->get_Level(),    Z_NO_COMPRESSION;
    is $x->get_Strategy(), Z_FILTERED;
     
    $status = $x->deflate($goodbye, $Answer) ;
    cmp_ok $status, '==', Z_OK ;
    $input .= $goodbye;
    
    cmp_ok $x->flush($Answer), '==', Z_OK ;
     
    my $k;
    ok(($k, $err) = new Compress::Raw::Zlib::Inflate()) ;
    ok $k ;
    cmp_ok $err, '==', Z_OK ;
     
    my $Z;
    $status = $k->inflate($Answer, $Z) ;

    cmp_ok $status, '==', Z_STREAM_END ;
    is $Z, $input ;
}


{
    title "ConsumeInput and a read-only buffer trapped" ;

    ok my $k = new Compress::Raw::Zlib::Inflate(-ConsumeInput => 1) ;
     
    my $Z; 
    eval { $k->inflate("abc", $Z) ; };
    like $@, mkErr("Compress::Raw::Zlib::Inflate::inflate input parameter cannot be read-only when ConsumeInput is specified");

}

foreach (1 .. 2)
{
    next if $[ < 5.005 ;

    title 'test inflate/deflate with a substr';

    my $contents = '' ;
    foreach (1 .. 5000)
      { $contents .= chr int rand 255 }
    ok  my $x = new Compress::Raw::Zlib::Deflate(-AppendOutput => 1) ;
     
    my $X ;
    my $status = $x->deflate(substr($contents,0), $X);
    cmp_ok $status, '==', Z_OK ;
    
    cmp_ok $x->flush($X), '==', Z_OK  ;
     
    my $append = "Appended" ;
    $X .= $append ;
     
    ok my $k = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) ;
     
    my $Z; 
    my $keep = $X ;
    $status = $k->inflate(substr($X, 0), $Z) ;
     
    cmp_ok $status, '==', Z_STREAM_END ;
    #print "status $status X [$X]\n" ;
    is $contents, $Z ;
    ok $X eq $append;
    #is length($X), length($append);
    #ok $X eq $keep;
    #is length($X), length($keep);
}

title 'Looping Append test - checks that deRef_l resets the output buffer';
foreach (1 .. 2)
{

    my $hello = "I am a HAL 9000 computer" ;
    my @hello = split('', $hello) ;
    my ($err, $x, $X, $status); 
 
    ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1 ) );
    ok $x ;
    cmp_ok $err, '==', Z_OK ;
 
    $X = "" ;
    my $Answer = '';
    foreach (@hello)
    {
        $status = $x->deflate($_, $X) ;
        last unless $status == Z_OK ;
    
        $Answer .= $X ;
    }
     
    cmp_ok $status, '==', Z_OK ;
    
    cmp_ok  $x->flush($X), '==', Z_OK ;
    $Answer .= $X ;
     
    my @Answer = split('', $Answer) ;
     
    my $k;
    ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
    ok $k ;
    cmp_ok $err, '==', Z_OK ;
 
    my $GOT ;
    my $Z;
    $Z = 1 ;#x 2000 ;
    foreach (@Answer)
    {
        $status = $k->inflate($_, $GOT) ;
        last if $status == Z_STREAM_END or $status != Z_OK ;
    }
     
    cmp_ok $status, '==', Z_STREAM_END ;
    is $GOT, $hello ;

}

if ($] >= 5.005)
{
    title 'test inflate input parameter via substr';

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

    my($X, $Z);

    ok my $x = new Compress::Raw::Zlib::Deflate ( -AppendOutput => 1 );

    cmp_ok $x->deflate($data, $X), '==',  Z_OK ;

    cmp_ok $x->flush($X), '==', Z_OK ;
     
    my $append = "Appended" ;
    $X .= $append ;
    my $keep = $X ;
     
    ok my $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1,
                                             -ConsumeInput => 1 ) ;
     
    cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ;
     
    ok $hello eq $Z ;
    is $X, $append;
    
    $X = $keep ;
    $Z = '';
    ok $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1,
                                          -ConsumeInput => 0 ) ;
     
    cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ;
    #cmp_ok $k->inflate(substr($X, 0), $Z), '==', Z_STREAM_END ; ;
     
    ok $hello eq $Z ;
    is $X, $keep;
    
}

{
    # regression - check that resetLastBlockByte can cope with a NULL
    # pointer.
    Compress::Raw::Zlib::InflateScan->new->resetLastBlockByte(undef);
    ok 1, "resetLastBlockByte(undef) is ok" ;
}

exit if $] < 5.006 ;

title 'Looping Append test with substr output - substr the end of the string';
foreach (1 .. 2)
{

    my $hello = "I am a HAL 9000 computer" ;
    my @hello = split('', $hello) ;
    my ($err, $x, $X, $status); 
 
    ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1,
                                            -AppendOutput => 1 ) );
    ok $x ;
    cmp_ok $err, '==', Z_OK ;
 
    $X = "" ;
    my $Answer = '';
    foreach (@hello)
    {
        $status = $x->deflate($_, substr($Answer, length($Answer))) ;
        last unless $status == Z_OK ;
    
    }
     
    cmp_ok $status, '==', Z_OK ;
    
    cmp_ok  $x->flush(substr($Answer, length($Answer))), '==', Z_OK ;
     
    #cmp_ok length $Answer, ">", 0 ;

    my @Answer = split('', $Answer) ;
    
     
    my $k;
    ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
    ok $k ;
    cmp_ok $err, '==', Z_OK ;
 
    my $GOT = '';
    my $Z;
    $Z = 1 ;#x 2000 ;
    foreach (@Answer)
    {
        $status = $k->inflate($_, substr($GOT, length($GOT))) ;
        last if $status == Z_STREAM_END or $status != Z_OK ;
    }
     
    cmp_ok $status, '==', Z_STREAM_END ;
    is $GOT, $hello ;

}

title 'Looping Append test with substr output - substr the complete string';
foreach (1 .. 2)
{

    my $hello = "I am a HAL 9000 computer" ;
    my @hello = split('', $hello) ;
    my ($err, $x, $X, $status); 
 
    ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1,
                                            -AppendOutput => 1 ) );
    ok $x ;
    cmp_ok $err, '==', Z_OK ;
 
    $X = "" ;
    my $Answer = '';
    foreach (@hello)
    {
        $status = $x->deflate($_, substr($Answer, 0)) ;
        last unless $status == Z_OK ;
    
    }
     
    cmp_ok $status, '==', Z_OK ;
    
    cmp_ok  $x->flush(substr($Answer, 0)), '==', Z_OK ;
     
    my @Answer = split('', $Answer) ;
     
    my $k;
    ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
    ok $k ;
    cmp_ok $err, '==', Z_OK ;
 
    my $GOT = '';
    my $Z;
    $Z = 1 ;#x 2000 ;
    foreach (@Answer)
    {
        $status = $k->inflate($_, substr($GOT, 0)) ;
        last if $status == Z_STREAM_END or $status != Z_OK ;
    }
     
    cmp_ok $status, '==', Z_STREAM_END ;
    is $GOT, $hello ;
}