Skip to content

Commit

Permalink
readline: clear the error flag if the error happens to be EAGAIN
Browse files Browse the repository at this point in the history
(or the equivalent EWOULDBLOCK)

This allows questionable code that tries to combine select and the
readline flavour of buffered I/O to limp along.  Such code is still
risky due to select() checking the underlying OS handle and not
the perl handle.

Fixes Perl#22883
  • Loading branch information
tonycoz committed Jan 9, 2025
1 parent 7a6c52e commit 7fba50a
Show file tree
Hide file tree
Showing 3 changed files with 55 additions and 0 deletions.
1 change: 1 addition & 0 deletions MANIFEST
Original file line number Diff line number Diff line change
Expand Up @@ -6404,6 +6404,7 @@ t/op/range.t See if .. works
t/op/read.t See if read() works
t/op/readdir.t See if readdir() works
t/op/readline.t See if <> / readline / rcatline work
t/op/readline_nb.t Test <> error handling on non-blocking handles
t/op/recurse.t See if deep recursion works
t/op/ref.t See if refs and objects work
t/op/refstack.t See if a ref counted stack fixes things
Expand Down
18 changes: 18 additions & 0 deletions pp_hot.c
Original file line number Diff line number Diff line change
Expand Up @@ -3994,6 +3994,21 @@ PP(pp_match)
return NORMAL;
}

/* errno can be either EAGAIN or EWOULDBLOCK for a socket() read that
is non-blocking but would have blocked if blocking
*/
PERL_STATIC_INLINE bool
error_is_would_block(int err) {
#ifdef EAGAIN
if (err == EAGAIN)
return true;
#endif
#ifdef EWOULDBLOCK
if (err == EWOULDBLOCK)
return true;
#endif
return false;
}

/* Perl_do_readline(): implement <$fh>, readline($fh) and glob('*.h')
*
Expand Down Expand Up @@ -4236,6 +4251,9 @@ Perl_do_readline(pTHX)
(STATUS_CURRENT & 0x80) ? ", core dumped" : "");
}
}
else if (error_is_would_block(errno)) {
PerlIO_clearerr(fp);
}

if (gimme == G_SCALAR) {
if (type != OP_RCATLINE) {
Expand Down
36 changes: 36 additions & 0 deletions t/op/readline_nb.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,36 @@
#!./perl

BEGIN {
chdir 't' if -d 't';
require './test.pl';
set_up_inc('../lib');
require Config; Config->import;

skip_all_if_miniperl();
}

use strict;
use IO::Select;

$Config{d_pipe}
or skip_all("No pipe");

my ($in, $out);
pipe($in, $out)
or skip_all("Cannot pipe: $!");

$in->blocking(0)
or skip_all("Cannot make pipe non-blocking");

my $line = <$in>;
is($line, undef, "error reading");
ok(!$in->error, "but did not set error flag");
close $out;
$line = <$in>;
is($line, undef, "nothing to read, but eof");
ok(!$in->error, "still did not set error flag");
ok($in->eof, "did set eof");
ok(close($in), "close success");


done_testing();

0 comments on commit 7fba50a

Please sign in to comment.