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.
Perl · Nov 19, 2013 · 1da2e9e · 1da2e9e
1 parent 0f24672
commit 1da2e9e
Show file tree

Hide file tree

Showing 2 changed files with 35 additions and 5 deletions.
diff --git 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
@@ -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";