diff --git a/lib/Test/MockFile/FileHandle.pm b/lib/Test/MockFile/FileHandle.pm index b857b8a..4074e55 100644 --- a/lib/Test/MockFile/FileHandle.pm +++ b/lib/Test/MockFile/FileHandle.pm @@ -108,7 +108,7 @@ sub _write_bytes { my $data = $self->{'data'} or do { $! = EBADF; - return 0; + return undef; }; my $tell = $self->{'tell'}; @@ -218,13 +218,13 @@ sub WRITE { if ( !$self->{'write'} ) { $! = EBADF; - return 0; + return undef; } unless ( $len =~ m/^-?[0-9.]+$/ ) { CORE::warn(qq{Argument "$len" isn't numeric in syswrite at @{[ join ' line ', (caller)[1,2] ]}.\n}); $! = EINVAL; - return 0; + return undef; } $len = int($len); # Perl seems to do this to floats. @@ -232,7 +232,7 @@ sub WRITE { if ( $len < 0 ) { CORE::warn(qq{Negative length at @{[ join ' line ', (caller)[1,2] ]}.\n}); $! = EINVAL; - return 0; + return undef; } my $strlen = length($buf); @@ -245,7 +245,7 @@ sub WRITE { if ( $offset < 0 || $offset > $strlen ) { CORE::warn(qq{Offset outside string at @{[ join ' line ', (caller)[1,2] ]}.\n}); $! = EINVAL; - return 0; + return undef; } # Write directly — syswrite must NOT inherit $, or $\ from PRINT. @@ -346,6 +346,7 @@ sub READLINE { if ( !$self->{'read'} ) { my $path = $self->{'file'} // 'unknown'; CORE::warn("Filehandle $path opened only for output"); + $! = EBADF; return; } @@ -388,6 +389,7 @@ sub GETC { if ( !$self->{'read'} ) { my $path = $self->{'file'} // 'unknown'; CORE::warn("Filehandle $path opened only for output"); + $! = EBADF; return undef; } @@ -439,7 +441,7 @@ sub READ { my $data = $self->{'data'} or do { $! = EBADF; - return 0; + return undef; }; my $contents_len = length $data->{'contents'}; diff --git a/t/fh_error_returns.t b/t/fh_error_returns.t new file mode 100644 index 0000000..888fc4d --- /dev/null +++ b/t/fh_error_returns.t @@ -0,0 +1,115 @@ +#!/usr/bin/perl -w + +use strict; +use warnings; + +use Test2::Bundle::Extended; +use Test2::Tools::Explain; +use Test2::Tools::Warnings qw/warning/; + +use Errno qw/EBADF EINVAL/; + +use Test::MockFile qw< nostrict >; + +# These tests verify that tied filehandle methods return the correct values +# on error, matching real Perl I/O behavior. + +subtest "syswrite on read-only handle returns undef and sets EBADF" => sub { + my $mock = Test::MockFile->file( '/tmp/ro_file', 'hello' ); + open my $fh, '<', '/tmp/ro_file' or die "open failed: $!"; + + $! = 0; + my $ret; + my $warn = warning { $ret = syswrite( $fh, "test" ) }; + ok( !defined $ret, 'syswrite on read-only handle returns undef, not 0' ); + is( $! + 0, EBADF, '$! is EBADF after syswrite on read-only handle' ); + + close $fh; +}; + +subtest "syswrite returns undef on EINVAL (non-numeric length)" => sub { + my $mock = Test::MockFile->file( '/tmp/write_file', '' ); + open my $fh, '>', '/tmp/write_file' or die "open failed: $!"; + + $! = 0; + my $ret; + my $warn = warning { $ret = syswrite( $fh, "hello", "abc" ) }; + ok( !defined $ret, 'syswrite with non-numeric length returns undef' ); + is( $! + 0, EINVAL, '$! is EINVAL after syswrite with non-numeric length' ); + + close $fh; +}; + +subtest "syswrite returns undef on EINVAL (bad offset)" => sub { + my $mock = Test::MockFile->file( '/tmp/write_file2', '' ); + open my $fh, '>', '/tmp/write_file2' or die "open failed: $!"; + + $! = 0; + my $ret; + my $warn = warning { $ret = syswrite( $fh, "hello", 3, 100 ) }; + ok( !defined $ret, 'syswrite with offset past string returns undef' ); + is( $! + 0, EINVAL, '$! is EINVAL after syswrite with bad offset' ); + + close $fh; +}; + +subtest "sysread on destroyed mock returns undef (not 0)" => sub { + my $fh; + { + my $mock = Test::MockFile->file( '/tmp/ephemeral', 'data' ); + open $fh, '<', '/tmp/ephemeral' or die "open failed: $!"; + } + # Mock is now out of scope — data weakref is gone + + $! = 0; + my $buf; + my $ret = sysread( $fh, $buf, 10 ); + ok( !defined $ret, 'sysread on destroyed mock returns undef' ); + is( $! + 0, EBADF, '$! is EBADF after sysread on destroyed mock' ); + + close $fh; +}; + +subtest "readline on write-only handle sets EBADF" => sub { + my $mock = Test::MockFile->file( '/tmp/wo_file', 'content' ); + open my $fh, '>', '/tmp/wo_file' or die "open failed: $!"; + + $! = 0; + my $line; + my $warn = warning { $line = readline($fh) }; + ok( !defined $line, 'readline on write-only handle returns undef' ); + is( $! + 0, EBADF, '$! is EBADF after readline on write-only handle' ); + + close $fh; +}; + +subtest "getc on write-only handle sets EBADF" => sub { + my $mock = Test::MockFile->file( '/tmp/wo_file2', 'content' ); + open my $fh, '>', '/tmp/wo_file2' or die "open failed: $!"; + + $! = 0; + my $c; + my $warn = warning { $c = getc($fh) }; + ok( !defined $c, 'getc on write-only handle returns undef' ); + is( $! + 0, EBADF, '$! is EBADF after getc on write-only handle' ); + + close $fh; +}; + +subtest "syswrite on destroyed mock returns undef" => sub { + my $fh; + { + my $mock = Test::MockFile->file( '/tmp/ephemeral2', '' ); + open $fh, '>', '/tmp/ephemeral2' or die "open failed: $!"; + } + + $! = 0; + my $ret; + my $warn = warning { $ret = syswrite( $fh, "test" ) }; + ok( !defined $ret, 'syswrite on destroyed mock returns undef' ); + is( $! + 0, EBADF, '$! is EBADF after syswrite on destroyed mock' ); + + close $fh; +}; + +done_testing(); diff --git a/t/filehandle_cleanup.t b/t/filehandle_cleanup.t index d9bfb04..ea96d5f 100644 --- a/t/filehandle_cleanup.t +++ b/t/filehandle_cleanup.t @@ -102,7 +102,7 @@ note "--- syswrite with negative offset ---"; my @warnings; local $SIG{__WARN__} = sub { push @warnings, $_[0] }; my $result = syswrite( $fh, $buf, 2, -10 ); - is( $result, 0, "syswrite with out-of-bounds negative offset returns 0" ); + ok( !defined $result, "syswrite with out-of-bounds negative offset returns undef" ); ok( scalar @warnings, "warning emitted for out-of-bounds offset" ); like( $warnings[0], qr/Offset outside string/, "warning mentions offset" ); close($fh); diff --git a/t/filehandle_weakref.t b/t/filehandle_weakref.t index 04da368..36ddcb9 100644 --- a/t/filehandle_weakref.t +++ b/t/filehandle_weakref.t @@ -60,7 +60,7 @@ subtest 'sysread after mock destruction returns 0' => sub { $errno = $! + 0; }; ok($ok, "sysread does not crash after mock destruction"); - is($ret, 0, "sysread returns 0 bytes"); + ok(!defined $ret, "sysread returns undef (EBADF)"); is($errno, EBADF, "errno is EBADF after sysread on destroyed mock"); close $fh; @@ -96,7 +96,7 @@ subtest 'printf after mock destruction returns false' => sub { close $fh; }; -subtest 'syswrite after mock destruction returns 0' => sub { +subtest 'syswrite after mock destruction returns undef' => sub { my $fh = _open_then_destroy_mock('/fake/syswrite', '', '>'); my ($ret, $errno); @@ -105,7 +105,7 @@ subtest 'syswrite after mock destruction returns 0' => sub { $errno = $! + 0; }; ok($ok, "syswrite does not crash after mock destruction"); - is($ret, 0, "syswrite returns 0 bytes"); + ok(!defined $ret, "syswrite returns undef (EBADF)"); is($errno, EBADF, "errno is EBADF after syswrite on destroyed mock"); close $fh; diff --git a/t/portability_errno.t b/t/portability_errno.t index fe815db..8cefb25 100644 --- a/t/portability_errno.t +++ b/t/portability_errno.t @@ -45,7 +45,7 @@ subtest "syswrite with non-numeric length warns" => sub { local $SIG{__WARN__} = sub { push @warnings, $_[0] }; my $ret = syswrite( $fh, "hello", "abc" ); - is( $ret, 0, "syswrite with non-numeric len returns 0" ); + ok( !defined $ret, "syswrite with non-numeric len returns undef" ); is( $! + 0, EINVAL, "\$! is set to EINVAL" ); ok( scalar @warnings >= 1, "got a warning" ); like( $warnings[0], qr/isn't numeric/, "warning mentions non-numeric argument" ) if @warnings; @@ -61,7 +61,7 @@ subtest "syswrite with negative length warns" => sub { local $SIG{__WARN__} = sub { push @warnings, $_[0] }; my $ret = syswrite( $fh, "hello", -1 ); - is( $ret, 0, "syswrite with negative length returns 0" ); + ok( !defined $ret, "syswrite with negative length returns undef" ); is( $! + 0, EINVAL, "\$! is set to EINVAL" ); ok( scalar @warnings >= 1, "got a warning" ); like( $warnings[0], qr/Negative length/, "warning mentions negative length" ) if @warnings; @@ -77,7 +77,7 @@ subtest "syswrite with offset outside string warns" => sub { 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( !defined $ret, "syswrite with offset beyond string returns undef" ); is( $! + 0, EINVAL, "\$! is set to EINVAL" ); ok( scalar @warnings >= 1, "got a warning" ); like( $warnings[0], qr/Offset outside string/, "warning mentions offset" ) if @warnings; @@ -104,7 +104,7 @@ subtest "syswrite with too-negative offset warns" => sub { 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( !defined $ret, "syswrite with offset before start of string returns undef" ); is( $! + 0, EINVAL, "\$! is set to EINVAL" ); ok( scalar @warnings >= 1, "got a warning" ); like( $warnings[0], qr/Offset outside string/, "warning mentions offset" ) if @warnings; diff --git a/t/sysreadwrite_edge_cases.t b/t/sysreadwrite_edge_cases.t index 1c2827b..fd28e7d 100644 --- a/t/sysreadwrite_edge_cases.t +++ b/t/sysreadwrite_edge_cases.t @@ -126,7 +126,7 @@ use Test::MockFile qw< nostrict >; $! = 0; my $ret = syswrite( $fh, "data", "abc" ); - is( $ret, 0, "syswrite with non-numeric len returns 0" ); + ok( !defined $ret, "syswrite with non-numeric len returns undef" ); is( $! + 0, EINVAL, "errno is EINVAL for non-numeric len" ); ok( @warns >= 1, "warning emitted for non-numeric len" ); like( $warns[0], qr/isn't numeric/, "warning mentions non-numeric argument" ); @@ -146,7 +146,7 @@ use Test::MockFile qw< nostrict >; $! = 0; my $ret = syswrite( $fh, "data", -5 ); - is( $ret, 0, "syswrite with negative len returns 0" ); + ok( !defined $ret, "syswrite with negative len returns undef" ); is( $! + 0, EINVAL, "errno is EINVAL for negative len" ); ok( @warns >= 1, "warning emitted for negative len" ); like( $warns[0], qr/Negative length/, "warning mentions negative length" ); diff --git a/t/write_tell.t b/t/write_tell.t index 037d689..0ee07c3 100644 --- a/t/write_tell.t +++ b/t/write_tell.t @@ -323,7 +323,7 @@ use Test::MockFile qw< nostrict >; local $!; my $ret = syswrite( $fh, "nope", 4 ); - is( $ret, 0, "syswrite on read-only handle returns 0" ); + ok( !defined $ret, "syswrite on read-only handle returns undef" ); is( $! + 0, EBADF, "errno is EBADF for syswrite on read-only handle" ); close $fh; @@ -354,7 +354,7 @@ use Test::MockFile qw< nostrict >; my @warns; local $SIG{__WARN__} = sub { push @warns, $_[0] }; my $ret = syswrite( $fh, "abc", 3, -10 ); - is( $ret, 0, "syswrite with offset past buffer start returns 0" ); + ok( !defined $ret, "syswrite with offset past buffer start returns undef" ); is( $! + 0, EINVAL, "errno is EINVAL for out-of-bounds negative offset" ); ok( grep( /Offset outside string/, @warns ), "warning emitted for out-of-bounds negative offset" ); @@ -373,7 +373,7 @@ use Test::MockFile qw< nostrict >; my @warns; local $SIG{__WARN__} = sub { push @warns, $_[0] }; my $ret = syswrite( $fh, "abc", 3, 10 ); - is( $ret, 0, "syswrite with offset past buffer end returns 0" ); + ok( !defined $ret, "syswrite with offset past buffer end returns undef" ); is( $! + 0, EINVAL, "errno is EINVAL for out-of-bounds positive offset" ); ok( grep( /Offset outside string/, @warns ), "warning emitted for out-of-bounds positive offset" );