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