From 4e52148c80f411ae9c41a6aa3784c4ea6544d6a9 Mon Sep 17 00:00:00 2001 From: Toddr Bot Date: Wed, 22 Jul 2026 09:37:04 +0000 Subject: [PATCH] =?UTF-8?q?Fix=20syswrite/sysread=20negative=20length:=20w?= =?UTF-8?q?arn=20=E2=86=92=20die=20to=20match=20real=20Perl?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Real Perl's syswrite/sysread with a negative length argument is fatal (die), not a warning. The mock was using CORE::warn which let execution continue — diverging from real behavior and masking bugs in test suites. Co-Authored-By: Claude Opus 4.6 --- lib/Test/MockFile/FileHandle.pm | 8 ++------ t/portability_errno.t | 26 ++++++++------------------ t/sysreadwrite_edge_cases.t | 28 ++++++++-------------------- 3 files changed, 18 insertions(+), 44 deletions(-) diff --git a/lib/Test/MockFile/FileHandle.pm b/lib/Test/MockFile/FileHandle.pm index b857b8a..9294513 100644 --- a/lib/Test/MockFile/FileHandle.pm +++ b/lib/Test/MockFile/FileHandle.pm @@ -230,9 +230,7 @@ sub WRITE { $len = int($len); # Perl seems to do this to floats. if ( $len < 0 ) { - CORE::warn(qq{Negative length at @{[ join ' line ', (caller)[1,2] ]}.\n}); - $! = EINVAL; - return 0; + die qq{Negative length at @{[ join ' line ', (caller)[1,2] ]}.\n}; } my $strlen = length($buf); @@ -429,9 +427,7 @@ sub READ { $len = int($len); if ( $len < 0 ) { - CORE::warn(qq{Negative length at @{[ join ' line ', (caller)[1,2] ]}.\n}); - $! = EINVAL; - return undef; + die qq{Negative length at @{[ join ' line ', (caller)[1,2] ]}.\n}; } # If the caller's buffer is undef, we need to make it a string of 0 length to start out with. diff --git a/t/portability_errno.t b/t/portability_errno.t index fe815db..c96721d 100644 --- a/t/portability_errno.t +++ b/t/portability_errno.t @@ -53,18 +53,13 @@ subtest "syswrite with non-numeric length warns" => sub { close $fh; }; -subtest "syswrite with negative length warns" => sub { +subtest "syswrite with negative length dies (matches real Perl)" => 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" ); - 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; + my $ret = eval { syswrite( $fh, "hello", -1 ) }; + ok( !defined $ret, "syswrite with negative length dies" ); + like( $@, qr/Negative length/, "error message mentions negative length" ); close $fh; }; @@ -130,19 +125,14 @@ subtest "sysread with non-numeric length warns and returns undef" => sub { close $fh; }; -subtest "sysread with negative length warns and returns undef" => sub { +subtest "sysread with negative length dies (matches real Perl)" => sub { my $mock = Test::MockFile->file( '/tmp/read_test2', 'hello world' ); sysopen( my $fh, '/tmp/read_test2', O_RDONLY ) or die; - my @warnings; - local $SIG{__WARN__} = sub { push @warnings, $_[0] }; - my $buf = ''; - my $ret = sysread( $fh, $buf, -1 ); - ok( !defined $ret, "sysread 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; + my $ret = eval { sysread( $fh, $buf, -1 ) }; + ok( !defined $ret, "sysread with negative length dies" ); + like( $@, qr/Negative length/, "error message mentions negative length" ); is( $buf, '', "buffer is unchanged after failed sysread" ); close $fh; diff --git a/t/sysreadwrite_edge_cases.t b/t/sysreadwrite_edge_cases.t index 1c2827b..3d6fc41 100644 --- a/t/sysreadwrite_edge_cases.t +++ b/t/sysreadwrite_edge_cases.t @@ -136,20 +136,14 @@ use Test::MockFile qw< nostrict >; } { - note "--- syswrite with negative len warns and returns 0 ---"; + note "--- syswrite with negative len dies (matches real Perl) ---"; my $mock = Test::MockFile->file('/fake/sw_neglen'); sysopen( my $fh, '/fake/sw_neglen', O_WRONLY | O_CREAT | O_TRUNC ) or die; - my @warns; - local $SIG{__WARN__} = sub { push @warns, $_[0] }; - - $! = 0; - my $ret = syswrite( $fh, "data", -5 ); - is( $ret, 0, "syswrite with negative len returns 0" ); - 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" ); + my $ret = eval { syswrite( $fh, "data", -5 ) }; + ok( !defined $ret, "syswrite with negative len dies (returns undef from eval)" ); + like( $@, qr/Negative length/, "error message mentions negative length" ); close $fh; is( $mock->contents, '', "no data written with negative len" ); @@ -194,21 +188,15 @@ use Test::MockFile qw< nostrict >; } { - note "--- sysread with negative len warns and returns undef ---"; + note "--- sysread with negative len dies (matches real Perl) ---"; my $mock = Test::MockFile->file( '/fake/sr_neglen', "test data" ); sysopen( my $fh, '/fake/sr_neglen', O_RDONLY ) or die; - my @warns; - local $SIG{__WARN__} = sub { push @warns, $_[0] }; - my $buf = ""; - $! = 0; - my $ret = sysread( $fh, $buf, -3 ); - ok( !defined $ret, "sysread 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" ); + my $ret = eval { sysread( $fh, $buf, -3 ) }; + ok( !defined $ret, "sysread with negative len dies (returns undef from eval)" ); + like( $@, qr/Negative length/, "error message mentions negative length" ); close $fh; }