From 0628dc7ef6a8750ad9f124dae161a246e092e417 Mon Sep 17 00:00:00 2001 From: Toddr Bot Date: Wed, 22 Jul 2026 05:30:29 +0000 Subject: [PATCH] fix: correct error returns in tied handle methods WRITE (syswrite) now returns undef on all error conditions instead of 0, matching real Perl behavior where undef signals error and 0 means zero bytes written. READ (sysread) data-gone case also corrected. GETC and READLINE on write-only handles now set $! = EBADF in addition to warning, matching real Perl's errno behavior. Closes #351 --- lib/Test/MockFile/FileHandle.pm | 14 ++++++++------ t/filehandle_cleanup.t | 2 +- t/filehandle_weakref.t | 8 ++++---- t/portability_errno.t | 8 ++++---- t/readline.t | 6 ++++++ t/sysreadwrite_edge_cases.t | 8 ++++---- t/write_tell.t | 6 +++--- 7 files changed, 30 insertions(+), 22 deletions(-) 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/filehandle_cleanup.t b/t/filehandle_cleanup.t index d9bfb04..7794f15 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" ); + is( $result, undef, "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..0f06965 100644 --- a/t/filehandle_weakref.t +++ b/t/filehandle_weakref.t @@ -51,7 +51,7 @@ subtest 'getc after mock destruction returns undef' => sub { close $fh; }; -subtest 'sysread after mock destruction returns 0' => sub { +subtest 'sysread after mock destruction returns undef' => sub { my $fh = _open_then_destroy_mock('/fake/sysread', "data"); my ($buf, $ret, $errno) = (''); @@ -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"); + is($ret, undef, "sysread returns undef on error"); 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"); + is($ret, undef, "syswrite returns undef on error"); 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..4a1f02f 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" ); + is( $ret, undef, "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" ); + is( $ret, undef, "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" ); + is( $ret, undef, "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" ); + is( $ret, undef, "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/readline.t b/t/readline.t index 7631872..856e65d 100644 --- a/t/readline.t +++ b/t/readline.t @@ -138,18 +138,22 @@ note "-------------- readline on write-only handle --------------"; { my $warn_msg; local $SIG{__WARN__} = sub { $warn_msg = shift }; + local $!; my $line = readline($wfh); ok( !defined $line, 'readline on write-only handle returns undef' ); like( $warn_msg, qr{opened only for output}, 'readline on write-only handle warns' ); + is( $! + 0, EBADF, 'readline on write-only handle sets $! to EBADF' ); } # List context { my $warn_msg; local $SIG{__WARN__} = sub { $warn_msg = shift }; + local $!; my @lines = <$wfh>; is( scalar @lines, 0, 'readline in list context on write-only handle returns empty list' ); like( $warn_msg, qr{opened only for output}, 'readline list context on write-only handle warns' ); + is( $! + 0, EBADF, 'readline list context on write-only handle sets $! to EBADF' ); } close $wfh; @@ -162,9 +166,11 @@ note "-------------- getc on write-only handle --------------"; my $warn_msg; local $SIG{__WARN__} = sub { $warn_msg = shift }; + local $!; my $ch = getc($wfh); ok( !defined $ch, 'getc on write-only handle returns undef' ); like( $warn_msg, qr{opened only for output}, 'getc on write-only handle warns' ); + is( $! + 0, EBADF, 'getc on write-only handle sets $! to EBADF' ); close $wfh; } diff --git a/t/sysreadwrite_edge_cases.t b/t/sysreadwrite_edge_cases.t index 1c2827b..3ce03fb 100644 --- a/t/sysreadwrite_edge_cases.t +++ b/t/sysreadwrite_edge_cases.t @@ -116,7 +116,7 @@ use Test::MockFile qw< nostrict >; } { - note "--- syswrite with non-numeric len warns and returns 0 ---"; + note "--- syswrite with non-numeric len warns and returns undef ---"; my $mock = Test::MockFile->file('/fake/sw_nonnumeric'); sysopen( my $fh, '/fake/sw_nonnumeric', O_WRONLY | O_CREAT | O_TRUNC ) or die; @@ -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" ); + is( $ret, undef, "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" ); @@ -136,7 +136,7 @@ use Test::MockFile qw< nostrict >; } { - note "--- syswrite with negative len warns and returns 0 ---"; + note "--- syswrite with negative len warns and returns undef ---"; my $mock = Test::MockFile->file('/fake/sw_neglen'); sysopen( my $fh, '/fake/sw_neglen', O_WRONLY | O_CREAT | O_TRUNC ) or die; @@ -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" ); + is( $ret, undef, "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..5e497d3 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" ); + is( $ret, undef, "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" ); + is( $ret, undef, "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" ); + is( $ret, undef, "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" );