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

plan tests => 48 + $extra ;

}

sub run
{
    my $CompressClass   = identify();
    my $AnyClass        = getClass();
    my $UncompressClass = getInverse($CompressClass);
    my $Error           = getErrorRef($CompressClass);
    my $UnError         = getErrorRef($UncompressClass);

my @anyUnLz = ();
    @anyUnLz = (UnLzma => 1 ) if $CompressClass =~ /lzma/i ;

my $AnyConstruct = "IO::Uncompress::${AnyClass}" ;
    no strict 'refs';
    my $AnyError = \${ "IO::Uncompress::${AnyClass}::${AnyClass}Error" };

for my $trans ( 0, 1 )
    {
        for my $file ( 0, 1 )
        {
            title "$AnyClass(Transparent => $trans, File=>$file) with $CompressClass" ;
            my $string = "some text" x 100 ;

my $buffer ;
            my $x = new $CompressClass(\$buffer) ;
            ok $x, "  create $CompressClass object" ;
            ok $x->write($string), "  write to object" ;
            ok $x->close, "  close ok" ;

my $lex = new LexFile my $output;
            my $input ;

if ($file) {
                writeFile($output, $buffer);
                $input = $output;
            }
            else {
                $input = \$buffer;
            }

{
                my $unc = new $AnyConstruct $input, Transparent => $trans,
                                           RawInflate => 1,
                                           @anyUnLz,
                                           Append => 1  ;

ok $unc, "  Created $AnyClass object" 
                    or print "# $$AnyError\n";
                my $uncomp ;
                1 while  $unc->read($uncomp) > 0 ;
                #ok $unc->read($uncomp) > 0 
                #    or print "# $$AnyError\n";
                my $y;
                is $unc->read($y, 1), 0, "  at eof" ;
                ok $unc->eof(), "  at eof" ;
                #ok $unc->type eq $Type;

is $uncomp, $string, "  expected output" ;
            }

ok $unc, "  Created $AnyClass object" 
                    or print "# $$AnyError\n";
                my $uncomp ;
                1 while  $unc->read($uncomp, 100) > 0 ;
                #ok $unc->read($uncomp) > 0 
                #    or print "# $$AnyError\n";
                my $y;
                is $unc->read($y, 1), 0, "  at eof" ;
                ok $unc->eof(), "  at eof" ;
                #ok $unc->type eq $Type;

is $uncomp, $string, "  expected output" ;
            }
        }
    }
}