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