ext/Compress/Zlib/t/05examples.t

   1
   2 use lib 't';
   3
   4 use strict;
   5 use warnings;
   6 use bytes;
   7
   8 use Test::More ;
   9 use ZlibTestUtils;
  10 use Compress::Zlib;
  11
  12 BEGIN
  13 {
  14     plan(skip_all => "Examples needs Perl 5.005 or better - you have Perl $]" )
  15         if $] < 5.005 ;
  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 => 30 + $extra ;
  23 }
  24
  25
  26 my $Inc = join " ", map qq["-I$_"] => @INC;
  27 $Inc = '"-MExtUtils::testlib"'
  28     if ! $ENV{PERL_CORE} && eval " require ExtUtils::testlib; " ;
  29
  30 my $Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ;
  31 $Perl = qq["$Perl"] if $^O eq 'MSWin32' ;
  32
  33 $Perl = "$Perl $Inc -w" ;
  34 my $examples = $ENV{PERL_CORE} ? "../ext/Compress/Zlib/examples"
  35                                : "./examples";
  36
  37 my $hello1 = <<EOM ;
  38 hello
  39 this is
  40 a test
  41 message
  42 x ttttt
  43 xuuuuuu
  44 the end
  45 EOM
  46
  47 my @hello1 = grep(s/$/\n/, split(/\n/, $hello1)) ;
  48
  49 my $hello2 = <<EOM;
  50
  51 Howdy
  52 this is the
  53 second
  54 file
  55 x ppppp
  56 xuuuuuu
  57 really the end
  58 EOM
  59
  60 my @hello2 = grep(s/$/\n/, split(/\n/, $hello2)) ;
  61
  62 my $file1 = "hello1.gz" ;
  63 my $file2 = "hello2.gz" ;
  64 my $stderr = "err.out" ;
  65 unlink $stderr ;
  66
  67 unlink $file1, $file2 ;
  68
  69 my $gz = gzopen($file1, "wb");
  70 $gz->gzwrite($hello1);
  71 $gz->gzclose();
  72
  73 $gz = gzopen($file2, "wb");
  74 $gz->gzwrite($hello2);
  75 $gz->gzclose();
  76
  77 sub check
  78 {
  79     my $command = shift ;
  80     my $expected = shift ;
  81
  82     my $stderr = 'err.out';
  83     unlink $stderr;
  84
  85     my $cmd = "$command 2>$stderr";
  86     my $stdout = `$cmd` ;
  87
  88     my $aok = 1 ;
  89
  90     $aok &= is $?, 0, "  exit status is 0" ;
  91
  92     $aok &= is readFile($stderr), '', "  no stderr" ;
  93
  94     $aok &= is $stdout, $expected, "  expected content is ok"
  95         if defined $expected ;
  96
  97     if (! $aok) {
  98         diag "Command line: $cmd";
  99         my ($file, $line) = (caller)[1,2];
 100         diag "Test called from $file, line $line";
 101     }
 102
 103     unlink $stderr;
 104 }
 105
 106 # gzcat
 107 # #####
 108
 109 title "gzcat.zlib" ;
 110 check "$Perl ${examples}/gzcat.zlib $file1 $file2 ", $hello1 . $hello2 ;
 111
 112 title "gzcat - command line" ;
 113 check "$Perl ${examples}/gzcat $file1 $file2",  $hello1 . $hello2;
 114
 115 title "gzcat - stdin" ;
 116 check "$Perl ${examples}/gzcat <$file1 ", $hello1;
 117
 118
 119 # gzgrep
 120 # ######
 121
 122 title "gzgrep";
 123 check "$Perl  ${examples}/gzgrep the $file1 $file2",
 124         join('', grep(/the/, @hello1, @hello2));
 125
 126 unlink $file1, $file2 ;
 127
 128
 129 # filtdef/filtinf
 130 # ##############
 131
 132
 133 writeFile($file1, $hello1) ;
 134 writeFile($file2, $hello2) ;
 135
 136 title "filtdef" ;
 137 # there's no way to set binmode on backticks in Win32 so we won't use $a later
 138 check "$Perl ${examples}/filtdef $file1 $file2" ;
 139
 140 title "filtdef | filtinf";
 141 check "$Perl ${examples}/filtdef $file1 $file2 | $Perl ${examples}/filtinf",
 142         $hello1 . $hello2;
 143 # gzstream
 144 # ########
 145
 146 {
 147     title "gzstream" ;
 148     writeFile($file1, $hello1) ;
 149     check "$Perl ${examples}/gzstream <$file1 >$file2";
 150
 151     title "gzcat" ;
 152     check "$Perl ${examples}/gzcat $file2", $hello1 ;
 153 }
 154
 155 END
 156 {
 157     for ($file1, $file2, $stderr) { 1 while unlink $_ } ;
 158 }
 159