fix: use stat (not lstat) for -p/-S/-b/-c in mock_all_from_stat

lib/Overload/FileCheck.pm

@@ -287,10 +287,11 @@ sub _check_from_stat {
     #   or if we let it fallback to the Perl OP
     # 2/ doing a second stat call in order to cache _
 
-    my $can_use_stat;
-    $can_use_stat = 1 if $check =~ qr{^[sfdMXxzACORWeorwugk]$};
+    # In Perl, only -l uses lstat (does not follow symlinks).
+    # All other file test ops use stat (follows symlinks).
+    my $use_lstat = ( $check eq 'l' );
 
-    my $stat_or_lstat = $can_use_stat ? 'stat' : 'lstat';
+    my $stat_or_lstat = $use_lstat ? 'lstat' : 'stat';
 
     my (@mocked_lstat_result) = $sub_for_stat->( $stat_or_lstat, $f_or_fh );
     if (   scalar @mocked_lstat_result == 1
@@ -307,14 +308,14 @@ sub _check_from_stat {
     # now performing a real stat call [ using the mocked stat function ]
     my ( @stat, @lstat );
 
-    if ($can_use_stat) {
-        no warnings;    # throw warnings with Perl <= 5.14
-        @stat = stat($f_or_fh) if defined $f_or_fh;
-    }
-    else {
+    if ($use_lstat) {
         no warnings;
         @lstat = lstat($f_or_fh) if defined $f_or_fh;
     }
+    else {
+        no warnings;    # throw warnings with Perl <= 5.14
+        @stat = stat($f_or_fh) if defined $f_or_fh;
+    }
 
     # Dispatch table mapping each check letter to its handler.
     # Closures capture @stat, @lstat, $optype, and $f_or_fh from the enclosing scope.
@@ -355,12 +356,14 @@ sub _check_from_stat {
         f => sub { _check_mode_type( $stat[ST_MODE],  S_IFREG ) },       # plain file
         d => sub { _check_mode_type( $stat[ST_MODE],  S_IFDIR ) },       # directory
 
-        # File type checks via mode bits (using @lstat — does not follow symlinks)
+        # Symlink check — only op that uses lstat (does not follow symlinks)
         l => sub { _check_mode_type( $lstat[ST_MODE], S_IFLNK ) },       # symbolic link
-        p => sub { _check_mode_type( $lstat[ST_MODE], S_IFIFO ) },       # named pipe (FIFO)
-        S => sub { _check_mode_type( $lstat[ST_MODE], S_IFSOCK ) },      # socket
-        b => sub { _check_mode_type( $lstat[ST_MODE], S_IFBLK ) },       # block special file
-        c => sub { _check_mode_type( $lstat[ST_MODE], S_IFCHR ) },       # character special file
+
+        # File type checks via mode bits (using @stat — follows symlinks like Perl)
+        p => sub { _check_mode_type( $stat[ST_MODE], S_IFIFO ) },        # named pipe (FIFO)
+        S => sub { _check_mode_type( $stat[ST_MODE], S_IFSOCK ) },       # socket
+        b => sub { _check_mode_type( $stat[ST_MODE], S_IFBLK ) },        # block special file
+        c => sub { _check_mode_type( $stat[ST_MODE], S_IFCHR ) },        # character special file
 
         # Age calculations: (basetime - timestamp) / seconds_per_day
         M => sub {
@@ -378,7 +381,7 @@ sub _check_from_stat {
     );
 
     my $handler = $dispatch{$check}
-        or die "Unknown check $check.\n";
+        or Carp::croak(qq[Unknown check '$check']);
     return $handler->();
 }
 
@@ -403,7 +406,7 @@ sub mock_stat {
 
     foreach my $opname (qw{stat lstat}) {
         my $optype = $MAP_FC_OP{$opname};
-        die qq[No optype found for $opname] unless $optype;
+        Carp::croak(qq[No optype found for $opname]) unless $optype;
 
         # plug the sub
         $_current_mocks->{$optype} = sub {

t/stat-dispatch-special-types.t

@@ -0,0 +1,144 @@
+#!/usr/bin/perl -w
+
+# Test that _check_from_stat uses stat (not lstat) for -p, -S, -b, -c checks,
+# matching real Perl semantics where these operators follow symlinks.
+#
+# Before this fix, -p/-S/-b/-c used lstat, so mocking a symlink that points
+# to a socket (for example) would incorrectly fail -S because lstat sees
+# symlink mode bits, not socket mode bits.
+
+use strict;
+use warnings;
+
+use Test2::Bundle::Extended;
+use Test2::Tools::Explain;
+use Test2::Plugin::NoWarnings;
+
+use Fcntl qw(S_IFIFO);
+use Overload::FileCheck q{:all};
+
+my $mock_path = '/test/special-file';
+
+subtest '-p/-S/-b/-c dispatch stat, not lstat' => sub {
+    my @types_seen;
+
+    mock_all_from_stat(
+        sub {
+            my ( $type, $file ) = @_;
+            if ( defined $file && $file eq $mock_path ) {
+                push @types_seen, $type;
+                return stat_as_socket();
+            }
+            return FALLBACK_TO_REAL_OP;
+        }
+    );
+
+    for my $check (qw( p S b c )) {
+        @types_seen = ();
+        # Just trigger the check to verify the stat_or_lstat argument
+        eval "no warnings; -$check '$mock_path'";
+        is( \@types_seen, ['stat'], "-$check dispatches stat, not lstat" );
+    }
+
+    unmock_all_file_checks();
+};
+
+subtest '-S detects socket through symlink mock' => sub {
+    mock_all_from_stat(
+        sub {
+            my ( $type, $file ) = @_;
+            return FALLBACK_TO_REAL_OP unless defined $file && $file eq $mock_path;
+
+            if ( $type eq 'lstat' ) {
+                # lstat sees the symlink itself
+                return stat_as_symlink();
+            }
+            # stat follows the symlink and sees the socket
+            return stat_as_socket();
+        }
+    );
+
+    ok( -S $mock_path, '-S returns true for symlink-to-socket (follows symlink via stat)' );
+    ok( !-f $mock_path, '-f returns false for socket' );
+
+    unmock_all_file_checks();
+};
+
+subtest '-p detects pipe through symlink mock' => sub {
+    mock_all_from_stat(
+        sub {
+            my ( $type, $file ) = @_;
+            return FALLBACK_TO_REAL_OP unless defined $file && $file eq $mock_path;
+
+            if ( $type eq 'lstat' ) {
+                return stat_as_symlink();
+            }
+            return [ 0, 0, S_IFIFO | 0644, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0 ];
+        }
+    );
+
+    ok( -p $mock_path, '-p returns true for symlink-to-pipe (follows symlink via stat)' );
+
+    unmock_all_file_checks();
+};
+
+subtest '-b detects block device through symlink mock' => sub {
+    mock_all_from_stat(
+        sub {
+            my ( $type, $file ) = @_;
+            return FALLBACK_TO_REAL_OP unless defined $file && $file eq $mock_path;
+
+            if ( $type eq 'lstat' ) {
+                return stat_as_symlink();
+            }
+            return stat_as_block();
+        }
+    );
+
+    ok( -b $mock_path, '-b returns true for symlink-to-block-device (follows symlink via stat)' );
+
+    unmock_all_file_checks();
+};
+
+subtest '-c detects char device through symlink mock' => sub {
+    mock_all_from_stat(
+        sub {
+            my ( $type, $file ) = @_;
+            return FALLBACK_TO_REAL_OP unless defined $file && $file eq $mock_path;
+
+            if ( $type eq 'lstat' ) {
+                return stat_as_symlink();
+            }
+            return stat_as_chr();
+        }
+    );
+
+    ok( -c $mock_path, '-c returns true for symlink-to-char-device (follows symlink via stat)' );
+
+    unmock_all_file_checks();
+};
+
+subtest '-l still uses lstat correctly' => sub {
+    my @types_seen;
+
+    mock_all_from_stat(
+        sub {
+            my ( $type, $file ) = @_;
+            return FALLBACK_TO_REAL_OP unless defined $file && $file eq $mock_path;
+            push @types_seen, $type;
+
+            if ( $type eq 'lstat' ) {
+                return stat_as_symlink();
+            }
+            return stat_as_file();
+        }
+    );
+
+    @types_seen = ();
+    ok( -l $mock_path, '-l returns true for symlink' );
+    is( \@types_seen, ['lstat'], '-l dispatches lstat, not stat' );
+
+    unmock_all_file_checks();
+};
+
+done_testing;