Fix bug #68260

File::Find was not resolving paths of the form "/..////../" correctly. Fixed by adding a quantifier to the substitution parameter in contract_name().
Perl · Nov 20, 2009 · 51393fc · 51393fc
1 parent d521341
commit 51393fc
Show file tree

Hide file tree

Showing 2 changed files with 39 additions and 2 deletions.
diff --git a/lib/File/Find.pm b/lib/File/Find.pm
@@ -448,7 +448,7 @@ sub contract_name {
     my $abs_name= $cdir . $fn;
 
     if (substr($fn,0,3) eq '../') {
-       1 while $abs_name =~ s!/[^/]*/\.\./!/!;
+       1 while $abs_name =~ s!/[^/]*/\.\./+!/!;
     }
 
     return $abs_name;

diff --git a/lib/File/Find/t/find.t b/lib/File/Find/t/find.t
@@ -95,13 +95,17 @@ sub cleanup {
 	       file_path('fa', 'faa', 'faa_ord'),
 	       file_path('fa', 'fab', 'fab_ord'),
 	       file_path('fa', 'fab', 'faba', 'faba_ord'),
+               file_path('fa', 'fac', 'faca'),
 	       file_path('fb', 'fb_ord'),
-	       file_path('fb', 'fba', 'fba_ord');
+	       file_path('fb', 'fba', 'fba_ord'),
+               file_path('fb', 'fbc', 'fbca');
 	rmdir dir_path('fa', 'faa');
 	rmdir dir_path('fa', 'fab', 'faba');
 	rmdir dir_path('fa', 'fab');
+	rmdir dir_path('fa', 'fac');
 	rmdir dir_path('fa');
 	rmdir dir_path('fb', 'fba');
+	rmdir dir_path('fb', 'fbc');
 	rmdir dir_path('fb');
     }
     if ($need_updir) {
@@ -893,3 +897,36 @@ if ($^O eq 'MSWin32') {
     File::Find::find( {wanted => \&wanted_File_Dir, no_chdir => 1}, $volume . topdir('fa'));
     Check( scalar(keys %Expect_File) == 0 );
 }
+
+
+if ($symlink_exists) {  # Issue 68260
+    print "# BUG  68260\n";
+    MkDir (dir_path ('fa', 'fac'), 0770);
+    MkDir (dir_path ('fb', 'fbc'), 0770);
+    touch (file_path ('fa', 'fac', 'faca'));
+    if ($^O eq 'MacOS') {
+        CheckDie (symlink ('..::::..:fa:fac:faca', 'fb:fbc:fbca'));
+    }
+    else {
+        CheckDie (symlink ('..////../fa/fac/faca', 'fb/fbc/fbca'));
+    }
+
+    use warnings;
+    my $dangling_symlink;
+    local $SIG {__WARN__} = sub {
+        local $" = " ";
+        $dangling_symlink ++ if "@_" =~ /dangling symbolic link/;
+    };
+
+    File::Find::find (
+        {
+            wanted            => sub {1;},
+            follow            => 1,
+            follow_skip       => 2,
+            dangling_symlinks => 1,
+        },
+        File::Spec -> curdir
+    );
+
+    Check (!$dangling_symlink);
+}