In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/3aa68f86ad53a134998fbee61a4f85252e3d251b?hp=6a8b6cf093d76054742feb5b8ed9d170b868d0bc>
- Log -----------------------------------------------------------------
commit 3aa68f86ad53a134998fbee61a4f85252e3d251b
Author: Craig A. Berry <craigbe...@mac.com>
Date: Sat Nov 8 21:22:55 2014 -0600
Version bump for File::Spec::VMS.
M dist/PathTools/lib/File/Spec/VMS.pm
commit a0dc9691937ad77060951167326f14e544e5cc97
Author: Craig A. Berry <craigbe...@mac.com>
Date: Sat Nov 8 21:16:12 2014 -0600
Simplify abs2rel.t.
Factor out all the things that were common for the different test
cases (which was everything except the filename). And use made-up
names that indicate what's being tested rather than special system
filenames commonly found on Unix systems. Otherwise, if, for
example, a test for "'init.d' is a directory" fails, you'd be
wondering whether something is wrong with your system rather than
looking for problems in File::Spec, which is what we're testing.
M dist/PathTools/t/abs2rel.t
commit 44480951b76939c88af4b5ca1569a41062065177
Author: Craig A. Berry <craigbe...@mac.com>
Date: Sat Nov 8 21:08:16 2014 -0600
Fix undefined warning in File::Spec::VMS::catfile.
We had very carefully created a lexical variable to hold a default
result when the filename was undefined. Then we forgot to use it.
Now we use it.
M dist/PathTools/lib/File/Spec/VMS.pm
commit 40aa2760c83c095bb7adaa0f1ae5130a680e2042
Author: Craig A. Berry <craigbe...@mac.com>
Date: Sat Nov 8 18:43:15 2014 -0600
Force barename base to be a directory in File::Spec::VMS:abs2rel.
The docs say that the filename portion of base is ignored, but they
don't specify what happens when base is a single component without
directory syntax, leaving ambiguous whether it's a file or a Unix-
style directory spec. Let's default to the latter for greatest
consistency with what happens elsewhere.
M dist/PathTools/lib/File/Spec/VMS.pm
commit e4e41a3a51289b7c363b5cf48fbba9343adb5e62
Author: Craig A. Berry <craigbe...@mac.com>
Date: Sat Nov 8 18:27:44 2014 -0600
Revise Unix syntax detection File::Spec::VMS::abs2rel.
For a long time we've punted to the Unix method if either path or
base has a forward slash in it. But that really only works if
*both* are not native specs. So check for that by making sure we
don't have unescaped left bracket (square or angle) or colon in
either parameter before handing off to File::Spec::Unix::abs2rel.
M dist/PathTools/lib/File/Spec/VMS.pm
commit b4347c71ef148af0508b6416d20510f8a0f03302
Author: Craig A. Berry <craigbe...@mac.com>
Date: Sat Nov 8 18:13:38 2014 -0600
Move rel2abs earlier in File::Spec::VMS::abs2rel.
We need to make the path and base parameters absolute before
splitting them apart and comparing their pieces. Since rel2abs
will do its own canonpath, we don't need to do that anymore here.
M dist/PathTools/lib/File/Spec/VMS.pm
-----------------------------------------------------------------------
Summary of changes:
dist/PathTools/lib/File/Spec/VMS.pm | 14 ++++----
dist/PathTools/t/abs2rel.t | 69 ++++++++++---------------------------
2 files changed, 27 insertions(+), 56 deletions(-)
diff --git a/dist/PathTools/lib/File/Spec/VMS.pm
b/dist/PathTools/lib/File/Spec/VMS.pm
index d94de9f..f350918 100644
--- a/dist/PathTools/lib/File/Spec/VMS.pm
+++ b/dist/PathTools/lib/File/Spec/VMS.pm
@@ -4,7 +4,7 @@ use strict;
use vars qw(@ISA $VERSION);
require File::Spec::Unix;
-$VERSION = '3.51';
+$VERSION = '3.52';
$VERSION =~ tr/_//;
@ISA = qw(File::Spec::Unix);
@@ -204,7 +204,7 @@ sub catfile {
# Only passed a single file?
my $xfile = (defined($file) && length($file)) ? $file : '';
- $rslt = $unix_rpt ? $file : vmsify($file);
+ $rslt = $unix_rpt ? $xfile : vmsify($xfile);
}
return $self->canonpath($rslt) unless $unix_rpt;
@@ -439,12 +439,16 @@ Attempt to convert an absolute file specification to a
relative specification.
sub abs2rel {
my $self = shift;
return vmspath(File::Spec::Unix::abs2rel( $self, @_ ))
- if grep m{/}, @_;
+ if ((grep m{/}, @_) && !(grep m{(?<!\^)[\[<:]}, @_));
my($path,$base) = @_;
$base = $self->_cwd() unless defined $base and length $base;
- for ($path, $base) { $_ = $self->canonpath($_) }
+ # If there is no device or directory syntax on $base, make sure it
+ # is treated as a directory.
+ $base = VMS::Filespec::vmspath($base) unless $base =~ m{(?<!\^)[\[<:]};
+
+ for ($path, $base) { $_ = $self->rel2abs($_) }
# Are we even starting $path on the same (node::)device as $base? Note
that
# logical paths or nodename differences may be on the "same device"
@@ -460,8 +464,6 @@ sub abs2rel {
my ($base_volume, $base_directories, $base_file) = $self->splitpath($base);
return $path unless lc($path_volume) eq lc($base_volume);
- for ($path, $base) { $_ = $self->rel2abs($_) }
-
# Now, remove all leading components that are the same
my @pathchunks = $self->splitdir( $path_directories );
my $pathchunks = @pathchunks;
diff --git a/dist/PathTools/t/abs2rel.t b/dist/PathTools/t/abs2rel.t
index 008498d..5e33ab6 100644
--- a/dist/PathTools/t/abs2rel.t
+++ b/dist/PathTools/t/abs2rel.t
@@ -9,71 +9,40 @@ use File::Temp qw(tempdir);
use File::Path qw(make_path);
my $startdir = cwd();
+my @files = ( 'anyfile', './anyfile', '../first_sub_dir/anyfile',
'../second_sub_dir/second_file' );
-test_rel2abs( {
- startdir => $startdir,
- first_sub_dir => 'etc',
- sub_sub_dir => 'init.d',
- first_file => 'passwd',
- second_sub_dir => 'dev',
- second_file => 'null',
-} );
-
-test_rel2abs( {
- startdir => $startdir,
- first_sub_dir => 'etc',
- sub_sub_dir => 'init.d',
- first_file => './passwd',
- second_sub_dir => 'dev',
- second_file => 'null',
-} );
-
-test_rel2abs( {
- startdir => $startdir,
- first_sub_dir => 'etc',
- sub_sub_dir => 'init.d',
- first_file => '../etc/passwd',
- second_sub_dir => 'dev',
- second_file => 'null',
-} );
-
-test_rel2abs( {
- startdir => $startdir,
- first_sub_dir => 'etc',
- sub_sub_dir => 'init.d',
- first_file => '../dev/null',
- second_sub_dir => 'dev',
- second_file => 'null',
-} );
+for my $file (@files) {
+ test_rel2abs($file);
+}
sub test_rel2abs {
- my $args = shift;
+ my $first_file = shift;
my $tdir = tempdir( CLEANUP => 1 );
chdir $tdir or die "Unable to change to $tdir: $!";
my @subdirs = (
- $args->{first_sub_dir},
- File::Spec->catdir($args->{first_sub_dir}, $args->{sub_sub_dir}),
- $args->{second_sub_dir}
+ 'first_sub_dir',
+ File::Spec->catdir('first_sub_dir', 'sub_sub_dir'),
+ 'second_sub_dir'
);
make_path(@subdirs, { mode => 0711 })
or die "Unable to make_path: $!";
open my $OUT2, '>',
- File::Spec->catfile($args->{second_sub_dir}, $args->{second_file})
- or die "Unable to open $args->{second_file} for writing: $!";
+ File::Spec->catfile('second_sub_dir', 'second_file')
+ or die "Unable to open 'second_file' for writing: $!";
print $OUT2 "Attempting to resolve RT #121360\n";
- close $OUT2 or die "Unable to close $args->{second_file} after writing:
$!";
+ close $OUT2 or die "Unable to close 'second_file' after writing: $!";
- chdir $args->{first_sub_dir}
- or die "Unable to change to '$args->{first_sub_dir}': $!";
- open my $OUT1, '>', $args->{first_file}
- or die "Unable to open $args->{first_file} for writing: $!";
+ chdir 'first_sub_dir'
+ or die "Unable to change to 'first_sub_dir': $!";
+ open my $OUT1, '>', $first_file
+ or die "Unable to open $first_file for writing: $!";
print $OUT1 "Attempting to resolve RT #121360\n";
- close $OUT1 or die "Unable to close $args->{first_file} after writing: $!";
+ close $OUT1 or die "Unable to close $first_file after writing: $!";
- my $rel_path = $args->{first_file};
- my $rel_base = $args->{sub_sub_dir};
+ my $rel_path = $first_file;
+ my $rel_base = File::Spec->catdir(File::Spec->curdir(), 'sub_sub_dir');
my $abs_path = File::Spec->rel2abs($rel_path);
my $abs_base = File::Spec->rel2abs($rel_base);
ok(-f $rel_path, "'$rel_path' is readable by effective uid/gid");
@@ -101,7 +70,7 @@ sub test_rel2abs {
is($rr_link, $aa_link,
"rel_path-rel_base '$rr_link' = abs_path-abs_base '$aa_link'");
- chdir $args->{startdir} or die "Unable to change back to
$args->{startdir}: $!";
+ chdir $startdir or die "Unable to change back to $startdir: $!";
}
done_testing();
--
Perl5 Master Repository
