From: Abigail Date: Fri, 20 Nov 2009 17:58:34 +0000 (+0100) Subject: Fix bug #68260 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=51393fc07355ffd0a4b6b212fd676ee37de23e09;p=p5sagit%2Fp5-mst-13.2.git 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(). --- diff --git a/lib/File/Find.pm b/lib/File/Find.pm index eddedbd..3cf14da 100644 --- 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 index 6a71f98..a59ea78 100644 --- 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); +}