| Subject: | [PATCH] Make the test-suite pass on VMS |
Okay, this patch makes the testsuite pass on VMS.
There is still the problem of "illegal directory names" on VMS. I'll see about that later.
The testsuite sould include a typical tarball for distributions to test on IMO.
-- Abe.
diff -ru ../Archive-Tar-1.24/lib/Archive/Tar.pm Archive-Tar-1.24/lib/Archive/Tar.pm
--- ../Archive-Tar-1.24/lib/Archive/Tar.pm Tue May 3 15:03:09 2005
+++ Archive-Tar-1.24/lib/Archive/Tar.pm Wed May 4 18:10:03 2005
@@ -479,8 +479,15 @@
### splitpath takes a bool at the end to indicate
### that it's splitting a dir
- my ($vol,$dirs,$file) = File::Spec::Unix->splitpath( $name,
- $entry->is_dir );
+ my ($vol,$dirs,$file);
+ if ( defined $alt ) { # It's a local-OS path
+ ($vol,$dirs,$file) = File::Spec->splitpath( $alt,
+ $entry->is_dir );
+ } else {
+ ($vol,$dirs,$file) = File::Spec::Unix->splitpath( $name,
+ $entry->is_dir );
+ }
+
my $dir;
### is $name an absolute path? ###
if( File::Spec->file_name_is_absolute( $dirs ) ) {
@@ -490,7 +497,14 @@
} else {
my @dirs = File::Spec::Unix->splitdir( $dirs );
my @cwd = File::Spec->splitdir( $cwd );
- $dir = File::Spec->catdir(@cwd, @dirs);
+ $dir = File::Spec->catdir( @cwd, @dirs );
+
+ # catdir() returns undef if the path is longer than 255 chars on VMS
+ unless ( defined $dir ) {
+ $^W && $self->_error( qq[Could not compose a path for '$dirs'\n] );
+ return;
+ }
+
}
if( -e $dir && !-d _ ) {
diff -ru ../Archive-Tar-1.24/t/02_methods.t Archive-Tar-1.24/t/02_methods.t
--- ../Archive-Tar-1.24/t/02_methods.t Tue May 3 13:35:43 2005
+++ Archive-Tar-1.24/t/02_methods.t Wed May 4 18:09:23 2005
@@ -60,7 +60,7 @@
my $LONG_FILE = qq[directory/really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-really-long-directory-name/myfile];
### wintendo can't deal with too long paths, so we might have to skip tests ###
-my $TOO_LONG = ($^O eq 'MSWin32' or $^O eq 'cygwin')
+my $TOO_LONG = ($^O eq 'MSWin32' or $^O eq 'cygwin' or $^O eq 'VMS')
&& length( cwd(). $LONG_FILE ) > 247;
### warn if we are going to skip long file names
@@ -85,8 +85,9 @@
my $OUT_TAR_FILE = File::Spec->catfile( @ROOT, 'out.tar' );
my $OUT_TGZ_FILE = File::Spec->catfile( @ROOT, 'out.tgz' );
-copy( File::Basename::basename($0), 'copy' );
-my $COMPRESS_FILE = 'copy';
+my $COMPRESS_FILE = 'copy';
+$^O eq 'VMS' and $COMPRESS_FILE .= '.';
+copy( File::Basename::basename($0), $COMPRESS_FILE );
chmod 0644, $COMPRESS_FILE;
### done setting up environment ###
@@ -557,6 +558,7 @@
my ($dir) = File::Spec::Unix->splitdir( $LONG_FILE );
rmtree $dir if $dir && -d $dir && not $NO_UNLINK;
+ 1 while unlink $COMPRESS_FILE;
}
###########################
@@ -579,7 +581,11 @@
sub rm {
my $x = shift;
- is_dir($x) ? rmtree($x) : unlink $x;
+ if ( is_dir($x) ) {
+ rmtree($x);
+ } else {
+ 1 while unlink $x;
+ }
}
sub check_tar_file {
@@ -678,7 +684,7 @@
like( $content, qr/$econtent/,
" Contents OK" );
- unlink $path unless $NO_UNLINK;
+ $NO_UNLINK or 1 while unlink $path;
### alternate extract path tests
### to abs and rel paths
@@ -687,8 +693,8 @@
File::Spec->catdir( @ROOT )
)
) {
-
- my $outfile = File::Spec->catfile( $outpath, $$ );
+
+ my $outfile = File::Spec->catfile( $outpath, $$ );
ok( $tar->extract_file( $file->full_path, $outfile ),
" Extracted file '$path' to $outfile" );