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