Skip to content

Fix: syswrite/sysread negative length should die, not warn #421

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
toddr-bot wants to merge 1 commit into
base: main
Choose a base branch
from
Draft

Fix: syswrite/sysread negative length should die, not warn #421

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 2 additions & 6 deletions lib/Test/MockFile/FileHandle.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down Expand Up @@ -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.
Expand Down
26 changes: 8 additions & 18 deletions t/portability_errno.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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;
};
Expand Down Expand Up @@ -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;
Expand Down
28 changes: 8 additions & 20 deletions t/sysreadwrite_edge_cases.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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" );
Expand Down Expand Up @@ -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;
}
Expand Down
Loading