Assorted File::stat changes and clean-up

lib/File/stat-7896.t

@@ -9,7 +9,7 @@ use File::stat;
 # should be revisited
 is($INC{'Symbol.pm'}, undef, "Symbol isn't loaded yet");
 
-# ID 20011110.104 (RT #7896)
+# ID 20011110.104 (RT #7896 / GH #4572)
 $! = 0;
 is($!, '', '$! is empty');
 is(File::stat::stat('/notafile'), undef, 'invalid file should fail');

lib/File/stat.pm

@@ -16,12 +16,12 @@ our ( $st_dev, $st_ino, $st_mode,
 
 use Exporter 'import';
 our @EXPORT      = qw(stat lstat);
-our @fields      = qw( $st_dev	   $st_ino    $st_mode
-		       $st_nlink   $st_uid    $st_gid 
-		       $st_rdev    $st_size 
-		       $st_atime   $st_mtime  $st_ctime 
-		       $st_blksize $st_blocks
-		    );
+our @fields      = qw( $st_dev     $st_ino    $st_mode
+                       $st_nlink   $st_uid    $st_gid
+                       $st_rdev    $st_size
+                       $st_atime   $st_mtime  $st_ctime
+                       $st_blksize $st_blocks
+                    );
 our @EXPORT_OK   = ( @fields, "stat_cando" );
 our %EXPORT_TAGS = ( FIELDS => [ @fields, @EXPORT ] );
 
@@ -73,7 +73,7 @@ sub _ingroup {
 # and interpreting it later would require this module to have an XS
 # component (at which point we might as well just call Perl_cando and
 # have done with it).
-    
+
 if (grep $^O eq $_, qw/os2 MSWin32/) {
 
     # from doio.c
@@ -152,7 +152,7 @@ my %op = (
 use constant HINT_FILETEST_ACCESS => 0x00400000;
 
 # we need fallback=>1 or stringifying breaks
-use overload 
+use overload
     fallback => 1,
     -X => sub {
         my ($s, $op) = @_;
@@ -179,36 +179,36 @@ use overload
 use Class::Struct qw(struct);
 struct 'File::stat' => [
      map { $_ => '$' } qw{
-	 dev ino mode nlink uid gid rdev size
-	 atime mtime ctime blksize blocks
+         dev ino mode nlink uid gid rdev size
+         atime mtime ctime blksize blocks
      }
 ];
 
 sub populate {
-    return unless @_;
+    return undef unless @_;
     my $stob = new();
     @$stob = (
-	$st_dev, $st_ino, $st_mode, $st_nlink, $st_uid, $st_gid, $st_rdev,
-        $st_size, $st_atime, $st_mtime, $st_ctime, $st_blksize, $st_blocks ) 
-	    = @_;
+        $st_dev, $st_ino, $st_mode, $st_nlink, $st_uid, $st_gid, $st_rdev,
+        $st_size, $st_atime, $st_mtime, $st_ctime, $st_blksize, $st_blocks )
+            = @_;
     return $stob;
-} 
+}
 
-sub lstat :prototype($) { populate(CORE::lstat(shift)) }
+sub lstat :prototype(_) ($arg) {
+    populate(CORE::lstat $arg)
+}
 
-sub stat :prototype($) {
-    my $arg = shift;
+sub stat :prototype(_) ($arg) {
     my $st = populate(CORE::stat $arg);
-    return $st if defined $st;
-    return if ref $arg;
+    return $st if defined $st || ref $arg;
     # ... maybe $arg is the name of a bareword handle?
     my $fh;
     {
         local $!;
         no strict 'refs';
         require Symbol;
         $fh = \*{ Symbol::qualify( $arg, caller() )};
-        return unless defined fileno $fh;
+        return undef unless defined fileno $fh;
     }
     return populate(CORE::stat $fh);
 }
@@ -221,34 +221,34 @@ File::stat - by-name interface to Perl's built-in stat() functions
 
 =head1 SYNOPSIS
 
- use File::stat;
- my $st = stat($file) or die "No $file: $!";
- if ( ($st->mode & 0111) && ($st->nlink > 1) ) {
-     print "$file is executable with lotsa links\n";
- } 
+    use File::stat;
+    my $st = stat($file) or die "No $file: $!";
+    if ( ($st->mode & 0111) && ($st->nlink > 1) ) {
+        print "$file is executable with lotsa links\n";
+    }
 
- if ( -x $st ) {
-     print "$file is executable\n";
- }
+    if ( -x $st ) {
+        print "$file is executable\n";
+    }
 
- use Fcntl "S_IRUSR";
- if ( $st->cando(S_IRUSR, 1) ) {
-     print "My effective uid can read $file\n";
- }
+    use Fcntl "S_IRUSR";
+    if ( $st->cando(S_IRUSR, 1) ) {
+        print "My effective uid can read $file\n";
+    }
 
- use File::stat qw(:FIELDS);
- stat($file) or die "No $file: $!";
- if ( ($st_mode & 0111) && ($st_nlink > 1) ) {
-     print "$file is executable with lotsa links\n";
- } 
+    use File::stat qw(:FIELDS);
+    stat($file) or die "No $file: $!";
+    if ( ($st_mode & 0111) && ($st_nlink > 1) ) {
+        print "$file is executable with lotsa links\n";
+    }
 
 =head1 DESCRIPTION
 
-This module's default exports override the core stat() 
-and lstat() functions, replacing them with versions that return 
+This module's default exports override the core stat()
+and lstat() functions, replacing them with versions that return
 "File::stat" objects.  This object has methods that
 return the similarly named structure field name from the
-stat(2) function; namely,
+L<stat(2)> function; namely,
 dev,
 ino,
 mode,
@@ -262,13 +262,13 @@ mtime,
 ctime,
 blksize,
 and
-blocks.  
+blocks.
 
 As of version 1.02 (provided with perl 5.12) the object provides C<"-X">
 overloading, so you can call filetest operators (C<-f>, C<-x>, and so
 on) on it. It also provides a C<< ->cando >> method, called like
 
- $st->cando( ACCESS, EFFECTIVE )
+    $st->cando( ACCESS, EFFECTIVE )
 
 where I<ACCESS> is one of C<S_IRUSR>, C<S_IWUSR> or C<S_IXUSR> from the
 L<Fcntl|Fcntl> module, and I<EFFECTIVE> indicates whether to use
@@ -288,23 +288,41 @@ variables named with a preceding C<st_> in front their method names.
 Thus, C<$stat_obj-E<gt>dev()> corresponds to $st_dev if you import
 the fields.
 
-To access this functionality without the core overrides,
-pass the C<use> an empty import list, and then access
-function functions with their full qualified names.
-On the other hand, the built-ins are still available
-via the C<CORE::> pseudo-package.
+To access this functionality without the core overrides, pass the C<use>
+an empty import list, and then access functions with their full qualified
+names:
+
+    use File::stat ();
+    my $st = File::stat::stat($file);
+
+On the other hand, the built-ins are still available via the C<CORE::>
+pseudo-package even if you let File::stat override them:
+
+    use File::stat;
+    my ($dev, $ino, $mode) = CORE::stat($file);
+
+As of version 1.15 (provided with perl 5.44) C<stat> and C<lstat> can be
+called without arguments, in which case C<$_> is used (just like the
+built-in C<stat>/C<lstat> functions):
+
+    my $st_1 = stat;   # stat($_)
+    my $st_2 = lstat;  # lstat($_)
 
 =head1 BUGS
 
-As of Perl 5.8.0 after using this module you cannot use the implicit
-C<$_> or the special filehandle C<_> with stat() or lstat(), trying
-to do so leads into strange errors.  The workaround is for C<$_> to
-be explicit
+The built-in C<stat> and C<lstat> functions recognize the special
+filehandle C<_> (underscore) to indicate that no actual C<stat> be done;
+instead the results of the last C<stat> or C<lstat> or filetest operation
+should be returned.  This syntax does not work with File::stat, but the
+same result can be achieved by passing C<stat> a reference to the C<*_>
+typeglob:
 
-    my $stat_obj = stat $_;
+    use File::stat;
+    my $stat_obj = stat \*_;  # reuse results of last stat operation
 
-and for C<_> to explicitly populate the object using the unexported
-and undocumented populate() function with CORE::stat():
+Alternatively, another workaround is to explicitly populate the object
+using the unexported and undocumented populate() function with
+CORE::stat():
 
     my $stat_obj = File::stat::populate(CORE::stat(_));
 
@@ -344,7 +362,7 @@ do not, since the information required is not available.
 
 =head1 NOTE
 
-While this class is currently implemented using the Class::Struct
+While this class is currently implemented using the L<Class::Struct>
 module to build a struct-like class, you shouldn't rely upon this.
 
 =head1 AUTHOR

lib/File/stat.t

@@ -154,32 +154,32 @@ for (split //, "tTB") {
 }
 
 SKIP: {
-	skip("Could not open file: $!", 2) unless $canopen;
-	isa_ok(File::stat::stat('STAT'), 'File::stat',
-	       '... should be able to find filehandle');
-
-	package foo;
-	local *STAT = *main::STAT;
-	my $stat2 = File::stat::stat('STAT');
-	main::isa_ok($stat2, 'File::stat',
-		     '... and filehandle in another package');
-	close STAT;
-
-#	VOS open() updates atime; ignore this error (posix-975).
-	my $stat3 = $stat2;
-	if ($^O eq 'vos') {
-		$$stat3[8] = $$stat[8];
-	}
+    skip("Could not open file: $!", 2) unless $canopen;
+    isa_ok(File::stat::stat('STAT'), 'File::stat',
+           '... should be able to find filehandle');
+
+    package foo;
+    local *STAT = *main::STAT;
+    my $stat2 = File::stat::stat('STAT');
+    main::isa_ok($stat2, 'File::stat',
+             '... and filehandle in another package');
+    close STAT;
+
+#   VOS open() updates atime; ignore this error (posix-975).
+    my $stat3 = $stat2;
+    if ($^O eq 'vos') {
+        $$stat3[8] = $$stat[8];
+    }
 
-	main::skip("Win32: different stat-info on filehandle", 1) if $^O eq 'MSWin32';
+    main::skip("Win32: different stat-info on filehandle", 1) if $^O eq 'MSWin32';
 
-	main::skip("OS/2: inode number is not constant on os/2", 1) if $^O eq 'os2';
+    main::skip("OS/2: inode number is not constant on os/2", 1) if $^O eq 'os2';
 
-	main::is_deeply($stat, $stat3, '... and must match normal stat');
+    main::is_deeply($stat, $stat3, '... and must match normal stat');
 }
 
 SKIP:
-{   # RT #111638
+{   # RT #111638 / GH #11992
     skip "We can't check for FIFOs", 2 unless defined &Fcntl::S_ISFIFO;
     skip "No pipes", 2 unless defined $Config{d_pipe};
     pipe my ($rh, $wh)
@@ -225,6 +225,34 @@ SKIP:
     is stat({}), undef, 'stat({}) fails by returning undef';
 }
 
+{
+    # list context
+
+    my @ret = stat '/ no such file';
+    is scalar(@ret), 1, 'stat returns one value in list context on failure';
+    is $ret[0], undef, 'stat returns undef on failure';
+
+    @ret = stat $file;
+    is scalar(@ret), 1, 'stat returns one value in list context on success';
+    isa_ok $ret[0], 'File::stat', 'successful stat in list context';
+}
+
+{
+    # implicit $_
+    $_ = $file;
+    my $st_1 = stat;
+    isa_ok $st_1, 'File::stat', 'stat()';
+
+    # reuse stat buffer
+    my $st_2 = stat \*_;
+    isa_ok $st_2, 'File::stat', 'stat(\\*_)';
+    # we can't verify directly that no actual stat() was done, but we can check
+    # that the returned device/inode match those of $file even though *_{IO}
+    # (the actual _ handle) was never opened
+    is $st_1->dev, $st_2->dev, 'stat(\\*_)->dev matches that of last stat()';
+    is $st_1->ino, $st_2->ino, 'stat(\\*_)->ino matches that of last stat()';
+}
+
 # Testing pretty much anything else is unportable.
 
 done_testing;

pod/perldelta.pod

@@ -135,9 +135,29 @@ XXX Remove this section if F<Porting/corelist-perldelta.pl> did not add any cont
 
 =item *
 
-L<XXX> has been upgraded from version A.xx to B.yy.
+L<File::stat> has been upgraded from version 1.14 to 1.15.
 
-XXX If there was something important to note about this change, include that here.
+=over 4
+
+=item *
+
+The overridden C<stat> and C<lstat> functions now always return a scalar value,
+even in list context. Previously a failed stat in list context would return an
+empty list; now it returns C<undef>.
+
+=item *
+
+C<stat> and C<lstat> can now be called without an argument, in which case they
+will use C<$_>, just like the built-in C<stat>/C<lstat> functions.
+
+=item *
+
+It is now safe to pass path objects (e.g. instances of L<Path::Tiny>) to
+C<stat>/C<lstat>. Previously a failed stat operation on such an object would
+die with a cryptic C<Not a GLOB reference at .../File/stat.pm line 208> error.
+[GH #23507]
+
+=back
 
 =back
 

t/porting/known_pod_issues.dat

@@ -255,6 +255,7 @@ Padre
 PadWalker
 Parse::Keyword
 passwd(1)
+Path::Tiny
 pclose(3)
 perl(1)
 Perl4::CoreLibs