Move IO::Compress from ext/ to cpan/
[p5sagit/p5-mst-13.2.git] / cpan / IO-Compress / t / 101truncate-rawdeflate.t
CommitLineData
25f0751f 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
14BEGIN {
15 # use Test::NoWarnings, if available
16 my $extra = 0 ;
17 $extra = 1
18 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
19
20 plan tests => 625 + $extra;
21
22};
23
24
25use IO::Compress::RawDeflate qw($RawDeflateError) ;
26use IO::Uncompress::RawInflate qw($RawInflateError) ;
27
28#sub identify
29#{
30# 'IO::Compress::RawDeflate';
31#}
32#
33#require "truncate.pl" ;
34#run();
35
36use CompTestUtils;
37
38my $hello = <<EOM ;
39hello world
40this is a test
41some more stuff on this line
42ad finally...
43EOM
44
45my $blocksize = 10 ;
46
47
48foreach my $CompressClass ( 'IO::Compress::RawDeflate')
49{
50 my $UncompressClass = getInverse($CompressClass);
51 my $Error = getErrorRef($UncompressClass);
52
53 my $compressed ;
54 ok( my $x = new IO::Compress::RawDeflate \$compressed);
55 ok $x->write($hello) ;
56 ok $x->close ;
57
58
59 my $cc = $compressed ;
60
61 my $gz ;
62 ok($gz = new $UncompressClass(\$cc,
63 -Transparent => 0))
64 or diag "$$Error\n";
65 my $un;
319fab50 66 is $gz->read($un, length($hello)), length($hello);
25f0751f 67 ok $gz->close();
319fab50 68 is $un, $hello ;
25f0751f 69
70 for my $trans (0 .. 1)
71 {
72 title "Testing $CompressClass, Transparent = $trans";
73
74 my $info = $gz->getHeaderInfo() ;
75 my $header_size = $info->{HeaderLength};
76 my $trailer_size = $info->{TrailerLength};
77 ok 1, "Compressed size is " . length($compressed) ;
78 ok 1, "Header size is $header_size" ;
79 ok 1, "Trailer size is $trailer_size" ;
80
81
82 title "Compressed Data Truncation";
83 foreach my $i (0 .. $blocksize)
84 {
85
86 my $lex = new LexFile my $name ;
87
88 ok 1, "Length $i" ;
89 my $part = substr($compressed, 0, $i);
90 writeFile($name, $part);
91 my $gz = new $UncompressClass $name,
92 -BlockSize => $blocksize,
93 -Transparent => $trans;
94 if ($trans) {
95 ok $gz;
96 ok ! $gz->error() ;
97 my $buff = '';
319fab50 98 is $gz->read($buff, length $part), length $part ;
25f0751f 99 is $buff, $part ;
100 ok $gz->eof() ;
101 $gz->close();
102 }
103 else {
104 ok !$gz;
105 }
106 }
107
108 foreach my $i ($blocksize+1 .. length($compressed)-1)
109 {
110
111 my $lex = new LexFile my $name ;
112
113 ok 1, "Length $i" ;
114 my $part = substr($compressed, 0, $i);
115 writeFile($name, $part);
116 ok my $gz = new $UncompressClass $name,
117 -BlockSize => $blocksize,
118 -Transparent => $trans;
119 my $un ;
120 my $status = 1 ;
121 $status = $gz->read($un) while $status > 0 ;
122 ok $status < 0 ;
123 ok $gz->eof() ;
124 ok $gz->error() ;
125 $gz->close();
126 }
127 }
128
129}
130