fix: portable errno constants (ELOOP, ENOTEMPTY) + WRITE validation

lib/Test/MockFile.pm

@@ -36,7 +36,7 @@ use Symbol;
 
 use Overload::FileCheck '-from-stat' => \&_mock_stat, q{:check};
 
-use Errno qw/EPERM ENOENT ELOOP EEXIST EISDIR ENOTDIR EINVAL/;
+use Errno qw/EPERM ENOENT ELOOP ENOTEMPTY EEXIST EISDIR ENOTDIR EINVAL/;
 
 use constant FOLLOW_LINK_MAX_DEPTH => 10;
 
@@ -1915,7 +1915,7 @@ sub __sysopen (*$$;$) {
 
     # O_NOFOLLOW
     if ( ( $sysopen_mode & O_NOFOLLOW ) == O_NOFOLLOW && $mock_file->is_link ) {
-        $! = 40;
+        $! = ELOOP;
         return undef;
     }
 
@@ -2289,7 +2289,7 @@ sub __rmdir (_) {
     }
 
     if ( _files_in_dir($file) ) {
-        $! = 39;
+        $! = ENOTEMPTY;
         return 0;
     }
 

lib/Test/MockFile/FileHandle.pm

@@ -150,30 +150,29 @@ sub WRITE {
     my ( $self, $buf, $len, $offset ) = @_;
 
     unless ( $len =~ m/^-?[0-9.]+$/ ) {
-        $! = qq{Argument "$len" isn't numeric in syswrite at ??};
+        CORE::warn(qq{Argument "$len" isn't numeric in syswrite at @{[ join ' line ', (caller)[1,2] ]}.\n});
         return 0;
     }
 
     $len = int($len);    # Perl seems to do this to floats.
 
     if ( $len < 0 ) {
-        $! = qq{Negative length at ???};
+        CORE::warn(qq{Negative length at @{[ join ' line ', (caller)[1,2] ]}.\n});
         return 0;
     }
 
     my $strlen = length($buf);
     $offset //= 0;
 
-    if ( $strlen - $offset < abs($len) ) {
-        $! = q{Offset outside string at ???.};
-        return 0;
-    }
-
-    $offset //= 0;
     if ( $offset < 0 ) {
         $offset = $strlen + $offset;
     }
 
+    if ( $offset < 0 || $offset + $len > $strlen ) {
+        CORE::warn(qq{Offset outside string at @{[ join ' line ', (caller)[1,2] ]}.\n});
+        return 0;
+    }
+
     return $self->PRINT( substr( $buf, $offset, $len ) );
 }
 

t/portability_errno.t

@@ -0,0 +1,111 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+use Test2::Bundle::Extended;
+use Test2::Tools::Explain;
+
+use Errno qw/ELOOP ENOTEMPTY ENOENT/;
+use Fcntl;
+
+use Test::MockFile qw< nostrict >;
+
+subtest "sysopen O_NOFOLLOW on symlink sets ELOOP" => sub {
+    my $target = Test::MockFile->file( '/tmp/real_file', 'data' );
+    my $link   = Test::MockFile->symlink( '/tmp/real_file', '/tmp/link_to_file' );
+
+    # O_NOFOLLOW on a regular file should work
+    $! = 0;
+    ok( sysopen( my $fh, '/tmp/real_file', O_RDONLY | O_NOFOLLOW ), "sysopen O_NOFOLLOW on regular file succeeds" );
+    close $fh if $fh;
+
+    # O_NOFOLLOW on a symlink should fail with ELOOP
+    $! = 0;
+    ok( !sysopen( my $fh2, '/tmp/link_to_file', O_RDONLY | O_NOFOLLOW ), "sysopen O_NOFOLLOW on symlink fails" );
+    is( $! + 0, ELOOP, "\$! is ELOOP (not hardcoded 40)" ) or diag "Got errno: " . ( $! + 0 ) . " ($!)";
+};
+
+subtest "rmdir non-empty directory sets ENOTEMPTY" => sub {
+    my $dir  = Test::MockFile->dir('/tmp/test_dir');
+    my $file = Test::MockFile->file( '/tmp/test_dir/child', 'content' );
+
+    mkdir('/tmp/test_dir');
+
+    $! = 0;
+    ok( !rmdir('/tmp/test_dir'), "rmdir on non-empty directory fails" );
+    is( $! + 0, ENOTEMPTY, "\$! is ENOTEMPTY (not hardcoded 39)" ) or diag "Got errno: " . ( $! + 0 ) . " ($!)";
+};
+
+subtest "syswrite with non-numeric length warns" => sub {
+    my $mock = Test::MockFile->file('/tmp/write_test');
+    sysopen( my $fh, '/tmp/write_test', O_WRONLY | O_CREAT | O_TRUNC ) or die;
+
+    my @warnings;
+    local $SIG{__WARN__} = sub { push @warnings, $_[0] };
+
+    my $ret = syswrite( $fh, "hello", "abc" );
+    is( $ret, 0, "syswrite with non-numeric len returns 0" );
+    ok( scalar @warnings >= 1, "got a warning" );
+    like( $warnings[0], qr/isn't numeric/, "warning mentions non-numeric argument" ) if @warnings;
+
+    close $fh;
+};
+
+subtest "syswrite with negative length warns" => sub {
+    my $mock = Test::MockFile->file('/tmp/write_test2');
+    sysopen( my $fh, '/tmp/write_test2', O_WRONLY | O_CREAT | O_TRUNC ) or die;
+
+    my @warnings;
+    local $SIG{__WARN__} = sub { push @warnings, $_[0] };
+
+    my $ret = syswrite( $fh, "hello", -1 );
+    is( $ret, 0, "syswrite with negative length returns 0" );
+    ok( scalar @warnings >= 1, "got a warning" );
+    like( $warnings[0], qr/Negative length/, "warning mentions negative length" ) if @warnings;
+
+    close $fh;
+};
+
+subtest "syswrite with offset outside string warns" => sub {
+    my $mock = Test::MockFile->file('/tmp/write_test3');
+    sysopen( my $fh, '/tmp/write_test3', O_WRONLY | O_CREAT | O_TRUNC ) or die;
+
+    my @warnings;
+    local $SIG{__WARN__} = sub { push @warnings, $_[0] };
+
+    my $ret = syswrite( $fh, "hello", 2, 100 );
+    is( $ret, 0, "syswrite with offset beyond string returns 0" );
+    ok( scalar @warnings >= 1, "got a warning" );
+    like( $warnings[0], qr/Offset outside string/, "warning mentions offset" ) if @warnings;
+
+    close $fh;
+};
+
+subtest "syswrite with valid negative offset works" => sub {
+    my $mock = Test::MockFile->file('/tmp/write_test4');
+    sysopen( my $fh, '/tmp/write_test4', O_WRONLY | O_CREAT | O_TRUNC ) or die;
+
+    # -3 from end of "hello" (len 5) = position 2, write 2 chars = "ll"
+    is( syswrite( $fh, "hello", 2, -3 ), 2, "syswrite with negative offset returns correct byte count" );
+    is( $mock->contents, "ll", "correct substring written with negative offset" );
+
+    close $fh;
+};
+
+subtest "syswrite with too-negative offset warns" => sub {
+    my $mock = Test::MockFile->file('/tmp/write_test5');
+    sysopen( my $fh, '/tmp/write_test5', O_WRONLY | O_CREAT | O_TRUNC ) or die;
+
+    my @warnings;
+    local $SIG{__WARN__} = sub { push @warnings, $_[0] };
+
+    my $ret = syswrite( $fh, "hello", 2, -10 );
+    is( $ret, 0, "syswrite with offset before start of string returns 0" );
+    ok( scalar @warnings >= 1, "got a warning" );
+    like( $warnings[0], qr/Offset outside string/, "warning mentions offset" ) if @warnings;
+
+    close $fh;
+};
+
+done_testing();

t/rmdir.t

@@ -7,7 +7,7 @@ use Test2::Bundle::Extended;
 use Test2::Tools::Explain;
 use Test2::Plugin::NoWarnings;
 
-use Errno qw/ENOENT EISDIR EEXIST ENOTDIR/;
+use Errno qw/ENOENT ENOTEMPTY EISDIR EEXIST ENOTDIR/;
 use File::Temp qw/tempfile tempdir/;
 
 my $temp_dir_name = tempdir( CLEANUP => 1 );
@@ -113,7 +113,7 @@ subtest(
 
         is( $! + 0, 0, 'No errors yet' );
         ok( !rmdir('/foo'), 'rmdir failed because directory has files' );
-        is( $! + 0, 39, '$! is set to correct perror (39)' );
+        is( $! + 0, ENOTEMPTY, '$! is ENOTEMPTY' );
     }
 );