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

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = ("../lib", "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 $lex = new LexFile my $out_file ;
  82
  83         # create empty file
  84         open F, ">$out_file" ; print F "x"; close F;
  85         ok   -e $out_file, "  file exists" ;
  86         ok  !-z $out_file, "  and is not empty" ;
  87
  88         # make unwritable
  89         is chmod(0444, $out_file), 1, "  chmod worked" ;
  90         ok   -e $out_file, "  still exists after chmod" ;
  91
  92         SKIP:
  93         {
  94             skip "Cannot create non-writable file", 3
  95                 if -w $out_file ;
  96
  97             ok ! -w $out_file, "  chmod made file unwritable" ;
  98
  99             my $dest ;
 100             if ($to_file)
 101               { $dest = $out_file }
 102             else
 103               { $dest = new IO::File "<$out_file"  }
 104
 105             my $gz = $CompressClass->new($dest, Merge => 1) ;
 106
 107             ok ! $gz, "  Did not create $CompressClass object";
 108
 109             {
 110                 if ($to_file) {
 111                     is $$Error, "Output file '$out_file' is not writable",
 112                             "  Got non-writable filename message" ;
 113                 }
 114                 else {
 115                     is $$Error, "Output filehandle is not writable",
 116                             "  Got non-writable filehandle message" ;
 117                 }
 118             }
 119         }
 120
 121         chmod 0777, $out_file ;
 122     }
 123 }
 124
 125 # output is not compressed at all
 126 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
 127 {
 128
 129     my $Error = getErrorRef($CompressClass);
 130
 131     my $lex = new LexFile my $out_file ;
 132
 133     foreach my $to_file ( qw(buffer file handle ) )
 134     {
 135         title "$CompressClass to $to_file, content is not compressed";
 136
 137         my $content = "abc" x 300 ;
 138         my $buffer ;
 139         my $disp_content = defined $content ? $content : '<undef>' ;
 140         my $str_content = defined $content ? $content : '' ;
 141
 142         if ($to_file eq 'buffer')
 143         {
 144             $buffer = \$content ;
 145         }
 146         else
 147         {
 148             writeFile($out_file, $content);
 149
 150             if ($to_file eq 'handle')
 151             {
 152                 $buffer = new IO::File "+<$out_file"
 153                     or die "# Cannot open $out_file: $!";
 154             }
 155             else
 156               { $buffer = $out_file }
 157         }
 158
 159         ok ! $CompressClass->new($buffer, Merge => 1), "  constructor fails";
 160         {
 161             like $$Error, '/Cannot create InflateScan object: (Header Error|unexpected end of file)/', "  got Bad Magic" ;
 162         }
 163
 164     }
 165 }
 166
 167 # output is empty
 168 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
 169 {
 170
 171     my $Error = getErrorRef($CompressClass);
 172
 173     my $lex = new LexFile my $out_file ;
 174
 175     foreach my $to_file ( qw(buffer file handle ) )
 176     {
 177         title "$CompressClass to $to_file, content is empty";
 178
 179         my $content = '';
 180         my $buffer ;
 181         my $dest ;
 182
 183         if ($to_file eq 'buffer')
 184         {
 185             $dest = $buffer = \$content ;
 186         }
 187         else
 188         {
 189             writeFile($out_file, $content);
 190             $dest = $out_file;
 191
 192             if ($to_file eq 'handle')
 193             {
 194                 $buffer = new IO::File "+<$out_file"
 195                     or die "# Cannot open $out_file: $!";
 196             }
 197             else
 198               { $buffer = $out_file }
 199         }
 200
 201         ok my $gz = $CompressClass->new($buffer, Merge => 1, AutoClose => 1), "  constructor passes";
 202
 203         $gz->write("FGHI");
 204         $gz->close();
 205
 206         #hexDump($buffer);
 207         my $out = anyUncompress($dest);
 208
 209         is $out, "FGHI", '  Merge OK';
 210     }
 211 }
 212
 213 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
 214 {
 215     my $Error = getErrorRef($CompressClass);
 216
 217     title "$CompressClass - Merge to file that doesn't exist";
 218
 219     my $lex = new LexFile my $out_file ;
 220
 221     ok ! -e $out_file, "  Destination file, '$out_file', does not exist";
 222
 223     ok my $gz1 = $CompressClass->new($out_file, Merge => 1)
 224         or die "# $CompressClass->new failed: $GzipError\n";
 225     #hexDump($buffer);
 226     $gz1->write("FGHI");
 227     $gz1->close();
 228
 229     #hexDump($buffer);
 230     my $out = anyUncompress($out_file);
 231
 232     is $out, "FGHI", '  Merged OK';
 233 }
 234
 235 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
 236 {
 237     my $Error = getErrorRef($CompressClass);
 238
 239     my $lex = new LexFile my $out_file ;
 240
 241     foreach my $to_file ( qw( buffer file handle ) )
 242     {
 243         foreach my $content (undef, '', 'x', 'abcde')
 244         {
 245             #next if ! defined $content && $to_file;
 246
 247             my $buffer ;
 248             my $disp_content = defined $content ? $content : '<undef>' ;
 249             my $str_content = defined $content ? $content : '' ;
 250
 251             if ($to_file eq 'buffer')
 252             {
 253                 my $x ;
 254                 $buffer = \$x ;
 255                 title "$CompressClass to Buffer, content is '$disp_content'";
 256             }
 257             else
 258             {
 259                 $buffer = $out_file ;
 260                 if ($to_file eq 'handle')
 261                 {
 262                     title "$CompressClass to Filehandle, content is '$disp_content'";
 263                 }
 264                 else
 265                 {
 266                     title "$CompressClass to File, content is '$disp_content'";
 267                 }
 268             }
 269
 270             my $gz = $CompressClass->new($buffer);
 271             my $len = defined $content ? length($content) : 0 ;
 272             is $gz->write($content), $len, "  write ok";
 273             ok $gz->close(), " close ok";
 274
 275             #hexDump($buffer);
 276             is anyUncompress($buffer), $str_content, '  Destination is ok';
 277
 278             #if ($corruption)
 279             #{
 280                 #    next if $TopTypes eq 'RawDeflate' && $content eq '';
 281                 #
 282                 #}
 283
 284             my $dest = $buffer ;
 285             if ($to_file eq 'handle')
 286             {
 287                 $dest = new IO::File "+<$buffer" ;
 288             }
 289
 290             my $gz1 = $CompressClass->new($dest, Merge => 1, AutoClose => 1)
 291                 or die "## Error is  $$Error\n";
 292
 293             #print "YYY\n";
 294             #hexDump($buffer);
 295             #print "XXX\n";
 296             is $gz1->write("FGHI"), 4, "  write returned 4";
 297             ok $gz1->close(), "  close ok";
 298
 299             #hexDump($buffer);
 300             my $out = anyUncompress($buffer);
 301
 302             is $out, $str_content . "FGHI", '  Merged OK';
 303             #exit;
 304         }
 305     }
 306
 307 }
 308
 309
 310
 311 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
 312 {
 313     my $Error = getErrorRef($CompressClass);
 314
 315     my $Func = getTopFuncRef($CompressClass);
 316     my $TopType = getTopFuncName($CompressClass);
 317
 318     my $buffer ;
 319
 320     my $lex = new LexFile my $out_file ;
 321
 322     foreach my $to_file (0, 1)
 323     {
 324         foreach my $content (undef, '', 'x', 'abcde')
 325         {
 326             my $disp_content = defined $content ? $content : '<undef>' ;
 327             my $str_content = defined $content ? $content : '' ;
 328             my $buffer ;
 329             if ($to_file)
 330             {
 331                 $buffer = $out_file ;
 332                 title "$TopType to File, content is '$disp_content'";
 333             }
 334             else
 335             {
 336                 my $x = '';
 337                 $buffer = \$x ;
 338                 title "$TopType to Buffer, content is '$disp_content'";
 339             }
 340
 341
 342             ok $Func->(\$content, $buffer), " Compress content";
 343             #hexDump($buffer);
 344             is anyUncompress($buffer), $str_content, '  Destination is ok';
 345
 346
 347             ok $Func->(\"FGHI", $buffer, Merge => 1), "  Merge content";
 348
 349             #hexDump($buffer);
 350             my $out = anyUncompress($buffer);
 351
 352             is $out, $str_content . "FGHI", '  Merged OK';
 353         }
 354     }
 355
 356 }
 357
 358
 359