Perl 5.10.0 Archive/Extract test failure

Guy Dalziel krendoshazin at dementedfury.org
Sat Jul 25 04:03:22 PDT 2009


There is a failure in one of the tests in Perl 5.10.0 (chapter 6) under
the development book, the test is Archive/Extract. I pulled the fixes
for this from upstream which stems from a problem with newer versions of
tar. See attached. 
-------------- next part --------------
Submitted By: Guy Dalziel <krendoshazin at dementedfury dot org>
Date: 2009-07-25
Initial Package Version: 5.10.0
Upstream Status: In CVS
Origin: Upstream
Description: This fixes the Archive/Extract test so that it does not fail.

diff -Naur perl-5.10.0-orig/lib/Archive/Extract.pm perl-5.10.0/lib/Archive/Extract.pm
--- perl-5.10.0-orig/lib/Archive/Extract.pm	2007-12-18 10:47:07.000000000 +0000
+++ perl-5.10.0/lib/Archive/Extract.pm	2009-07-25 12:51:19.529000133 +0100
@@ -550,12 +550,19 @@
                              $self->bin_tar, '-tf', '-'] :
             [$self->bin_tar, '-tf', $self->archive];
 
-        ### run the command ###
-        my $buffer = '';
-        unless( scalar run( command => $cmd,
+        ### run the command
+        ### newer versions of 'tar' (1.21 and up) now print record size
+        ### to STDERR as well if v OR t is given (used to be both). This
+        ### is a 'feature' according to the changelog, so we must now only
+        ### inspect STDOUT, otherwise, failures like these occur:
+        ### nntp.perl.org/group/perl.cpan.testers/2009/02/msg3230366.html
+        my $buffer  = '';
+        my @out     = run(  command => $cmd,
                             buffer  => \$buffer,
-                            verbose => $DEBUG )
-        ) {
+                            verbose => $DEBUG );
+
+        ### command was unsuccessful
+        unless( $out[0] ) {
             return $self->_error(loc(
                             "Error listing contents of archive '%1': %2",
                             $self->archive, $buffer ));
@@ -578,7 +585,8 @@
                                             \s+ [\d,.]+ \s tape \s blocks
                                         |x ? $1 : $_);
 
-                    } split $/, $buffer;
+            ### only STDOUT, see above
+            } map { split $/, $_ } @{$out[3]};
 
             ### store the files that are in the archive ###
             $self->files(\@files);
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 836 bytes
Desc: not available
URL: <http://lists.linuxfromscratch.org/pipermail/lfs-dev/attachments/20090725/1292b9ec/attachment.sig>


More information about the lfs-dev mailing list