This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Compress::Zlib 1.40
authorRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Fri, 23 Sep 2005 20:46:04 +0000 (20:46 +0000)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Fri, 23 Sep 2005 20:46:04 +0000 (20:46 +0000)
p4raw-id: //depot/perl@25591

ext/Compress/Zlib/Changes
ext/Compress/Zlib/README
ext/Compress/Zlib/Zlib.pm
ext/Compress/Zlib/Zlib.xs
ext/Compress/Zlib/t/03examples.t

index 61956b2..aa9bcc0 100644 (file)
@@ -1,6 +1,10 @@
 CHANGES
 -------
 
+  1.40 - 23 September 2005
+
+      * Fixed failure of 03examples.t for some windows systems.
+
   1.39 - 15 September 2005
 
       * Fixed dTHX macro for 5.00503 on FreeBSD
index fcfae01..086a72b 100644 (file)
@@ -1,8 +1,8 @@
                                  Compress::Zlib
 
-                                  Version 1.39
+                                  Version 1.40
 
-                                15 September 2005
+                                23 September 2005
 
           Copyright (c) 1995-2005 Paul Marquess. All rights reserved.
          This program is free software; you can redistribute it and/or
index 3f40987..f6e48ac 100644 (file)
@@ -1,7 +1,7 @@
 # File   : Zlib.pm
 # Author  : Paul Marquess
-# Created : 7 September 2005
-# Version : 1.39
+# Created : 23 September 2005
+# Version : 1.40
 #
 #     Copyright (c) 1995-2005 Paul Marquess. All rights reserved.
 #     This program is free software; you can redistribute it and/or
@@ -21,7 +21,7 @@ use warnings ;
 our ($VERSION, @ISA, @EXPORT, $AUTOLOAD);
 our ($deflateDefault, $deflateParamsDefault, $inflateDefault);
 
-$VERSION = "1.39" ;
+$VERSION = "1.40" ;
 
 @ISA = qw(Exporter);
 # Items to export into callers namespace by default. Note: do not export
index 2528ab6..6f02146 100644 (file)
@@ -1,7 +1,7 @@
 /* Filename: Zlib.xs
  * Author  : Paul Marquess, <pmqs@cpan.org>
  * Created : 30 January 2005
- * Version : 1.38
+ * Version : 1.40
  *
  *   Copyright (c) 1995-2005 Paul Marquess. All rights reserved.
  *   This program is free software; you can redistribute it and/or
index 23990ee..af16043 100644 (file)
@@ -2,16 +2,20 @@
 use strict ;
 use warnings ;
 
+use Compress::Zlib;
+
+my $count = 0 ;
 sub ok
 {
-    my ($no, $ok) = @_ ;
+    my $ok = shift ;
 
     #++ $total ;
     #++ $totalBad unless $ok ;
+    ++ $count;
 
-    print "ok $no\n" if $ok ;
-    print "not ok $no\n" unless $ok ;
-    printf "# Failed test at line %d\n", (caller)[2] unless $ok ;
+    print "ok $count\n" if $ok ;
+    print "not ok $count\n" unless $ok ;
+    #printf "# Failed test at line %d\n", (caller)[2] unless $ok ;
 
     $ok;
 }
@@ -40,16 +44,62 @@ sub readFile
     close F ;
     $string ;
 }
+
+sub diag
+{
+    my $msg = shift ;
+    $msg =~ s/^/# /mg;
+    #$msg =~ s/\n+$//;
+    $msg .= "\n" unless $msg =~ /\n\Z/;
+    print $msg;
+}
  
+sub check
+{
+    my $command = shift ;
+    my $expected = shift ;
+
+    my $stderr = 'err.out';
+    unlink $stderr;
+
+    my $cmd = "$command 2>$stderr";
+    my $stdout = `$cmd` ;
+
+    my $aok = 1 ;
+
+    $aok &= ok $? == 0
+        or diag "  exit status is $?" ;
+
+    $aok &= ok readFile($stderr) eq ''
+        or diag "Stderr is: " .  readFile($stderr);
+
+    if (defined $expected ) {
+        $aok &= ok $stdout eq $expected 
+            or diag "got content:\n". $stdout;
+    }
+
+    if (! $aok) {
+        diag "Command line: $cmd";
+        my ($file, $line) = (caller)[1,2];
+        diag "Test called from $file, line $line";
+    }
+
+    unlink $stderr;
+}
+
+
 
 my $Inc = join " ", map qq["-I$_"] => @INC;
+$Inc = '"-MExtUtils::testlib"'
+    if ! $ENV{PERL_CORE} && eval "require ExtUtils::testlib;" ;
 
 my $Perl = '' ;
 $Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ;
 $Perl = qq["$Perl"] if $^O eq 'MSWin32' ;
  
-$Perl = "$Perl -w" ;
-my $examples = $ENV{PERL_CORE} ? "../ext/Compress/Zlib/examples" : "./examples";
+$Perl = "$Perl -w $Inc" ;
+my $examples = $ENV{PERL_CORE} ? "../ext/Compress/Zlib/examples" 
+                               : "./examples";
 
 my $hello1 = <<EOM ;
 hello
@@ -76,56 +126,33 @@ EOM
 
 my @hello2 = grep(s/$/\n/, split(/\n/, $hello2)) ;
 
-print "1..13\n" ;
-
-
-
-# gzcat
-# #####
-
 my $file1 = "hello1.gz" ;
 my $file2 = "hello2.gz" ;
-unlink $file1, $file2 ;
+my $stderr = "err.out" ;
+unlink $stderr ;
 
-my $hello1_uue = <<'EOM';
-M'XL("(W#+3$" VAE;&QO,0#+2,W)R><JR<@L5@ BKD2%DM3B$J[<U.+BQ/14
-;K@J%$A#@JB@% Z"Z5(74O!0N &D:".,V    
-EOM
+my $gz = gzopen($file1, "wb");
+$gz->gzwrite($hello1);
+$gz->gzclose();
 
-my $hello2_uue = <<'EOM';
-M'XL("*[#+3$" VAE;&QO,@#C\L@O3ZGD*LG(+%8 HI*,5*[BU.3\O!2NM,R<
-A5*X*A0(0X*HH!0.NHM3$G)Q*D#*%5* : #) E6<^    
-EOM
+$gz = gzopen($file2, "wb");
+$gz->gzwrite($hello2);
+$gz->gzclose();
 
-# Write a test .gz file
-{
-    #local $^W = 0 ;
-    writeFile($file1, unpack("u", $hello1_uue)) ;
-    writeFile($file2, unpack("u", $hello2_uue)) ;
-}
+print "1..16\n" ;
 
-$a = `$Perl $Inc ${examples}/gzcat $file1 $file2 2>&1` ;
 
-ok(1, $? == 0) 
-    or print "# \$\? == [$?]\n";
-ok(2, $a eq $hello1 . $hello2) 
-    or print "# got $a\n";
-#print "? = $? [$a]\n";
 
+# gzcat
+# #####
+
+check "$Perl ${examples}/gzcat $file1 $file2", $hello1 . $hello2 ;
 
 # gzgrep
 # ######
 
-$a = ($^O eq 'MSWin32' || $^O eq 'VMS'
-     ? `$Perl $Inc ${examples}/gzgrep "^x" $file1 $file2 2>&1`
-     : `$Perl $Inc ${examples}/gzgrep '^x' $file1 $file2 2>&1`) ;
-ok(3, $? == 0) 
-    or print "# \$\? == [$?]\n";
-
-ok(4, $a eq join('', grep(/^x/, @hello1, @hello2))) 
-    or print "# got $a\n";
-#print "? = $? [$a]\n";
+check "$Perl ${examples}/gzgrep the $file1 $file2",
+        join('', grep(/the/, @hello1, @hello2));
 
 
 unlink $file1, $file2 ;
@@ -135,40 +162,22 @@ unlink $file1, $file2 ;
 # ##############
 
 
-my $stderr = "err.out" ;
-unlink $stderr ;
 writeFile($file1, $hello1) ;
 writeFile($file2, $hello2) ;
 
 # there's no way to set binmode on backticks in Win32 so we won't use $a later
-$a = `$Perl $Inc ${examples}/filtdef $file1 $file2 2>$stderr` ;
-ok(5, $? == 0)
-    or print "# \$\? == [$?]\n";
-ok(6, -s $stderr == 0) ;
-
-unlink $stderr;
-$a = `$Perl $Inc ${examples}/filtdef $file1 $file2 | $Perl $Inc ${examples}/filtinf 2>$stderr`;
-ok(7, $? == 0) 
-    or print "# \$\? == [$?]\n";
-ok(8, -s $stderr == 0) ;
-ok(9, $a eq $hello1 . $hello2) 
-    or print "# got $a\n";
+check "$Perl ${examples}/filtdef $file1 $file2"; ;
+
+check "$Perl ${examples}/filtdef $file1 $file2 | $Perl ${examples}/filtinf 2>$stderr", $hello1 . $hello2;
 
 # gzstream
 # ########
 
 {
     writeFile($file1, $hello1) ;
-    $a = `$Perl $Inc ${examples}/gzstream <$file1 >$file2 2>$stderr` ;
-    ok(10, $? == 0) 
-        or print "# \$\? == [$?]\n";
-    ok(11, -s $stderr == 0) ;
-
-    my $b = `$Perl $Inc ${examples}/gzcat $file2 2>&1` ;
-    ok(12, $? == 0) 
-        or print "# \$\? == [$?]\n";
-    ok(13, $b eq $hello1 ) 
-        or print "# got $b\n";
+    check "$Perl ${examples}/gzstream <$file1 >$file2" ;
+
+    check "$Perl ${examples}/gzcat $file2", $hello1;
 
 }