summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authorVictor Efimov <victor@vsespb.ru>2013-11-19 01:18:26 +0100
committerJames E Keenan <jkeenan@cpan.org>2013-11-19 01:18:26 +0100
commit1da2e9eb3a112ea133c6142767636b9b08f65930 (patch)
tree5bf5134a3ecf13729290f2153eb35b2139244801 /ext
parent0f24672021c6c5d7f398a81ee24305ae45c32779 (diff)
downloadperl-1da2e9eb3a112ea133c6142767636b9b08f65930.tar.gz
Check symlink status before setting File::Find::fullname to undef.
Problem reported by James Avera in RT #120388. Patches supplied by Victor Efimov, then adapted to new testing functions in ext/File-Find/t/find.t.
Diffstat (limited to 'ext')
-rw-r--r--ext/File-Find/lib/File/Find.pm8
-rw-r--r--ext/File-Find/t/find.t32
2 files changed, 35 insertions, 5 deletions
diff --git a/ext/File-Find/lib/File/Find.pm b/ext/File-Find/lib/File/Find.pm
index a1799984fa..59953129cb 100644
--- a/ext/File-Find/lib/File/Find.pm
+++ b/ext/File-Find/lib/File/Find.pm
@@ -3,7 +3,7 @@ use 5.006;
use strict;
use warnings;
use warnings::register;
-our $VERSION = '1.25';
+our $VERSION = '1.26';
require Exporter;
require Cwd;
@@ -982,14 +982,16 @@ sub _find_dir_symlnk($$$) {
# ignore if invalid symlink
unless (defined $new_loc) {
if (!defined -l _ && $dangling_symlinks) {
+ $fullname = undef;
if (ref $dangling_symlinks eq 'CODE') {
$dangling_symlinks->($FN, $dir_pref);
} else {
warnings::warnif "$dir_pref$FN is a dangling symbolic link\n";
}
}
-
- $fullname = undef;
+ else {
+ $fullname = $loc_pref . $FN;
+ }
$name = $dir_pref . $FN;
$_ = ($no_chdir ? $name : $FN);
{ $wanted_callback->() };
diff --git a/ext/File-Find/t/find.t b/ext/File-Find/t/find.t
index db44ccd5cc..f44ef9c810 100644
--- a/ext/File-Find/t/find.t
+++ b/ext/File-Find/t/find.t
@@ -25,7 +25,7 @@ BEGIN {
my $symlink_exists = eval { symlink("",""); 1 };
my $test_count = 98;
-$test_count += 119 if $symlink_exists;
+$test_count += 127 if $symlink_exists;
$test_count += 26 if $^O eq 'MSWin32';
$test_count += 2 if $^O eq 'MSWin32' and $symlink_exists;
@@ -89,11 +89,14 @@ sub cleanup {
file_path('fa', 'fac', 'faca'),
file_path('fb', 'fb_ord'),
file_path('fb', 'fba', 'fba_ord'),
- file_path('fb', 'fbc', 'fbca');
+ file_path('fb', 'fbc', 'fbca'),
+ file_path('fa', 'fax', 'faz'),
+ file_path('fa', 'fay');
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', 'fax');
rmdir dir_path('fa');
rmdir dir_path('fb', 'fba');
rmdir dir_path('fb', 'fbc');
@@ -949,6 +952,31 @@ if ($symlink_exists) {
ok(!$dangling_symlink, "Found no dangling symlink");
}
+if ($symlink_exists) { # perl #120388
+ print "# BUG 120388\n";
+ mkdir_ok(dir_path ('fa', 'fax'), 0770);
+ create_file_ok(file_path ('fa', 'fax', 'faz'));
+ symlink_ok( file_path ('..', 'fa', 'fax', 'faz'), file_path ('fa', 'fay') );
+ my @seen;
+ File::Find::find( {wanted => sub {
+ if (/^fa[yz]$/) {
+ push @seen, $_;
+ ok(-e $File::Find::fullname,
+ "file identified by 'fullname' exists");
+ my $subdir = file_path qw/for_find fa fax faz/;
+ like(
+ $File::Find::fullname,
+ qr/\Q$subdir\E$/,
+ "fullname matches expected path"
+ );
+ }
+ }, follow => 1}, topdir('fa'));
+ # make sure "fay"(symlink) found before "faz"(real file);
+ # otherwise test invalid
+ is(join(',', @seen), 'fay,faz',
+ "symlink found before real file, as expected");
+}
+
##### Issue 59750 #####
print "# RT 59750\n";