[PATCH: perl@20898] fix File::Spec->abs2rel() to return absolute $path more often for VMS

Greetings,

The enclosed patch to lib/File/Spec/VMS.pm and the Spec.t
test make the VMS paths returned by abs2rel() return
full specs more often than they used to so as to accomodate
problems when, e.g. an absolute path to say $^X was given
from a cwd that was set defaulted to using a rooted logical name.
The behavior of now favoring return values that are more often
absolute specs makes the behavior more like File::Spec::Win32
which will return values like so when run from cygwin:

$ pwd
/cygdrive/c/Documents and Settings/pprymmer
$ ls ntuser.ini
ntuser.ini
$ perl -MFile::Spec -e 'print File::Spec->abs2rel("C:\Documents and
Settings\\pprymmer\\ntuser.ini")'
C:Documents and Settings/pprymmer/ntuser.ini

In which the sameness of the native OS
path C<C:\Documents and Settings\pprymmer\ntuser.ini>
was not recognized as the same as the cygwin
bash path of C</cygdrive/c/Documents and Settings/pprymmer/ntuser.ini>
but a sensible string was nevertheless returned.

In clear text:

diff -ru perl_20898/lib/File/Spec/VMS.pm perl/lib/File/Spec/VMS.pm
--- perl_20898/lib/File/Spec/VMS.pm 2003-08-21 11:48:45.000000000 -0400
+++ perl/lib/File/Spec/VMS.pm 2003-08-30 00:12:42.000000000 -0400
@@ -412,6 +412,21 @@
         $base = $self->canonpath( $base ) ;
     }

+    # 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"
+    # but the comparison that ignores device differences so as to concatenate
+    # [---] up directory specs is not even a good idea in cases where there is
+    # a logical path difference between $path and $base nodename and/or device.
+    # Hence we fall back to returning the absolute $path spec
+    # if there is a case blind device (or node) difference of any sort
+    # and we do not even try to call $parse() or consult %ENV for $trnlnm()
+    # (this module needs to run on non VMS platforms after all).
+    my $path_device = ($self->splitpath( $path, 1 ))[0];
+    my $base_device = ($self->splitpath( $base, 1 ))[0];
+    if ( lc( $path_device ) ne lc( $base_device ) ) {
+        return ( $path ) ;
+    }
+
     # Split up paths
     my ( $path_directories, $path_file ) =
         ($self->splitpath( $path, 1 ))[1,2] ;
diff -ru perl_20898/lib/File/Spec/t/Spec.t perl/lib/File/Spec/t/Spec.t
--- perl_20898/lib/File/Spec/t/Spec.t     2003-08-21 12:21:08.000000000 -0400
+++ perl/lib/File/Spec/t/Spec.t     2003-08-30 00:04:48.000000000 -0400
@@ -304,8 +304,8 @@
 [ "VMS->catdir('[.name]')",                                               '[.name]'            ],
 [ "VMS->catdir('[.name]','[.name]')",                                     '[.name.name]'],

-[  "VMS->abs2rel('node::volume:[t1.t2.t3]','[t1.t2.t3]')", ''                 ],
-[  "VMS->abs2rel('node::volume:[t1.t2.t4]','[t1.t2.t3]')", '[-.t4]'           ],
+[  "VMS->abs2rel('node::volume:[t1.t2.t3]','node::volume:[t1.t2.t3]')", ''                 ],
+[  "VMS->abs2rel('node::volume:[t1.t2.t4]','node::volume:[t1.t2.t3]')", '[-.t4]'           ],
 [  "VMS->abs2rel('[t1.t2.t3]','[t1.t2.t3]')",              ''                 ],
 [  "VMS->abs2rel('[t1.t2.t3]file','[t1.t2.t3]')",          'file'             ],
 [  "VMS->abs2rel('[t1.t2.t4]','[t1.t2.t3]')",              '[-.t4]'           ],
@@ -313,7 +313,7 @@
 [  "VMS->abs2rel('[t1.t2.t3.t4]','[t1.t2.t3]')",           '[t4]'             ],
 [  "VMS->abs2rel('[t4.t5.t6]','[t1.t2.t3]')",              '[---.t4.t5.t6]'   ],
 [ "VMS->abs2rel('[000000]','[t1.t2.t3]')",                 '[---]'            ],
-[ "VMS->abs2rel('a:[t1.t2.t4]','[t1.t2.t3]')",             '[-.t4]'           ],
+[ "VMS->abs2rel('a:[t1.t2.t4]','a:[t1.t2.t3]')",             '[-.t4]'           ],
 [ "VMS->abs2rel('[a.-.b.c.-]','[t1.t2.t3]')",              '[---.b]'          ],

 [ "VMS->rel2abs('[.t4]','[t1.t2.t3]')",          '[t1.t2.t3.t4]'    ],
End of Patch.

And as a MIME attachment:

(See attached file: file_spec_20898.patch_2)

Peter Prymmer

• [PATCH: perl@20898] fix File::Spec->abs2rel() to return absolute $path more often for VMS by PPrymmer