ext/Compress/Zlib/t/03examples.t

   1
   2 use strict ;
   3 use warnings ;
   4
   5 sub ok
   6 {
   7     my ($no, $ok) = @_ ;
   8
   9     #++ $total ;
  10     #++ $totalBad unless $ok ;
  11
  12     print "ok $no\n" if $ok ;
  13     print "not ok $no\n" unless $ok ;
  14     printf "# Failed test at line %d\n", (caller)[2] unless $ok ;
  15 }
  16
  17 sub writeFile
  18 {
  19     my($filename, @strings) = @_ ;
  20     open (F, ">$filename")
  21         or die "Cannot open $filename: $!\n" ;
  22     binmode(F);
  23     foreach (@strings)
  24       { print F }
  25     close F ;
  26 }
  27
  28 sub readFile
  29 {
  30     my ($filename) = @_ ;
  31     my ($string) = '' ;
  32
  33     open (F, "<$filename")
  34         or die "Cannot open $filename: $!\n" ;
  35     binmode(F);
  36     while (<F>)
  37       { $string .= $_ }
  38     close F ;
  39     $string ;
  40 }
  41
  42
  43 my $Inc = join " ", map qq["-I$_"] => @INC;
  44
  45 my $Perl = '' ;
  46 $Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ;
  47 $Perl = qq["$Perl"] if $^O eq 'MSWin32' ;
  48
  49 $Perl = "$Perl -w" ;
  50 my $examples = $ENV{PERL_CORE} ? "../ext/Compress/Zlib/examples" : "./examples";
  51
  52 my $hello1 = <<EOM ;
  53 hello
  54 this is
  55 a test
  56 message
  57 x ttttt
  58 xuuuuuu
  59 the end
  60 EOM
  61
  62 my @hello1 = grep(s/$/\n/, split(/\n/, $hello1)) ;
  63
  64 my $hello2 = <<EOM;
  65
  66 Howdy
  67 this is the
  68 second
  69 file
  70 x ppppp
  71 xuuuuuu
  72 really the end
  73 EOM
  74
  75 my @hello2 = grep(s/$/\n/, split(/\n/, $hello2)) ;
  76
  77 print "1..13\n" ;
  78
  79
  80
  81 # gzcat
  82 # #####
  83
  84 my $file1 = "hello1.gz" ;
  85 my $file2 = "hello2.gz" ;
  86 unlink $file1, $file2 ;
  87
  88 my $hello1_uue = <<'EOM';
  89 M'XL("(W#+3$" VAE;&QO,0#+2,W)R><JR<@L5@ BKD2%DM3B$J[<U.+BQ/14
  90 ;K@J%$A#@JB@% Z"Z5(74O!0N &D:".,V
  91 EOM
  92
  93 my $hello2_uue = <<'EOM';
  94 M'XL("*[#+3$" VAE;&QO,@#C\L@O3ZGD*LG(+%8 HI*,5*[BU.3\O!2NM,R<
  95 A5*X*A0(0X*HH!0.NHM3$G)Q*D#*%5* : #) E6<^
  96 EOM
  97
  98 # Write a test .gz file
  99 {
 100     #local $^W = 0 ;
 101     writeFile($file1, unpack("u", $hello1_uue)) ;
 102     writeFile($file2, unpack("u", $hello2_uue)) ;
 103 }
 104
 105
 106 $a = `$Perl $Inc ${examples}/gzcat $file1 $file2 2>&1` ;
 107
 108 ok(1, $? == 0) ;
 109 ok(2, $a eq $hello1 . $hello2) ;
 110 #print "? = $? [$a]\n";
 111
 112
 113 # gzgrep
 114 # ######
 115
 116 $a = ($^O eq 'MSWin32' || $^O eq 'VMS'
 117      ? `$Perl $Inc ${examples}/gzgrep "^x" $file1 $file2 2>&1`
 118      : `$Perl $Inc ${examples}/gzgrep '^x' $file1 $file2 2>&1`) ;
 119 ok(3, $? == 0) ;
 120
 121 ok(4, $a eq join('', grep(/^x/, @hello1, @hello2))) ;
 122 #print "? = $? [$a]\n";
 123
 124
 125 unlink $file1, $file2 ;
 126
 127
 128 # filtdef/filtinf
 129 # ##############
 130
 131
 132 my $stderr = "err.out" ;
 133 unlink $stderr ;
 134 writeFile($file1, $hello1) ;
 135 writeFile($file2, $hello2) ;
 136
 137 # there's no way to set binmode on backticks in Win32 so we won't use $a later
 138 $a = `$Perl $Inc ${examples}/filtdef $file1 $file2 2>$stderr` ;
 139 ok(5, $? == 0) ;
 140 ok(6, -s $stderr == 0) ;
 141
 142 unlink $stderr;
 143 $a = `$Perl $Inc ${examples}/filtdef $file1 $file2 | $Perl $Inc ${examples}/filtinf 2>$stderr`;
 144 ok(7, $? == 0) ;
 145 ok(8, -s $stderr == 0) ;
 146 ok(9, $a eq $hello1 . $hello2) ;
 147
 148 # gzstream
 149 # ########
 150
 151 {
 152     writeFile($file1, $hello1) ;
 153     $a = `$Perl $Inc ${examples}/gzstream <$file1 >$file2 2>$stderr` ;
 154     ok(10, $? == 0) ;
 155     ok(11, -s $stderr == 0) ;
 156
 157     my $b = `$Perl $Inc ${examples}/gzcat $file2 2>&1` ;
 158     ok(12, $? == 0) ;
 159     ok(13, $b eq $hello1 ) ;
 160 }
 161
 162
 163 END
 164 {
 165     for ($file1, $file2, $stderr) { 1 while unlink $_ } ;
 166 }