diff options
| author | Abigail <abigail@abigail.be> | 2009-11-20 18:58:34 +0100 |
|---|---|---|
| committer | Abigail <abigail@abigail.be> | 2009-11-20 18:58:34 +0100 |
| commit | 51393fc07355ffd0a4b6b212fd676ee37de23e09 (patch) | |
| tree | 6e4fd003d44a1c78d748c0909fae909f3e29525d /lib | |
| parent | d5213412bf7e51630c57470e49cc6b127a508ed6 (diff) | |
| download | perl-51393fc07355ffd0a4b6b212fd676ee37de23e09.tar.gz | |
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().
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/File/Find.pm | 2 | ||||
| -rw-r--r-- | lib/File/Find/t/find.t | 39 |
2 files changed, 39 insertions, 2 deletions
diff --git a/lib/File/Find.pm b/lib/File/Find.pm index eddedbd354..3cf14da2ab 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 6a71f98cb0..a59ea78162 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); +} |