ext/Compress/Zlib/t/22merge.t

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = '../lib';
   5     }
   6 }
   7
   8 use lib 't';
   9 use strict;
  10 use warnings;
  11 use bytes;
  12
  13 use Test::More ;
  14 use ZlibTestUtils;
  15
  16 our ($extra);
  17 use Compress::Zlib 2 ;
  18
  19 use IO::Compress::Gzip qw($GzipError);
  20 use IO::Uncompress::Gunzip qw($GunzipError);
  21
  22 use IO::Compress::Deflate qw($DeflateError);
  23 use IO::Uncompress::Inflate qw($InflateError);
  24
  25 use IO::Compress::RawDeflate qw($RawDeflateError);
  26 use IO::Uncompress::RawInflate qw($RawInflateError);
  27
  28
  29 BEGIN
  30 {
  31     plan(skip_all => "Merge needs Zlib 1.2.1 or better - you have Zlib "
  32                 . Compress::Zlib::zlib_version())
  33         if ZLIB_VERNUM() < 0x1210 ;
  34
  35     # use Test::NoWarnings, if available
  36     $extra = 0 ;
  37     $extra = 1
  38         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  39
  40     plan tests => 490 + $extra ;
  41
  42 }
  43
  44
  45 # Check zlib_version and ZLIB_VERSION are the same.
  46 is Compress::Zlib::zlib_version, ZLIB_VERSION,
  47     "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
  48
  49 # Tests
  50 #   destination is a file that doesn't exist -- should work ok unless AnyDeflate
  51 #   destination isn't compressed at all
  52 #   destination is compressed but wrong format
  53 #   destination is corrupt - error messages should be correct
  54 #   use apend mode with old zlib - check that this is trapped
  55 #   destination is not seekable, readable, writable - test for filename & handle
  56
  57 {
  58     title "Misc error cases";
  59
  60     eval { new Compress::Zlib::InflateScan Bufsize => 0} ;
  61     like $@, mkErr("^Compress::Zlib::InflateScan::new: Bufsize must be >= 1, you specified 0"), "  catch bufsize == 0";
  62
  63     eval { Compress::Zlib::inflateScanStream::createDeflateStream(undef, Bufsize => 0) } ;
  64     like $@, mkErr("^Compress::Zlib::InflateScan::createDeflateStream: Bufsize must be >= 1, you specified 0"), "  catch bufsize == 0";
  65
  66 }
  67
  68 # output file/handle not writable
  69 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
  70 {
  71
  72     my $Error = getErrorRef($CompressClass);
  73
  74     foreach my $to_file (0,1)
  75     {
  76         if ($to_file)
  77           { title "$CompressClass - Merge to filename that isn't writable" }
  78         else
  79           { title "$CompressClass - Merge to filehandle that isn't writable" }
  80
  81         my $out_file = 'abcde.out';
  82         my $lex = new LexFile($out_file) ;
  83
  84         # create empty file
  85         open F, ">$out_file" ; print F "x"; close F;
  86         ok   -e $out_file, "  file exists" ;
  87         ok  !-z $out_file, "  and is not empty" ;
  88
  89         # make unwritable
  90         is chmod(0444, $out_file), 1, "  chmod worked" ;
  91         ok   -e $out_file, "  still exists after chmod" ;
  92
  93         SKIP:
  94         {
  95             skip "Cannot create non-writable file", 3
  96                 if -w $out_file ;
  97
  98             ok ! -w $out_file, "  chmod made file unwritable" ;
  99
 100             my $dest ;
 101             if ($to_file)
 102               { $dest = $out_file }
 103             else
 104               { $dest = new IO::File "<$out_file"  }
 105
 106             my $gz = $CompressClass->new($dest, Merge => 1) ;
 107
 108             ok ! $gz, "  Did not create $CompressClass object";
 109
 110             {
 111                 if ($to_file) {
 112                     is $$Error, "Output file '$out_file' is not writable",
 113                             "  Got non-writable filename message" ;
 114                 }
 115                 else {
 116                     is $$Error, "Output filehandle is not writable",
 117                             "  Got non-writable filehandle message" ;
 118                 }
 119             }
 120         }
 121
 122         chmod 0777, $out_file ;
 123     }
 124 }
 125
 126 # output is not compressed at all
 127 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
 128 {
 129
 130     my $Error = getErrorRef($CompressClass);
 131
 132     my $out_file = 'abcde.out';
 133     my $lex = new LexFile($out_file) ;
 134
 135     foreach my $to_file ( qw(buffer file handle ) )
 136     {
 137         title "$CompressClass to $to_file, content is not compressed";
 138
 139         my $content = "abc" x 300 ;
 140         my $buffer ;
 141         my $disp_content = defined $content ? $content : '<undef>' ;
 142         my $str_content = defined $content ? $content : '' ;
 143
 144         if ($to_file eq 'buffer')
 145         {
 146             $buffer = \$content ;
 147         }
 148         else
 149         {
 150             writeFile($out_file, $content);
 151
 152             if ($to_file eq 'handle')
 153             {
 154                 $buffer = new IO::File "+<$out_file"
 155                     or die "# Cannot open $out_file: $!";
 156             }
 157             else
 158               { $buffer = $out_file }
 159         }
 160
 161         ok ! $CompressClass->new($buffer, Merge => 1), "  constructor fails";
 162         {
 163             like $$Error, '/Cannot create InflateScan object: (Header Error|unexpected end of file)/', "  got Bad Magic" ;
 164         }
 165
 166     }
 167 }
 168
 169 # output is empty
 170 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
 171 {
 172
 173     my $Error = getErrorRef($CompressClass);
 174
 175     my $out_file = 'abcde.out';
 176     my $lex = new LexFile($out_file) ;
 177
 178     foreach my $to_file ( qw(buffer file handle ) )
 179     {
 180         title "$CompressClass to $to_file, content is empty";
 181
 182         my $content = '';
 183         my $buffer ;
 184         my $dest ;
 185
 186         if ($to_file eq 'buffer')
 187         {
 188             $dest = $buffer = \$content ;
 189         }
 190         else
 191         {
 192             writeFile($out_file, $content);
 193             $dest = $out_file;
 194
 195             if ($to_file eq 'handle')
 196             {
 197                 $buffer = new IO::File "+<$out_file"
 198                     or die "# Cannot open $out_file: $!";
 199             }
 200             else
 201               { $buffer = $out_file }
 202         }
 203
 204         ok my $gz = $CompressClass->new($buffer, Merge => 1, AutoClose => 1), "  constructor passes";
 205
 206         $gz->write("FGHI");
 207         $gz->close();
 208
 209         #hexDump($buffer);
 210         my $out = anyUncompress($dest);
 211
 212         is $out, "FGHI", '  Merge OK';
 213     }
 214 }
 215
 216 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
 217 {
 218     my $Error = getErrorRef($CompressClass);
 219
 220     title "$CompressClass - Merge to file that doesn't exist";
 221
 222     my $out_file = 'abcd.out';
 223     my $lex = new LexFile($out_file) ;
 224
 225     ok ! -e $out_file, "  Destination file, '$out_file', does not exist";
 226
 227     ok my $gz1 = $CompressClass->new($out_file, Merge => 1)
 228         or die "# $CompressClass->new failed: $GzipError\n";
 229     #hexDump($buffer);
 230     $gz1->write("FGHI");
 231     $gz1->close();
 232
 233     #hexDump($buffer);
 234     my $out = anyUncompress($out_file);
 235
 236     is $out, "FGHI", '  Merged OK';
 237 }
 238
 239 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
 240 {
 241     my $Error = getErrorRef($CompressClass);
 242
 243     my $out_file = 'abcde.out';
 244     my $lex = new LexFile($out_file) ;
 245
 246     foreach my $to_file ( qw( buffer file handle ) )
 247     {
 248         foreach my $content (undef, '', 'x', 'abcde')
 249         {
 250             #next if ! defined $content && $to_file;
 251
 252             my $buffer ;
 253             my $disp_content = defined $content ? $content : '<undef>' ;
 254             my $str_content = defined $content ? $content : '' ;
 255
 256             if ($to_file eq 'buffer')
 257             {
 258                 my $x ;
 259                 $buffer = \$x ;
 260                 title "$CompressClass to Buffer, content is '$disp_content'";
 261             }
 262             else
 263             {
 264                 $buffer = $out_file ;
 265                 if ($to_file eq 'handle')
 266                 {
 267                     title "$CompressClass to Filehandle, content is '$disp_content'";
 268                 }
 269                 else
 270                 {
 271                     title "$CompressClass to File, content is '$disp_content'";
 272                 }
 273             }
 274
 275             my $gz = $CompressClass->new($buffer);
 276             my $len = defined $content ? length($content) : 0 ;
 277             is $gz->write($content), $len, "  write ok";
 278             ok $gz->close(), " close ok";
 279
 280             #hexDump($buffer);
 281             is anyUncompress($buffer), $str_content, '  Destination is ok';
 282
 283             #if ($corruption)
 284             #{
 285                 #    next if $TopTypes eq 'RawDeflate' && $content eq '';
 286                 #
 287                 #}
 288
 289             my $dest = $buffer ;
 290             if ($to_file eq 'handle')
 291             {
 292                 $dest = new IO::File "+<$buffer" ;
 293             }
 294
 295             my $gz1 = $CompressClass->new($dest, Merge => 1, AutoClose => 1)
 296                 or die "## $GzipError\n";
 297             #print "YYY\n";
 298             #hexDump($buffer);
 299             #print "XXX\n";
 300             is $gz1->write("FGHI"), 4, "  write returned 4";
 301             ok $gz1->close(), "  close ok";
 302
 303             #hexDump($buffer);
 304             my $out = anyUncompress($buffer);
 305
 306             is $out, $str_content . "FGHI", '  Merged OK';
 307             #exit;
 308         }
 309     }
 310
 311 }
 312
 313
 314 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
 315 {
 316     my $Error = getErrorRef($CompressClass);
 317
 318     my $Func = getTopFuncRef($CompressClass);
 319     my $TopType = getTopFuncName($CompressClass);
 320
 321     my $buffer ;
 322
 323     my $out_file = 'abcde.out';
 324     my $lex = new LexFile($out_file) ;
 325
 326     foreach my $to_file (0, 1)
 327     {
 328         foreach my $content (undef, '', 'x', 'abcde')
 329         {
 330             my $disp_content = defined $content ? $content : '<undef>' ;
 331             my $str_content = defined $content ? $content : '' ;
 332             my $buffer ;
 333             if ($to_file)
 334             {
 335                 $buffer = $out_file ;
 336                 title "$TopType to File, content is '$disp_content'";
 337             }
 338             else
 339             {
 340                 my $x = '';
 341                 $buffer = \$x ;
 342                 title "$TopType to Buffer, content is '$disp_content'";
 343             }
 344
 345
 346             ok $Func->(\$content, $buffer), " Compress content";
 347             #hexDump($buffer);
 348             is anyUncompress($buffer), $str_content, '  Destination is ok';
 349
 350
 351             ok $Func->(\"FGHI", $buffer, Merge => 1), "  Merge content";
 352
 353             #hexDump($buffer);
 354             my $out = anyUncompress($buffer);
 355
 356             is $out, $str_content . "FGHI", '  Merged OK';
 357         }
 358     }
 359
 360 }
 361
 362
 363