xref: /openbsd-src/gnu/usr.bin/perl/cpan/IO-Compress/t/compress/truncate.pl (revision d13be5d47e4149db2549a9828e244d59dbc43f15) 
1
2use lib 't';
3use strict;
4use warnings;
5use bytes;
6
7use Test::More ;
8use CompTestUtils;
9
10sub run
11{
12    my $CompressClass   = identify();
13    my $UncompressClass = getInverse($CompressClass);
14    my $Error           = getErrorRef($CompressClass);
15    my $UnError         = getErrorRef($UncompressClass);
16
17#    my $hello = <<EOM ;
18#hello world
19#this is a test
20#some more stuff on this line
21#and finally...
22#EOM
23
24    # ASCII hex equivalent of the text above. This makes the test
25    # harness behave identically on an EBCDIC platform.
26    my $hello =
27      "\x68\x65\x6c\x6c\x6f\x20\x77\x6f\x72\x6c\x64\x0a\x74\x68\x69\x73" .
28      "\x20\x69\x73\x20\x61\x20\x74\x65\x73\x74\x0a\x73\x6f\x6d\x65\x20" .
29      "\x6d\x6f\x72\x65\x20\x73\x74\x75\x66\x66\x20\x6f\x6e\x20\x74\x68" .
30      "\x69\x73\x20\x6c\x69\x6e\x65\x0a\x61\x6e\x64\x20\x66\x69\x6e\x61" .
31      "\x6c\x6c\x79\x2e\x2e\x2e\x0a" ;
32
33    my $blocksize = 10 ;
34
35
36    my ($info, $compressed) = mkComplete($CompressClass, $hello);
37
38    my $header_size  = $info->{HeaderLength};
39    my $trailer_size = $info->{TrailerLength};
40    my $fingerprint_size = $info->{FingerprintLength};
41    ok 1, "Compressed size is " . length($compressed) ;
42    ok 1, "Fingerprint size is $fingerprint_size" ;
43    ok 1, "Header size is $header_size" ;
44    ok 1, "Trailer size is $trailer_size" ;
45
46    for my $trans ( 0 .. 1)
47    {
48        title "Truncating $CompressClass, Transparent $trans";
49
50
51        foreach my $i (1 .. $fingerprint_size-1)
52        {
53            my $lex = new LexFile my $name ;
54
55            title "Fingerprint Truncation - length $i, Transparent $trans";
56
57            my $part = substr($compressed, 0, $i);
58            writeFile($name, $part);
59
60            my $gz = new $UncompressClass $name,
61                                          -BlockSize   => $blocksize,
62                                          -Transparent => $trans;
63            if ($trans) {
64                ok $gz;
65                ok ! $gz->error() ;
66                my $buff ;
67                is $gz->read($buff, 5000), length($part) ;
68                ok $buff eq $part ;
69                ok $gz->eof() ;
70                $gz->close();
71            }
72            else {
73                ok !$gz;
74            }
75
76        }
77
78        #
79        # Any header corruption past the fingerprint is considered catastrophic
80        # so even if Transparent is set, it should still fail
81        #
82        foreach my $i ($fingerprint_size .. $header_size -1)
83        {
84            my $lex = new LexFile my $name ;
85
86            title "Header Truncation - length $i, Transparent $trans";
87
88            my $part = substr($compressed, 0, $i);
89            writeFile($name, $part);
90            ok ! defined new $UncompressClass $name,
91                                              -BlockSize   => $blocksize,
92                                              -Transparent => $trans;
93            #ok $gz->eof() ;
94        }
95
96
97        foreach my $i ($header_size .. length($compressed) - 1 - $trailer_size)
98        {
99            next if $i == 0 ;
100
101            my $lex = new LexFile my $name ;
102
103            title "Compressed Data Truncation - length $i, Transparent $trans";
104
105            my $part = substr($compressed, 0, $i);
106            writeFile($name, $part);
107            ok my $gz = new $UncompressClass $name,
108                                             -Strict      => 1,
109                                             -BlockSize   => $blocksize,
110                                             -Transparent => $trans
111                 or diag $$UnError;
112
113            my $un ;
114            my $status = 1 ;
115            $status = $gz->read($un) while $status > 0 ;
116            cmp_ok $status, "<", 0 ;
117            ok $gz->error() ;
118            ok $gz->eof() ;
119            $gz->close();
120        }
121
122        # RawDeflate does not have a trailer
123        next if $CompressClass eq 'IO::Compress::RawDeflate' ;
124
125        title "Compressed Trailer Truncation";
126        foreach my $i (length($compressed) - $trailer_size .. length($compressed) -1 )
127        {
128            foreach my $lax (0, 1)
129            {
130                my $lex = new LexFile my $name ;
131
132                ok 1, "Compressed Trailer Truncation - Length $i, Lax $lax, Transparent $trans" ;
133                my $part = substr($compressed, 0, $i);
134                writeFile($name, $part);
135                ok my $gz = new $UncompressClass $name,
136                                                 -BlockSize   => $blocksize,
137                                                 -Strict      => !$lax,
138                                                 -Append      => 1,
139                                                 -Transparent => $trans;
140                my $un = '';
141                my $status = 1 ;
142                $status = $gz->read($un) while $status > 0 ;
143
144                if ($lax)
145                {
146                    is $un, $hello;
147                    is $status, 0
148                        or diag "Status $status Error is " . $gz->error() ;
149                    ok $gz->eof()
150                        or diag "Status $status Error is " . $gz->error() ;
151                    ok ! $gz->error() ;
152                }
153                else
154                {
155                    cmp_ok $status, "<", 0
156                        or diag "Status $status Error is " . $gz->error() ;
157                    ok $gz->eof()
158                        or diag "Status $status Error is " . $gz->error() ;
159                    ok $gz->error() ;
160                }
161
162                $gz->close();
163            }
164        }
165    }
166}
167
1681;
169
170