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