The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
BEGIN {
    if ($ENV{PERL_CORE}) {
	chdir 't' if -d 't';
    #@INC = ("../lib", "lib/compress");
	@INC = ("../lib");
    }
}

use lib 't';
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 };


    my $count = 0 ;
    if ($] < 5.005) {
        $count = 103 ;
    }
    elsif ($] >= 5.006) {
        $count = 689 ;
    }
    else {
        $count = 131 ;
    }

    plan tests => $count + $extra;

    use_ok('Compress::Raw::Lzma') ;
}

sub title
{
    #diag "" ;
    ok 1, $_[0] ;
    #diag "" ;
}

sub mkErr
{
    my $string = shift ;
    my ($dummy, $file, $line) = caller ;
    -- $line ;

    $string = quotemeta $string;
    $file = quotemeta($file);

    #return "/$string\\s+at $file line $line/" if $] >= 5.006 ;
    return "/$string\\s+at /" ;
}

sub mkEvalErr
{
    my $string = shift ;

    return "/$string\\s+at \\(eval /" if $] > 5.006 ;
    return "/$string\\s+at /" ;
}


sub doit
{
    my $compress_class = shift;
    my $uncompress_class = shift;

    title  "$compress_class and $uncompress_class";

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

    my $len   = length $hello ;

    if (0)
    {
        title "Error Cases" ;

        eval { $compress_class->new(1,2,3,4,5,6) };
        like $@,  mkErr "Usage: Compress::Raw::Lzma::lzma_alone_encoder(class, appendOut=1)";

    }


    if (1)
    {

        title  "lzma - small buffer";
        # ==============================

        my $hello = "I am a HAL 9000 computer" ;
        my @hello = split('', $hello) ;
        my ($err, $x, $X, $status); 
     
        ($x, $err) = $compress_class->new();
        isa_ok $x, "Compress::Raw::Lzma::Encoder";
        cmp_ok $err, '==', LZMA_OK, "status is LZMA_OK" ;
     
        is $x->uncompressedBytes(), 0, "uncompressedBytes() == 0" ;
        is $x->compressedBytes(), 0, "compressedBytes() == 0" ;

        $X = "" ;
        my $Answer = '';
        foreach (@hello)
        {
            $status = $x->code($_, $X) ;
            last unless $status == LZMA_OK ;
        
            $Answer .= $X ;
        }
         
        cmp_ok $status, '==', LZMA_OK, "code returned LZMA_OK" ;
        
        cmp_ok  $x->flush($X), '==', LZMA_STREAM_END, "flush returned LZMA_OK" ;
        $Answer .= $X ;
         
        is $x->uncompressedBytes(), length $hello, "uncompressedBytes ok" ;
        is $x->compressedBytes(), length $Answer, "compressedBytes ok" ;
         
        cmp_ok $x->flush($X), '==', LZMA_STREAM_END, "flush returned LZMA_STREAM_END";
        $Answer .= $X ;

        #open F, ">/tmp/xx1"; print F $Answer ; close F;
        my @Answer = split('', $Answer) ;
         
        my $k;
        ok(($k, $err) = $uncompress_class->new(AppendOutput => 0,
                                               ConsumeInput => 0));
        isa_ok $k, "Compress::Raw::Lzma::Decoder" ;
        cmp_ok $err, '==', LZMA_OK, "status is LZMA_OK" 
            or diag "GOT $err\n";
     
        is $k->compressedBytes(), 0, "compressedBytes() == 0" ;
        is $k->uncompressedBytes(), 0, "uncompressedBytes() == 0" ;
        my $GOT = '';
        my $Z;
        $Z = 1 ;#x 2000 ;
        foreach (@Answer)
        {
            $status = $k->code($_, $Z) ;
            $GOT .= $Z ;
            last if $status == LZMA_STREAM_END or $status != LZMA_OK ;
         
        }
         
        cmp_ok $status, '==', LZMA_STREAM_END, "Got LZMA_STREAM_END" ;
        is $GOT, $hello, "uncompressed data matches ok" ;
        is $k->compressedBytes(), length $Answer, "compressedBytes ok" ;
        is $k->uncompressedBytes(), length $hello , "uncompressedBytes ok";

    }


    if (1)
    {
        # bzdeflate/bzinflate - small buffer with a number
        # ==============================

        my $hello = 6529 ;
     
        ok  my ($x, $err) = $compress_class->new(AppendOutput => 1) ;
        ok $x ;
        cmp_ok $err, '==', LZMA_OK ;
     
        my $status;
        my $Answer = '';
         
        cmp_ok $x->code($hello, $Answer), '==', LZMA_OK ;
        
        cmp_ok $x->flush($Answer), '==', LZMA_STREAM_END, "flush returned LZMA_STREAM_END";
         
        my @Answer = split('', $Answer) ;
         
        my $k;
        ok(($k, $err) = $uncompress_class->new(AppendOutput => 1,
                                                         ConsumeInput => 0) );
        ok $k ;
        cmp_ok $err, '==', LZMA_OK ;
         
        #my $GOT = '';
        my $GOT ;
        foreach (@Answer)
        {
            $status = $k->code($_, $GOT) ;
            last if $status == LZMA_STREAM_END or $status != LZMA_OK ;
         
        }
         
        cmp_ok $status, '==', LZMA_STREAM_END ;
        is $GOT, $hello ;

    }

    if(1)
    {

    # bzdeflate/bzinflate options - AppendOutput
    # ================================

        # AppendOutput
        # CRC

        my $hello = "I am a HAL 9000 computer" ;
        my @hello = split('', $hello) ;
         
        ok  my ($x, $err) = $compress_class->new(AppendOutput => 1), "  Created lzma object" ;
        ok $x ;
        cmp_ok $err, '==', LZMA_OK, "Status is LZMA_OK" ;
         
        my $status;
        my $X;
        foreach (@hello)
        {
            $status = $x->code($_, $X) ;
            last unless $status == LZMA_OK ;
        }
         
        cmp_ok $status, '==', LZMA_OK ;
         
        cmp_ok $x->flush($X), '==', LZMA_STREAM_END ;
         
         
        my @Answer = split('', $X) ;
         
        my $k;
        ok(($k, $err) = $uncompress_class->new( {-AppendOutput =>1}));
        ok $k ;
        cmp_ok $err, '==', LZMA_OK ;
         
        my $Z;
        foreach (@Answer)
        {
            $status = $k->code($_, $Z) ;
            last if $status == LZMA_STREAM_END or $status != LZMA_OK ;
         
        }
         
        cmp_ok $status, '==', LZMA_STREAM_END ;
        is $Z, $hello ;
    }

     
    if(1)
    {

        title "lzma - larger buffer";
        # ==============================

        # generate a long random string
        my $contents = '' ;
        foreach (1 .. 50000)
          { $contents .= chr int rand 255 }
        
        
        ok my ($x, $err) = $compress_class->new(AppendOutput => 0) ;
        ok $x, "  lzma object ok" ;
        cmp_ok $err, '==', LZMA_OK,"  status is LZMA_OK" ;
         
        is $x->uncompressedBytes(), 0, "  uncompressedBytes() == 0" ;
        is $x->compressedBytes(), 0, "  compressedBytes() == 0" ;

        my (%X, $Y, %Z, $X, $Z);
        #cmp_ok $x->code($contents, $X{key}), '==', LZMA_OK ;
        my $status =  $x->code($contents, $X);
        #cmp_ok $x->code($contents, $X), '==', LZMA_OK, "  compressed ok" ;
        cmp_ok $status, '==', LZMA_OK, "  compressed ok" ;
        
        #$Y = $X{key} ;
        $Y = $X ;
         
         
        #cmp_ok $x->flush($X{key}), '==', LZMA_OK ;
        #$Y .= $X{key} ;
        cmp_ok $x->flush($X), '==', LZMA_STREAM_END ;
        $Y .= $X ;
         
         
     
        my $keep = $Y ;

        my $k;
        ok(($k, $err) = $uncompress_class->new(AppendOutput => 0,
                                                         ConsumeInput => 0) );
        ok $k ;
        cmp_ok $err, '==', LZMA_OK ;
         
        #cmp_ok $k->code($Y, $Z{key}), '==', LZMA_STREAM_END ;
        #ok $contents eq $Z{key} ;
        cmp_ok $k->code($Y, $Z), '==', LZMA_STREAM_END ;
        ok $contents eq $Z ;

        # redo deflate with AppendOutput

        ok (($k, $err) = $uncompress_class->new(AppendOutput => 1,
                                                          ConsumeInput => 0)) ;
        ok $k ;
        cmp_ok $err, '==', LZMA_OK ;
        
        my $s ; 
        my $out ;
        my @bits = split('', $keep) ;
        foreach my $bit (@bits) {
            $s = $k->code($bit, $out) ;
        }
        
        cmp_ok $s, '==', LZMA_STREAM_END ;
         
        ok $contents eq $out ;


    }


    for my $consume ( 0 .. 1)
    {
        title "lzma - check remaining buffer after LZMA_STREAM_END, Consume $consume";

        ok my $x = $compress_class->new(AppendOutput => 0) ;
     
        my ($X, $Y, $Z);
        cmp_ok $x->code($hello, $X), '==', LZMA_OK;
        cmp_ok $x->flush($Y), '==', LZMA_STREAM_END;
        $X .= $Y ;
     
        ok my $k = $uncompress_class->new(AppendOutput => 0,
                                                    ConsumeInput => $consume) ;
     
        my $first = substr($X, 0, 2) ;
        my $remember_first = $first ;
        my $last  = substr($X, 2) ;
        cmp_ok $k->code($first, $Z), '==', LZMA_OK;
        if ($consume) {
            ok $first eq "" ;
        }
        else {
            ok $first eq $remember_first ;
        }

        my $T ;
        $last .= "appendage" ;
        my $remember_last = $last ;
        cmp_ok $k->code($last, $T),  '==', LZMA_STREAM_END;
        is $hello, $Z . $T  ;
        if ($consume) {
            is $last, "appendage" ;
        }
        else {
            is $last, $remember_last ;
        }

    }


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

        ok my $k = $uncompress_class->new(AppendOutput => 0,
                                                    ConsumeInput => 1) ;
         
        my $Z; 
        eval { $k->code("abc", $Z) ; };
        like $@, mkErr("Compress::Raw::Lzma::Decoder::code input parameter cannot be read-only when ConsumeInput is specified");

    }

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

        title 'test lzma with a substr';

        my $contents = '' ;
        foreach (1 .. 5000)
          { $contents .= chr int rand 255 }
        ok  my $x = $compress_class->new(AppendOutput => 1) ;
         
        my $X ;
        my $status = $x->code(substr($contents,0), $X);
        cmp_ok $status, '==', LZMA_OK ;
        
        cmp_ok $x->flush($X), '==', LZMA_STREAM_END  ;
         
        my $append = "Appended" ;
        $X .= $append ;
         
        ok my $k = $uncompress_class->new(AppendOutput => 1,
                                                    ConsumeInput => 1) ;
         
        my $Z; 
        my $keep = $X ;
        $status = $k->code(substr($X, 0), $Z) ;
         
        cmp_ok $status, '==', LZMA_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) = $compress_class->new(AppendOutput => 0) );
        ok $x ;
        cmp_ok $err, '==', LZMA_OK ;
     
        $X = "" ;
        my $Answer = '';
        foreach (@hello)
        {
            $status = $x->code($_, $X) ;
            last unless $status == LZMA_OK ;
        
            $Answer .= $X ;
        }
         
        cmp_ok $status, '==', LZMA_OK ;
        
        cmp_ok  $x->flush($X), '==', LZMA_STREAM_END ;
        $Answer .= $X ;
         
        my @Answer = split('', $Answer) ;
         
        my $k;
        ok(($k, $err) = $uncompress_class->new(AppendOutput => 1,
                                                        ConsumeInput => 0) );
        ok $k ;
        cmp_ok $err, '==', LZMA_OK ;
     
        my $GOT ;
        my $Z;
        $Z = 1 ;#x 2000 ;
        foreach (@Answer)
        {
            $status = $k->code($_, $GOT) ;
            last if $status == LZMA_STREAM_END or $status != LZMA_OK ;
        }
         
        cmp_ok $status, '==', LZMA_STREAM_END ;
        is $GOT, $hello ;

    }

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

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

        my($X, $Z);

        ok my $x = $compress_class->new(AppendOutput => 1);

        cmp_ok $x->code($data, $X), '==',  LZMA_OK ;

        cmp_ok $x->flush($X), '==', LZMA_STREAM_END ;
         
        my $append = "Appended" ;
        $X .= $append ;
        my $keep = $X ;
         
        ok my $k = $uncompress_class->new( AppendOutput => 1,
                                                    ConsumeInput => 1);
         
    #    cmp_ok $k->code(substr($X, 0, -1), $Z), '==', LZMA_STREAM_END ; ;
        cmp_ok $k->code(substr($X, 0), $Z), '==', LZMA_STREAM_END ; ;
         
        ok $hello eq $Z ;
        is $X, $append;
        
        $X = $keep ;
        $Z = '';
        ok $k = $uncompress_class->new( AppendOutput => 1,
                                                    ConsumeInput => 0);
         
        cmp_ok $k->code(substr($X, 0, -1), $Z), '==', LZMA_STREAM_END ; ;
        #cmp_ok $k->code(substr($X, 0), $Z), '==', LZMA_STREAM_END ; ;
         
        ok $hello eq $Z ;
        is $X, $keep;
        
    }

    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) = $compress_class->new (AppendOutput => 1) );
        ok $x ;
        cmp_ok $err, '==', LZMA_OK ;
     
        $X = "" ;
        my $Answer = '';
        foreach (@hello)
        {
            $status = $x->code($_, substr($Answer, length($Answer))) ;
            last unless $status == LZMA_OK ;
        
        }
         
        cmp_ok $status, '==', LZMA_OK ;
        
        cmp_ok  $x->flush(substr($Answer, length($Answer))), '==', LZMA_STREAM_END ;
         
        my @Answer = split('', $Answer) ;
         
        my $k;
        ok(($k, $err) = $uncompress_class->new(AppendOutput => 1,
                                                        ConsumeInput => 0) );
        ok $k ;
        cmp_ok $err, '==', LZMA_OK ;
     
        my $GOT = '';
        my $Z;
        $Z = 1 ;#x 2000 ;
        foreach (@Answer)
        {
            $status = $k->code($_, substr($GOT, length($GOT))) ;
            last if $status == LZMA_STREAM_END or $status != LZMA_OK ;
        }
         
        cmp_ok $status, '==', LZMA_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) = $compress_class->new (AppendOutput => 1) );
        ok $x ;
        cmp_ok $err, '==', LZMA_OK ;
     
        $X = "" ;
        my $Answer = '';
        foreach (@hello)
        {
            $status = $x->code($_, substr($Answer, 0)) ;
            last unless $status == LZMA_OK ;
        
        }
         
        cmp_ok $status, '==', LZMA_OK ;
        
        cmp_ok  $x->flush(substr($Answer, 0)), '==', LZMA_STREAM_END ;
         
        my @Answer = split('', $Answer) ;
         
        # append, consume, limit
        my $k;
        ok(($k, $err) = $uncompress_class->new(AppendOutput => 1,
                                                        ConsumeInput => 0) );
        ok $k ;
        cmp_ok $err, '==', LZMA_OK ;
     
        my $GOT = '';
        my $Z;
        $Z = 1 ;#x 2000 ;
        foreach (@Answer)
        {
            $status = $k->code($_, substr($GOT, 0)) ;
            last if $status == LZMA_STREAM_END or $status != LZMA_OK ;
        }
         
        cmp_ok $status, '==', LZMA_STREAM_END ;
        is $GOT, $hello ;
    }

}

for my $class ([qw(AloneEncoder AloneDecoder)], 
               [qw(StreamEncoder StreamDecoder)], 
               [qw(RawEncoder RawDecoder)] ,
               [qw(EasyEncoder AutoDecoder)] ,
           )
{
    my $c = "Compress::Raw::Lzma::" . $class->[0];
    my $u = "Compress::Raw::Lzma::" . $class->[1];
    doit $c, $u;
}