1 files changed, 130 insertions, 0 deletions
diff --git a/ext/IO-Compress/t/101truncate-rawdeflate.t b/ext/IO-Compress/t/101truncate-rawdeflate.t
new file mode 100644
index 0000000000..d81b54a7b3
--- /dev/null
+++ b/ext/IO-Compress/t/101truncate-rawdeflate.t
@@ -0,0 +1,130 @@
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+	chdir 't' if -d 't';
+	@INC = ("../lib", "lib/compress");
+    }
+}
+
+use lib qw(t t/compress);
+use strict;
+use warnings;
+
+use Test::More ;
+
+BEGIN {
+    # use Test::NoWarnings, if available
+    my $extra = 0 ;
+    $extra = 1
+        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
+
+    plan tests => 625 + $extra;
+
+};
+
+
+use IO::Compress::RawDeflate   qw($RawDeflateError) ;
+use IO::Uncompress::RawInflate qw($RawInflateError) ;
+
+#sub identify
+#{
+#    'IO::Compress::RawDeflate';
+#}
+#
+#require "truncate.pl" ;
+#run();
+
+use CompTestUtils;
+
+my $hello = <<EOM ;
+hello world
+this is a test
+some more stuff on this line
+ad finally...
+EOM
+
+my $blocksize = 10 ;
+
+
+foreach my $CompressClass ( 'IO::Compress::RawDeflate')
+{
+    my $UncompressClass = getInverse($CompressClass);
+    my $Error = getErrorRef($UncompressClass);
+
+    my $compressed ;
+        ok( my $x = new IO::Compress::RawDeflate \$compressed);
+        ok $x->write($hello) ;
+        ok $x->close ;
+
+                           
+    my $cc = $compressed ;
+
+    my $gz ;
+    ok($gz = new $UncompressClass(\$cc,
+                                  -Transparent => 0))
+            or diag "$$Error\n";
+    my $un;
+    is $gz->read($un, length($hello)), length($hello);
+    ok $gz->close();
+    is $un, $hello ;
+    
+    for my $trans (0 .. 1)
+    {
+        title "Testing $CompressClass, Transparent = $trans";
+
+        my $info = $gz->getHeaderInfo() ;
+        my $header_size = $info->{HeaderLength};
+        my $trailer_size = $info->{TrailerLength};
+        ok 1, "Compressed size is " . length($compressed) ;
+        ok 1, "Header size is $header_size" ;
+        ok 1, "Trailer size is $trailer_size" ;
+
+        
+        title "Compressed Data Truncation";
+        foreach my $i (0 .. $blocksize)
+        {
+        
+            my $lex = new LexFile my $name ;
+        
+            ok 1, "Length $i" ;
+            my $part = substr($compressed, 0, $i);
+            writeFile($name, $part);
+            my $gz = new $UncompressClass $name,
+                                       -BlockSize   => $blocksize,
+                                       -Transparent => $trans;
+            if ($trans) {
+                ok $gz;
+                ok ! $gz->error() ;
+                my $buff = '';
+                is $gz->read($buff, length $part), length $part ;
+                is $buff, $part ;
+                ok $gz->eof() ;
+                $gz->close();
+            }
+            else {
+                ok !$gz;
+            }
+        }
+
+        foreach my $i ($blocksize+1 .. length($compressed)-1)
+        {
+        
+            my $lex = new LexFile my $name ;
+        
+            ok 1, "Length $i" ;
+            my $part = substr($compressed, 0, $i);
+            writeFile($name, $part);
+            ok my $gz = new $UncompressClass $name,
+                                             -BlockSize   => $blocksize,
+                                             -Transparent => $trans;
+            my $un ;
+            my $status = 1 ;
+            $status = $gz->read($un) while $status > 0 ;
+            ok $status < 0 ;
+            ok $gz->eof() ;
+            ok $gz->error() ;
+            $gz->close();
+        }
+    }
+    
+}
+