ext/Compress/Zlib/t/06gzdopen.t

   1
   2
   3 use strict ;
   4 use warnings ;
   5
   6 use Compress::Zlib ;
   7
   8 sub ok
   9 {
  10     my ($no, $ok) = @_ ;
  11
  12     #++ $total ;
  13     #++ $totalBad unless $ok ;
  14
  15     print "ok $no\n" if $ok ;
  16     print "not ok $no\n" unless $ok ;
  17 }
  18
  19 sub readFile
  20 {
  21     my ($filename) = @_ ;
  22     my ($string) = '' ;
  23
  24     open (F, "<$filename")
  25         or die "Cannot open $filename: $!\n" ;
  26     binmode(F);
  27     while (<F>)
  28       { $string .= $_ }
  29     close F ;
  30     $string ;
  31 }
  32
  33 my $hello = <<EOM ;
  34 hello world
  35 this is a test
  36 EOM
  37
  38 my $len   = length $hello ;
  39
  40
  41 print "1..23\n" ;
  42
  43 # Check zlib_version and ZLIB_VERSION are the same.
  44 ok(1, Compress::Zlib::zlib_version eq ZLIB_VERSION) ;
  45
  46
  47 # gzip - filehandle tests
  48 # ========================
  49
  50 {
  51   use IO::File ;
  52   my $filename = "fh.gz" ;
  53   my $hello = "hello, hello, I'm back again" ;
  54   my $len = length $hello ;
  55
  56   my $f = new IO::File ">$filename" ;
  57   binmode $f ; # for OS/2
  58
  59   ok(2, $f) ;
  60
  61   my $line_one =  "first line\n" ;
  62   print $f $line_one;
  63
  64   ok(3, my $fil = gzopen($f, "wb")) ;
  65
  66   ok(4, $fil->gzwrite($hello) == $len) ;
  67
  68   ok(5, ! $fil->gzclose ) ;
  69
  70
  71   ok(6, my $g = new IO::File "<$filename") ;
  72   binmode $g ; # for OS/2
  73
  74   my $first ;
  75   my $ret = read($g, $first, length($line_one));
  76   ok(7, $ret == length($line_one));
  77
  78   ok(8, $first eq $line_one) ;
  79
  80   ok(9, $fil = gzopen($g, "rb") ) ;
  81   my $uncomp;
  82   ok(10, (my $x = $fil->gzread($uncomp)) == $len) ;
  83
  84   ok(11, ! $fil->gzclose ) ;
  85
  86   unlink $filename ;
  87
  88   ok(12, $hello eq $uncomp) ;
  89
  90 }
  91
  92 {
  93   my $filename = "fh.gz" ;
  94   my $hello = "hello, hello, I'm back again" ;
  95   my $len = length $hello ;
  96   my $uncomp;
  97   local (*FH1) ;
  98   local (*FH2) ;
  99
 100   ok(13, open FH1, ">$filename") ;
 101   binmode FH1; # for OS/2
 102
 103   my $line_one =  "first line\n" ;
 104   print FH1 $line_one;
 105
 106   ok(14, my $fil = gzopen(\*FH1, "wb")) ;
 107
 108   ok(15, $fil->gzwrite($hello) == $len) ;
 109
 110   ok(16, ! $fil->gzclose ) ;
 111
 112
 113   ok(17, my $g = open FH2, "<$filename") ;
 114   binmode FH2; # for OS/2
 115
 116   my $first ;
 117   my $ret = read(FH2, $first, length($line_one));
 118   ok(18, $ret == length($line_one));
 119
 120   ok(19, $first eq $line_one) ;
 121
 122   ok(20, $fil = gzopen(*FH2, "rb") ) ;
 123   ok(21, (my $x = $fil->gzread($uncomp)) == $len) ;
 124
 125   ok(22, ! $fil->gzclose ) ;
 126
 127   unlink $filename ;
 128
 129   ok(23, $hello eq $uncomp) ;
 130
 131 }
 132