File::Basename::dirname bugs

private-msgid: <12393.9701071719@tempest.cise.npl.co.uk>

diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm
index ad44c5d..af52c34 100644 (file)
--- a/lib/File/Basename.pm
+++ b/lib/File/Basename.pm
@@ -149,7 +149,7 @@ sub fileparse {
   }
   if ($fstype =~ /^MSDOS/i) {
     ($dirpath,$basename) = ($fullname =~ /^(.*[:\\\/])?(.*)/);
-    $dirpath .= '.\\' unless $dirpath =~ /\\$/;
+    $dirpath .= '.\\' unless $dirpath =~ /[\\\/]$/;
   }
   elsif ($fstype =~ /^MacOS/i) {
     ($dirpath,$basename) = ($fullname =~ /^(.*:)?(.*)/);
@@ -202,10 +202,11 @@ sub dirname {
     }
     if ($fstype =~ /MacOS/i) { return $dirname }
     elsif ($fstype =~ /MSDOS/i) { 
-        if ( $dirname =~ /:\\$/) { return $dirname }
-        chop $dirname;
-        $dirname =~ s:[^\\]+$:: unless length($basename);
-        $dirname = '.' unless length($dirname);
+        $dirname =~ s/([^:])[\\\/]*$/$1/;
+        unless( length($basename) ) {
+           ($basename,$dirname) = fileparse $dirname;
+           $dirname =~ s/([^:])[\\\/]*$/$1/;
+       }
     }
     elsif ($fstype =~ /AmigaOS/i) {
         if ( $dirname =~ /:$/) { return $dirname }
@@ -213,11 +214,12 @@ sub dirname {
         $dirname =~ s#[^:/]+$## unless length($basename);
     }
     else { 
-        if ( $dirname =~ m:^/+$:) { return '/'; }
-        chop $dirname;
-        $dirname =~ s:[^/]+$:: unless length($basename);
-        $dirname =~ s:/+$:: ;
-        $dirname = '.' unless length($dirname);
+        $dirname =~ s:(.)/*$:$1:;
+        unless( length($basename) ) {
+           local($File::Basename::Fileparse_fstype) = $fstype;
+           ($basename,$dirname) = fileparse $dirname;
+           $dirname =~ s:(.)/*$:$1:;
+       }
     }
 
     $dirname;

diff --git a/t/lib/basename.t b/t/lib/basename.t
index 56b1f7f..0f8a117 100755 (executable)
--- a/t/lib/basename.t
+++ b/t/lib/basename.t
@@ -7,7 +7,7 @@ BEGIN {
 
 use File::Basename qw(fileparse basename dirname);
 
-print "1..30\n";
+print "1..34\n";
 
 # import correctly?
 print +(defined(&basename) && !defined(&fileparse_set_fstype) ?
@@ -105,3 +105,16 @@ print +(basename(':arma:virumque:cano.trojae','.trojae') eq 'cano' ?
 print +(basename(':arma:virumque:cano_trojae','.trojae') eq 'cano_trojae' ?
         '' : 'not '),"ok 30\n";
 
+# extra tests for a few specific bugs
+
+File::Basename::fileparse_set_fstype 'MSDOS';
+# perl5.003_18 gives C:/perl/.\
+print +((fileparse 'C:/perl/lib')[1] eq 'C:/perl/' ? '' : 'not '), "ok 31\n";
+# perl5.003_18 gives C:\perl\
+print +(dirname('C:\\perl\\lib\\') eq 'C:\\perl' ? '' : 'not '), "ok 32\n";
+
+File::Basename::fileparse_set_fstype 'UNIX';
+# perl5.003_18 gives '.'
+print +(dirname('/perl/') eq '/' ? '' : 'not '), "ok 33\n";
+# perl5.003_18 gives '/perl/lib'
+print +(dirname('/perl/lib//') eq '/perl' ? '' : 'not '), "ok 34\n";