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