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 CompTestUtils;
   8
   9 use Compress::Raw::Zlib 2 ;
  10
  11 BEGIN
  12 {
  13     plan(skip_all => "Merge needs Zlib 1.2.1 or better - you have Zlib "
  14                 . Compress::Raw::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::Raw::Zlib::zlib_version, ZLIB_VERSION,
  40         "ZLIB_VERSION matches Compress::Raw::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::Raw::Zlib::InflateScan Bufsize => 0} ;
  54         like $@, mkErr("^Compress::Raw::Zlib::InflateScan::new: Bufsize must be >= 1, you specified 0"), "  catch bufsize == 0";
  55
  56         eval { Compress::Raw::Zlib::inflateScanStream::createDeflateStream(undef, Bufsize => 0) } ;
  57         like $@, mkErr("^Compress::Raw::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                         ok $$Error, "  Got error message" ;
 106                     }
 107                 }
 108             }
 109
 110             chmod 0777, $out_file ;
 111         }
 112     }
 113
 114     # output is not compressed at all
 115     {
 116
 117         my $lex = new LexFile my $out_file ;
 118
 119         foreach my $to_file ( qw(buffer file handle ) )
 120         {
 121             title "$CompressClass to $to_file, content is not compressed";
 122
 123             my $content = "abc" x 300 ;
 124             my $buffer ;
 125             my $disp_content = defined $content ? $content : '<undef>' ;
 126             my $str_content = defined $content ? $content : '' ;
 127
 128             if ($to_file eq 'buffer')
 129             {
 130                 $buffer = \$content ;
 131             }
 132             else
 133             {
 134                 writeFile($out_file, $content);
 135
 136                 if ($to_file eq 'handle')
 137                 {
 138                     $buffer = new IO::File "+<$out_file"
 139                         or die "# Cannot open $out_file: $!";
 140                 }
 141                 else
 142                   { $buffer = $out_file }
 143             }
 144
 145             ok ! $CompressClass->new($buffer, Merge => 1), "  constructor fails";
 146             {
 147                 like $$Error, '/Cannot create InflateScan object: (Header Error|unexpected end of file)/', "  got Bad Magic" ;
 148             }
 149
 150         }
 151     }
 152
 153     # output is empty
 154     {
 155
 156         my $lex = new LexFile my $out_file ;
 157
 158         foreach my $to_file ( qw(buffer file handle ) )
 159         {
 160             title "$CompressClass to $to_file, content is empty";
 161
 162             my $content = '';
 163             my $buffer ;
 164             my $dest ;
 165
 166             if ($to_file eq 'buffer')
 167             {
 168                 $dest = $buffer = \$content ;
 169             }
 170             else
 171             {
 172                 writeFile($out_file, $content);
 173                 $dest = $out_file;
 174
 175                 if ($to_file eq 'handle')
 176                 {
 177                     $buffer = new IO::File "+<$out_file"
 178                         or die "# Cannot open $out_file: $!";
 179                 }
 180                 else
 181                   { $buffer = $out_file }
 182             }
 183
 184             ok my $gz = $CompressClass->new($buffer, Merge => 1, AutoClose => 1), "  constructor passes"
 185                 or diag $$Error;
 186
 187             $gz->write("FGHI");
 188             $gz->close();
 189
 190             #hexDump($buffer);
 191             my $out = anyUncompress($dest);
 192
 193             is $out, "FGHI", '  Merge OK';
 194         }
 195     }
 196
 197     {
 198         title "$CompressClass - Merge to file that doesn't exist";
 199
 200         my $lex = new LexFile my $out_file ;
 201
 202         ok ! -e $out_file, "  Destination file, '$out_file', does not exist";
 203
 204         ok my $gz1 = $CompressClass->new($out_file, Merge => 1)
 205             or die "# $CompressClass->new failed: $$Error\n";
 206         #hexDump($buffer);
 207         $gz1->write("FGHI");
 208         $gz1->close();
 209
 210         #hexDump($buffer);
 211         my $out = anyUncompress($out_file);
 212
 213         is $out, "FGHI", '  Merged OK';
 214     }
 215
 216     {
 217
 218         my $lex = new LexFile my $out_file ;
 219
 220         foreach my $to_file ( qw( buffer file handle ) )
 221         {
 222             foreach my $content (undef, '', 'x', 'abcde')
 223             {
 224                 #next if ! defined $content && $to_file;
 225
 226                 my $buffer ;
 227                 my $disp_content = defined $content ? $content : '<undef>' ;
 228                 my $str_content = defined $content ? $content : '' ;
 229
 230                 if ($to_file eq 'buffer')
 231                 {
 232                     my $x ;
 233                     $buffer = \$x ;
 234                     title "$CompressClass to Buffer, content is '$disp_content'";
 235                 }
 236                 else
 237                 {
 238                     $buffer = $out_file ;
 239                     if ($to_file eq 'handle')
 240                     {
 241                         title "$CompressClass to Filehandle, content is '$disp_content'";
 242                     }
 243                     else
 244                     {
 245                         title "$CompressClass to File, content is '$disp_content'";
 246                     }
 247                 }
 248
 249                 my $gz = $CompressClass->new($buffer);
 250                 my $len = defined $content ? length($content) : 0 ;
 251                 is $gz->write($content), $len, "  write ok";
 252                 ok $gz->close(), " close ok";
 253
 254                 #hexDump($buffer);
 255                 is anyUncompress($buffer), $str_content, '  Destination is ok';
 256
 257                 #if ($corruption)
 258                 #{
 259                     #    next if $TopTypes eq 'RawDeflate' && $content eq '';
 260                     #
 261                     #}
 262
 263                 my $dest = $buffer ;
 264                 if ($to_file eq 'handle')
 265                 {
 266                     $dest = new IO::File "+<$buffer" ;
 267                 }
 268
 269                 my $gz1 = $CompressClass->new($dest, Merge => 1, AutoClose => 1)
 270                     or die "## Error is  $$Error\n";
 271
 272                 #print "YYY\n";
 273                 #hexDump($buffer);
 274                 #print "XXX\n";
 275                 is $gz1->write("FGHI"), 4, "  write returned 4";
 276                 ok $gz1->close(), "  close ok";
 277
 278                 #hexDump($buffer);
 279                 my $out = anyUncompress($buffer);
 280
 281                 is $out, $str_content . "FGHI", '  Merged OK';
 282                 #exit;
 283             }
 284         }
 285
 286     }
 287
 288
 289
 290     {
 291         my $Func = getTopFuncRef($CompressClass);
 292         my $TopType = getTopFuncName($CompressClass);
 293
 294         my $buffer ;
 295
 296         my $lex = new LexFile my $out_file ;
 297
 298         foreach my $to_file (0, 1)
 299         {
 300             foreach my $content (undef, '', 'x', 'abcde')
 301             {
 302                 my $disp_content = defined $content ? $content : '<undef>' ;
 303                 my $str_content = defined $content ? $content : '' ;
 304                 my $buffer ;
 305                 if ($to_file)
 306                 {
 307                     $buffer = $out_file ;
 308                     title "$TopType to File, content is '$disp_content'";
 309                 }
 310                 else
 311                 {
 312                     my $x = '';
 313                     $buffer = \$x ;
 314                     title "$TopType to Buffer, content is '$disp_content'";
 315                 }
 316
 317
 318                 ok $Func->(\$content, $buffer), " Compress content";
 319                 #hexDump($buffer);
 320                 is anyUncompress($buffer), $str_content, '  Destination is ok';
 321
 322
 323                 ok $Func->(\"FGHI", $buffer, Merge => 1), "  Merge content";
 324
 325                 #hexDump($buffer);
 326                 my $out = anyUncompress($buffer);
 327
 328                 is $out, $str_content . "FGHI", '  Merged OK';
 329             }
 330         }
 331
 332     }
 333
 334 }
 335
 336
 337 1;