[perl #28929] File::Find follow_fast => 1 loses dangling symlink

From: "Steve Peters via RT" <perlbug-followup@perl.org>
Message-ID: <rt-3.0.11-28929-100158.11.3214775505644@perl.org>

p4raw-id: //depot/perl@23510

diff --git a/lib/File/Find.pm b/lib/File/Find.pm
index 49fa48a..e25d9d8 100644 (file)
--- a/lib/File/Find.pm
+++ b/lib/File/Find.pm
@@ -3,7 +3,7 @@ use 5.006;
 use strict;
 use warnings;
 use warnings::register;
-our $VERSION = '1.07';
+our $VERSION = '1.08';
 require Exporter;
 require Cwd;
 
@@ -126,7 +126,8 @@ C<wanted()> function is called. This enables fast file checks involving S< _>.
 =item *
 
 There is a variable C<$File::Find::fullname> which holds the absolute
-pathname of the file with all symbolic links resolved
+pathname of the file with all symbolic links resolved.  If the link is
+a dangling symbolic link, then fullname will be set to C<undef>.
 
 =back
 
@@ -1101,7 +1102,21 @@ sub _find_dir_symlnk($$$) {
            $new_loc = Follow_SymLink($loc_pref.$FN);
 
            # ignore if invalid symlink
-           next unless defined $new_loc;
+            unless (defined $new_loc) {
+               if ($dangling_symlinks) {
+                   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;
+               $name = $dir_pref . $FN;
+               $_ = ($no_chdir ? $name : $FN);
+               { $wanted_callback->() };
+               next;
+           }
 
            if (-d _) {
                push @Stack,[$new_loc,$updir_loc,$dir_name,$FN,1];

diff --git a/lib/File/Find/t/find.t b/lib/File/Find/t/find.t
index 8512373..315ad31 100644 (file)
--- a/lib/File/Find/t/find.t
+++ b/lib/File/Find/t/find.t
@@ -661,6 +661,7 @@ if ( $symlink_exists ) {
        use warnings;
 
         %Expect_File = (File::Spec->curdir => 1,
+                       file_path('dangling_file_sl') => 1,
                        file_path('fa_ord') => 1,
                         file_path('fsl') => 1,
                         file_path('fb_ord') => 1,
@@ -684,7 +685,7 @@ if ( $symlink_exists ) {
                            topdir('dangling_dir_sl'), topdir('fa') );
 
         Check( scalar(keys %Expect_File) == 0 );
-        Check( $warn_msg =~ m|dangling_dir_sl is a dangling symbolic link| );  
+        Check( $warn_msg =~ m|dangling_file_sl is a dangling symbolic link| );  
         unlink file_path('fa', 'dangling_file_sl'),
                          file_path('dangling_dir_sl');
 
@@ -750,10 +751,7 @@ if ( $symlink_exists ) {
     File::Find::finddepth( {wanted => \&wanted_File_Dir, follow => 1,
                            follow_skip => 1, no_chdir => 1},
                            topdir('fa') );
-
-    Check( scalar(keys %Expect_File) == 1 );
-    # Only the file and its symlink have value 2;<
-    Check( (values %Expect_File)[0] == 2);
+    Check( scalar(keys %Expect_File) == 0 );
     unlink file_path('fa', 'fa_ord_sl');
 
 
@@ -814,13 +812,10 @@ if ( $symlink_exists ) {
     # If we encountered the symlink first, then the entries corresponding to
     # the real name remain, if the real name first then the symlink
     my @names = sort keys %Expect_File;
-    Check( @names == 2 );
-    # In sorted order the directory name comes first
-    Check ($names[1] =~ /^$names[0]/);
+    Check( @names == 1 );
     # Normalise both to the original name
     s/_sl// foreach @names;
-    Check ($names[0] eq file_path_name('fa', 'faa'));
-    Check ($names[1] eq file_path_name('fa', 'faa', 'faa_ord'));
+    Check ($names[0] eq file_path_name('fa', 'faa', 'faa_ord'));
     unlink file_path('fa', 'faa_sl');
 
 }