Integrate with vmsperl #7430 by Charles Bailey:

       Cleanup from prior patch (Charles Lane?):
            - improve handling of MFDs in Basename and Path
            - default to no xsubpp line # munging when building debug images

p4raw-id: //depot/perl@7445

2 files changed, 16 insertions, 9 deletions

diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm
index 4581e7e93c..243234403a 100644
--- a/lib/File/Basename.pm
+++ b/lib/File/Basename.pm
@@ -189,9 +189,13 @@ sub fileparse {
   }
   elsif ($fstype !~ /^VMS/i) {  # default to Unix
     ($dirpath,$basename) = ($fullname =~ m#^(.*/)?(.*)#s);
-    if ($^O eq 'VMS' and $fullname =~ m:/[^/]+/000000/?:) {
+    if ($^O eq 'VMS' and $fullname =~ m:^(/[^/]+/000000(/|$))(.*):) {
       # dev:[000000] is top of VMS tree, similar to Unix '/'
-      ($basename,$dirpath) = ('',$fullname);
+      # so strip it off and treat the rest as "normal"
+      my $devspec  = $1;
+      my $remainder = $3;
+      ($dirpath,$basename) = ($remainder =~ m#^(.*/)?(.*)#s);
+      $dirpath = $devspec.$dirpath;
     }
     $dirpath = './' unless $dirpath;
   }
diff --git a/lib/File/Path.pm b/lib/File/Path.pm
index daa2eae0fb..8b0772d0e1 100644
--- a/lib/File/Path.pm
+++ b/lib/File/Path.pm
@@ -119,16 +119,19 @@ sub mkpath {
     my(@created,$path);
     foreach $path (@$paths) {
 	$path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT 
-	next if -d $path;
 	# Logic wants Unix paths, so go with the flow.
-	$path = VMS::Filespec::unixify($path) if $Is_VMS;
-	my $parent = File::Basename::dirname($path);
-	# Allow for creation of new logical filesystems under VMS
-	if (not $Is_VMS or $parent !~ m:/[^/]+/000000/?:) {
-	    unless (-d $parent or $path eq $parent) {
-		push(@created,mkpath($parent, $verbose, $mode));
+	if ($Is_VMS) {
+	    next if $path eq '/';
+	    $path = VMS::Filespec::unixify($path);
+	    if ($path =~ m:^(/[^/]+)/?\z:) {
+	        $path = $1.'/000000';
 	    }
 	}
+	next if -d $path;
+	my $parent = File::Basename::dirname($path);
+	unless (-d $parent or $path eq $parent) {
+	    push(@created,mkpath($parent, $verbose, $mode));
+ 	}
 	print "mkdir $path\n" if $verbose;
 	unless (mkdir($path,$mode)) {
 	    my $e = $!;