t/lib/compress/merge.pl

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