xref: /openbsd-src/gnu/usr.bin/perl/cpan/IO-Compress/t/101truncate-rawdeflate.t (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9) 
1BEGIN {
2    if ($ENV{PERL_CORE}) {
3	chdir 't' if -d 't';
4	@INC = ("../lib", "lib/compress");
5    }
6}
7
8use lib qw(t t/compress);
9use strict;
10use warnings;
11
12use Test::More ;
13
14use Compress::Raw::Zlib;
15
16BEGIN {
17    plan skip_all => "Lengthy Tests Disabled\n" .
18                     "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite"
19        unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST};
20
21    # use Test::NoWarnings, if available
22    my $extra = 0 ;
23    $extra = 1
24        if eval { require Test::NoWarnings ;  Test::NoWarnings->import; 1 };
25
26    my $tests = Compress::Raw::Zlib::is_zlibng() ? 615 : 625;
27    plan tests => $tests + $extra;
28};
29
30
31use IO::Compress::RawDeflate   qw($RawDeflateError) ;
32use IO::Uncompress::RawInflate qw($RawInflateError) ;
33
34#sub identify
35#{
36#    'IO::Compress::RawDeflate';
37#}
38#
39#require "truncate.pl" ;
40#run();
41
42use CompTestUtils;
43
44my $hello = <<EOM ;
45hello world
46this is a test
47some more stuff on this line
48ad finally...
49EOM
50
51my $blocksize = 10 ;
52
53
54foreach my $CompressClass ( 'IO::Compress::RawDeflate')
55{
56    my $UncompressClass = getInverse($CompressClass);
57    my $Error = getErrorRef($UncompressClass);
58
59    my $compressed ;
60        ok( my $x = IO::Compress::RawDeflate->new( \$compressed ) );
61        ok $x->write($hello) ;
62        ok $x->close ;
63
64
65    my $cc = $compressed ;
66
67    my $gz ;
68    ok($gz = $UncompressClass->can('new')->( $UncompressClass, \$cc,
69                                  -Transparent => 0))
70            or diag "$$Error\n";
71    my $un;
72    is $gz->read($un, length($hello)), length($hello);
73    ok $gz->close();
74    is $un, $hello ;
75
76    for my $trans (0 .. 1)
77    {
78        title "Testing $CompressClass, Transparent = $trans";
79
80        my $info = $gz->getHeaderInfo() ;
81        my $header_size = $info->{HeaderLength};
82        my $trailer_size = $info->{TrailerLength};
83        ok 1, "Compressed size is " . length($compressed) ;
84        ok 1, "Header size is $header_size" ;
85        ok 1, "Trailer size is $trailer_size" ;
86
87
88        title "Compressed Data Truncation";
89        foreach my $i (0 .. $blocksize)
90        {
91
92            my $lex = LexFile->new( my $name );
93
94            ok 1, "Length $i" ;
95            my $part = substr($compressed, 0, $i);
96            writeFile($name, $part);
97            my $gz = $UncompressClass->can('new')->( $UncompressClass, $name,
98                                       -BlockSize   => $blocksize,
99                                       -Transparent => $trans );
100            if ($trans) {
101                ok $gz;
102                ok ! $gz->error() ;
103                my $buff = '';
104                is $gz->read($buff, length $part), length $part ;
105                is $buff, $part ;
106                ok $gz->eof() ;
107                $gz->close();
108            }
109            else {
110                ok !$gz;
111            }
112        }
113
114        foreach my $i ($blocksize+1 .. length($compressed)-1)
115        {
116
117            my $lex = LexFile->new( my $name );
118
119            ok 1, "Length $i" ;
120            my $part = substr($compressed, 0, $i);
121            writeFile($name, $part);
122            ok my $gz = $UncompressClass->can('new')->( $UncompressClass, $name,
123                                             -BlockSize   => $blocksize,
124                                             -Transparent => $trans );
125            my $un ;
126            my $status = 1 ;
127            $status = $gz->read($un) while $status > 0 ;
128            ok $status < 0 ;
129            ok $gz->eof() ;
130            ok $gz->error() ;
131            $gz->close();
132        }
133    }
134
135}
136