In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/039b3ea2b5ab903aaee0f1a1a89004571e78b740?hp=9fe558dc18b541114538e75431e9b31368d744c5>
- Log -----------------------------------------------------------------
commit 039b3ea2b5ab903aaee0f1a1a89004571e78b740
Author: Craig A. Berry <craigbe...@mac.com>
Date: Tue Aug 9 10:48:31 2016 -0500
Add Richard Levitte to AUTHORS.
M AUTHORS
commit e11f7a82751877fddd83adf7de4c5c15d0df3d33
Author: Richard Levitte <levi...@openssl.org>
Date: Tue Aug 9 10:22:56 2016 -0500
File::Spec::VMS->canonpath() incorrect with ODS-5 style directory specs.
I've found a bug in File::Spec::VMS->canonpath(), when a dash
component in a directory spec is preceded by a name containing an
escaped period.
My examples show quite clearly where things go wrong:
$ perl -e "use File::Spec::Functions; print
canonpath('foo:[bar.coo.kie.--]')"
foo:[bar]
check!
$ perl -e "use File::Spec::Functions; print
canonpath('foo:[bar^.coo.kie.--]')"
foo:[bar^.coo.-]
WRONG!
$ perl -e "use File::Spec::Functions; print
canonpath('foo:[bar.coo^.kie.--]')"
foo:[bar.coo^.kie.--]
WRONG!
$ perl -e "use File::Spec::Functions; print
canonpath('foo:[bar.coo.kie.-]')"
foo:[bar.coo]
check!
$ perl -e "use File::Spec::Functions; print
canonpath('foo:[bar^.coo.kie.-]')"
foo:[bar^.coo]
check!
$ perl -e "use File::Spec::Functions; print
canonpath('foo:[bar.coo^.kie.-]')"
foo:[bar.coo^.kie.-]
WRONG!
I've created a patch (attached) that solves the issue, with these
correct results (same paths)
[Committer's note: this fixes perl RT #128865]
M dist/PathTools/lib/File/Spec/VMS.pm
M dist/PathTools/t/Spec.t
-----------------------------------------------------------------------
Summary of changes:
AUTHORS | 1 +
dist/PathTools/lib/File/Spec/VMS.pm | 10 +++++-----
dist/PathTools/t/Spec.t | 7 +++++++
3 files changed, 13 insertions(+), 5 deletions(-)
diff --git a/AUTHORS b/AUTHORS
index 09d6d31..595f3f3 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -1035,6 +1035,7 @@ Richard Hitt <rb...@utsglobal.com>
Richard Kandarian <richard.kandar...@lanl.gov>
Richard L. England <richard_engl...@mentorg.com>
Richard L. Maus, Jr. <rm...@monmouth.com>
+Richard Levitte <levi...@openssl.org>
Richard Möhn <richard.mo...@fu-berlin.de>
Richard Ohnemus
<richard_ohne...@dallas.csd.sterling.com>
Richard Soderberg <p5-auth...@crystalflame.net>
diff --git a/dist/PathTools/lib/File/Spec/VMS.pm
b/dist/PathTools/lib/File/Spec/VMS.pm
index 2050d93..d836cbe 100644
--- a/dist/PathTools/lib/File/Spec/VMS.pm
+++ b/dist/PathTools/lib/File/Spec/VMS.pm
@@ -97,7 +97,7 @@ sub canonpath {
# [-.-. ==> [--.
# .-.-] ==> .--]
# [-.-] ==> [--]
- 1 while ($path =~ s/(?<!\^)([\[\.])[^\]\.]+\.-(-+)([\]\.])/$1$2$3/);
+ 1 while ($path =~
s/(?<!\^)([\[\.])(?:\^.|[^\]\.])+\.-(-+)([\]\.])/$1$2$3/);
# That loop does the following
# with any amount (minimum 2)
# of dashes:
@@ -108,11 +108,11 @@ sub canonpath {
#
# And then, the remaining cases
$path =~ s/(?<!\^)\[\.-/[-/; # [.- ==> [-
- $path =~ s/(?<!\^)\.[^\]\.]+\.-\./\./g; # .foo.-. ==> .
- $path =~ s/(?<!\^)\[[^\]\.]+\.-\./\[/g; # [foo.-. ==> [
- $path =~ s/(?<!\^)\.[^\]\.]+\.-\]/\]/g; # .foo.-] ==> ]
+ $path =~ s/(?<!\^)\.(?:\^.|[^\]\.])+\.-\./\./g; # .foo.-. ==> .
+ $path =~ s/(?<!\^)\[(?:\^.|[^\]\.])+\.-\./\[/g; # [foo.-. ==> [
+ $path =~ s/(?<!\^)\.(?:\^.|[^\]\.])+\.-\]/\]/g; # .foo.-] ==> ]
# [foo.-] ==> [000000]
- $path =~ s/(?<!\^)\[[^\]\.]+\.-\]/\[000000\]/g;
+ $path =~ s/(?<!\^)\[(?:\^.|[^\]\.])+\.-\]/\[000000\]/g;
# [] ==>
$path =~ s/(?<!\^)\[\]// unless $path eq '[]';
return $unix_rpt ? unixify($path) : $path;
diff --git a/dist/PathTools/t/Spec.t b/dist/PathTools/t/Spec.t
index 150c8d4..0255bdb 100644
--- a/dist/PathTools/t/Spec.t
+++ b/dist/PathTools/t/Spec.t
@@ -448,6 +448,13 @@ my @tests = (
# During the Perl 5.8 era, FS::Unix stopped eliminating redundant path
elements, so mimic that here.
[ "VMS->canonpath('a/../../b/c.dat')", $vms_unix_rpt ?
'a/../../b/c.dat' : '[-.b]c.dat' ],
[ "VMS->canonpath('^<test^.new.-.caret^ escapes^>')", $vms_unix_rpt ?
'/<test.new.-.caret escapes>' : '^<test^.new.-.caret^ escapes^>'
],
+# Check that directory specs with caret-dot component is treated correctly
+[ "VMS->canonpath('foo:[bar.coo.kie.--]file.txt')", $vms_unix_rpt ?
'/foo/bar/file.txt' : "foo:[bar]file.txt" ],
+[ "VMS->canonpath('foo:[bar^.coo.kie.--]file.txt')", $vms_unix_rpt ?
'/foo/file.txt' : "foo:[000000]file.txt" ],
+[ "VMS->canonpath('foo:[bar.coo^.kie.--]file.txt')", $vms_unix_rpt ?
'/foo/file.txt' : "foo:[000000]file.txt" ],
+[ "VMS->canonpath('foo:[bar.coo.kie.-]file.txt')", $vms_unix_rpt ?
'/foo/bar/coo/file.txt' : "foo:[bar.coo]file.txt" ],
+[ "VMS->canonpath('foo:[bar^.coo.kie.-]file.txt')", $vms_unix_rpt ?
'/foo/bar.coo/file.txt' : "foo:[bar^.coo]file.txt" ],
+[ "VMS->canonpath('foo:[bar.coo^.kie.-]file.txt')", $vms_unix_rpt ?
'/foo/bar/file.txt' : "foo:[bar]file.txt" ],
[ "VMS->splitdir('')", '' ],
[ "VMS->splitdir('[]')", '' ],
--
Perl5 Master Repository
