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

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