From: Charles Bailey Date: Mon, 6 Mar 2000 05:18:59 +0000 (+0000) Subject: Fix ricochet in File::Spec::VMS X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=178326fd1b9de4069eb9c6e8aa69cd11204783ae;p=p5sagit%2Fp5-mst-13.2.git Fix ricochet in File::Spec::VMS Fix eval error in filespec.t Misc. minor fixes in filespec.t p4raw-id: //depot/vmsperl@5571 --- diff --git a/lib/File/Spec/VMS.pm b/lib/File/Spec/VMS.pm index 9514dd7..aecaada 100644 --- a/lib/File/Spec/VMS.pm +++ b/lib/File/Spec/VMS.pm @@ -5,6 +5,7 @@ use vars qw(@ISA); require File::Spec::Unix; @ISA = qw(File::Spec::Unix); +use Cwd; use File::Basename; use VMS::Filespec; @@ -141,10 +142,12 @@ sub canonpath { else { return vmsify($path); } } else { - $path =~ s-\]\[--g; $path =~ s/> foo.bar - $path =~ s/([\[<])000000\./$1/; # [000000.foo ==> foo - $path =~ s/[\[<\.]([^\[<\.]+)\.-\.\1//g; # bar.foo.-.foo ==> bar. - if ($reduce_ricochet) { $path =~ s/[^\[\-<.]+\.\-//g; } + $path =~ s-\]\[--g; $path =~ s/> foo.bar + $path =~ s/([\[<])000000\./$1/; # [000000.foo ==> foo + if ($reduce_ricochet) { + $path =~ s/\.[^\[<\.]+\.-([\]\>])/$1/g; + $path =~ s/([\[<\.])([^\[<\.]+)\.-\.?/$1/g; + } return $path; } } diff --git a/t/lib/filespec.t b/t/lib/filespec.t index 9c273d2..0e4c131 100755 --- a/t/lib/filespec.t +++ b/t/lib/filespec.t @@ -205,12 +205,10 @@ BEGIN { [ "VMS->catpath('node\"access_spec\"::volume:','[d1.d2.d3]','file')", 'node"access_spec"::volume:[d1.d2.d3]file' ], [ "VMS->canonpath('')", '' ], -# There's no VMS specific canonpath -#[ "VMS->canonpath('volume:[d1]file')", 'volume:[d1]file' ], -#[ "VMS->canonpath('LOGICAL:[LOGICAL]LOGICAL')", 'LOGICAL:[VULCAN]LOGICAL' ], -#[ "VMS->canonpath('volume:[d1]d2.dir')", 'volume:[d1.d2]' ], -#[ "VMS->canonpath('volume:[d1]d2.dir;1')", 'volume:[d1.d2]' ], -#[ "VMS->canonpath('volume:[d1.d2.--]file')", 'volume:[d1.d2.-.-]file' ], +[ "VMS->canonpath('volume:[d1]file')", 'volume:[d1]file' ], +[ "VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]')", 'volume:[d1.-.d2.d3.d4.-]' ], +[ "VMS->canonpath('volume:[d1.-.d2.][d3.d4.-]',1)", 'volume:[d2.d3]' ], +[ "VMS->canonpath('volume:[000000.d1]d2.dir;1')", 'volume:[d1]d2.dir;1' ], [ "VMS->canonpath('///../../..//./././a//b/.././c/././')", '/a/b/../c' ], [ "VMS->splitdir('')", '' ], @@ -222,20 +220,17 @@ BEGIN { [ "VMS->splitdir('.-.d2.d3')", ',-,d2,d3' ], [ "VMS->splitdir('[.-.d2.d3]')", ',-,d2,d3' ], -[ "VMS->catdir('')", '[]' ], -[ "VMS->catdir('d1','d2','d3')", '[d1.d2.d3]' ], -[ "VMS->catdir('d1','d2/','d3')", '[d1.d2.d3]' ], +#[ "VMS->catdir('')", '[]' ], +[ "VMS->catdir('d1','d2','d3')", '[.d1.d2.d3]' ], +[ "VMS->catdir('d1','d2/','d3')", '[.d1.d2.d3]' ], [ "VMS->catdir('','d1','d2','d3')", '[.d1.d2.d3]' ], -[ "VMS->catdir('','-','d2','d3')", '[.-.d2.d3]' ], -[ "VMS->catdir('','-','d2','d3')", '[.-.d2.d3]' ], -[ "VMS->catdir('','-','','d3')", '[.-.d3]' ], -[ "VMS->catdir('[]','<->','[]','[d3]')", '[.-.d3]' ], -[ "VMS->catdir('dir.dir','d2.dir','d3.dir')", '[dir.d2.d3]' ], +[ "VMS->catdir('','-','d2','d3')", '[-.d2.d3]' ], +[ "VMS->catdir('','-','','d3')", '[-.d3]' ], +#[ "VMS->catdir('[]','<->','[]','[d3]')", '[-.d3]' ], +[ "VMS->catdir('dir.dir','d2.dir','d3.dir')", '[.dir.d2.d3]' ], [ "VMS->catdir('[.name]')", '[.name]' ], [ "VMS->catdir('[.name]','[.name]')", '[.name.name]'], -[ "VMS->catdir('a:[.name]','b:[.name]')", '[.name.name]'], -[ "VMS->catdir('LOGICAL:[.LOGICAL]LOGICAL','LOGICAL:[.LOGICAL]LOGICAL')", '[.LOGICAL.LOGICAL]'], -[ "VMS->catdir('LOGICAL','LOGICAL')", '[VULCAN.VULCAN]'], +#[ "VMS->catdir('a:[.name]','b:[.name]')", '[.name.name]'], [ "VMS->abs2rel('node::volume:[t1.t2.t3]','[t1.t2.t3]')", '' ], [ "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]' ], @@ -321,10 +316,10 @@ if ( $@ ) { # on VMS. It might be better to change File::Spec::VMS to do this, # making it more usable when running on (say) Unix but working with # VMS paths. - eval { - sub File::Spec::VMS::unixify { die "unixify() only provided on VMS" } ; - sub File::Spec::VMS::vmspath { die "vmspath() only provided on VMS" } ; - } ; + eval qq- + sub File::Spec::VMS::unixify { die "Install VMS::Filespec (from vms/ext)" } ; + sub File::Spec::VMS::vmspath { die "Install VMS::Filespec (from vms/ext)" } ; + - ; $INC{"VMS/Filespec.pm"} = 1 ; } require File::Spec::VMS ; @@ -336,9 +331,6 @@ print "1..", scalar( @tests ), "\n" ; my $current_test= 1 ; -# Set up for logical interpolation in ::VMS->canonpath() and ::VMS->catdir() -%ENV = ( 'LOGICAL' => 'VULCAN' ) ; - # Test out the class methods for ( @tests ) { tryfunc( @$_ ) ;