This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Check symlink status before setting File::Find::fullname to undef.
authorVictor Efimov <victor@vsespb.ru>
Tue, 19 Nov 2013 00:18:26 +0000 (01:18 +0100)
committerJames E Keenan <jkeenan@cpan.org>
Tue, 19 Nov 2013 00:18:26 +0000 (01:18 +0100)
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.

ext/File-Find/lib/File/Find.pm
ext/File-Find/t/find.t

index a179998..5995312 100644 (file)
@@ -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->() };
index db44ccd..f44ef9c 100644 (file)
@@ -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";