diff --git a/lib/Test/MockFile.pm b/lib/Test/MockFile.pm index bb842ed..60e1062 100644 --- a/lib/Test/MockFile.pm +++ b/lib/Test/MockFile.pm @@ -37,7 +37,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; @@ -2045,7 +2045,7 @@ sub __sysopen (*$$;$) { # O_NOFOLLOW if ( ( $sysopen_mode & O_NOFOLLOW ) == O_NOFOLLOW && $mock_file->is_link ) { - $! = 40; + $! = ELOOP; return undef; } @@ -2426,7 +2426,7 @@ sub __rmdir (_) { } if ( _files_in_dir($file) ) { - $! = 39; + $! = ENOTEMPTY; return 0; } diff --git a/lib/Test/MockFile/FileHandle.pm b/lib/Test/MockFile/FileHandle.pm index f5d4772..5e1d97f 100644 --- a/lib/Test/MockFile/FileHandle.pm +++ b/lib/Test/MockFile/FileHandle.pm @@ -179,30 +179,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 ) ); } diff --git a/t/portability_errno.t b/t/portability_errno.t new file mode 100644 index 0000000..a753d0e --- /dev/null +++ b/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(); diff --git a/t/rmdir.t b/t/rmdir.t index a58a6d3..84877d6 100644 --- a/t/rmdir.t +++ b/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' ); } );