1
2use lib 't';
3use strict;
4use warnings;
5use bytes;
6
7use Test::More ;
8use CompTestUtils;
9
10our ($extra);
11
12BEGIN {
13    plan skip_all => "Lengthy Tests Disabled\n" .
14                     "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite"
15        unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST};
16
17    # use Test::NoWarnings, if available
18    $extra = 0 ;
19    $extra = 1
20        if eval { require Test::NoWarnings ;  Test::NoWarnings->import; 1 };
21
22}
23
24sub run
25{
26
27    my $CompressClass   = identify();
28    my $UncompressClass = getInverse($CompressClass);
29    my $Error           = getErrorRef($CompressClass);
30    my $UnError         = getErrorRef($UncompressClass);
31
32
33
34    my $hello = <<EOM ;
35hello world
36this is a test
37some more stuff on this line
38ad finally...
39EOM
40
41    print "#\n# Testing $UncompressClass\n#\n";
42
43    my $compressed = mkComplete($CompressClass, $hello);
44    my $cc = $compressed ;
45
46    plan tests => (length($compressed) * 6 * 7) + 1 + $extra ;
47
48    is anyUncompress(\$cc), $hello ;
49
50    for my $blocksize (1, 2, 13)
51    {
52        for my $i (0 .. length($compressed) - 1)
53        {
54            for my $useBuf (0 .. 1)
55            {
56                print "#\n# BlockSize $blocksize, Length $i, Buffer $useBuf\n#\n" ;
57                my $lex = LexFile->new( my $name );
58
59                my $prime = substr($compressed, 0, $i);
60                my $rest = substr($compressed, $i);
61
62                my $start  ;
63                if ($useBuf) {
64                    $start = \$rest ;
65                }
66                else {
67                    $start = $name ;
68                    writeFile($name, $rest);
69                }
70
71                #my $gz = $UncompressClass->can('new')->( $UncompressClass, $name,
72                my $gz = $UncompressClass->can('new')->( $UncompressClass, $start,
73                                              -Append      => 1,
74                                              -BlockSize   => $blocksize,
75                                              -Prime       => $prime,
76                                              -Transparent => 0
77                                             );
78                ok $gz;
79                ok ! $gz->error() ;
80                my $un ;
81                my $status = 1 ;
82                $status = $gz->read($un) while $status > 0 ;
83                is $status, 0 ;
84                ok ! $gz->error()
85                    or print "Error is '" . $gz->error() . "'\n";
86                is $un, $hello ;
87                ok $gz->eof() ;
88                ok $gz->close() ;
89            }
90        }
91    }
92}
93
941;
95