Skip to content

Commit d57d976

Browse files
committed
readline: clear the error flag if the error happens to be EAGAIN
(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
1 parent 48972dd commit d57d976

File tree

3 files changed

+55
-0
lines changed

3 files changed

+55
-0
lines changed

MANIFEST

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6410,6 +6410,7 @@ t/op/range.t See if .. works
64106410
t/op/read.t See if read() works
64116411
t/op/readdir.t See if readdir() works
64126412
t/op/readline.t See if <> / readline / rcatline work
6413+
t/op/readline_nb.t Test <> error handling on non-blocking handles
64136414
t/op/recurse.t See if deep recursion works
64146415
t/op/ref.t See if refs and objects work
64156416
t/op/refstack.t See if a ref counted stack fixes things

pp_hot.c

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3994,6 +3994,21 @@ PP(pp_match)
39943994
return NORMAL;
39953995
}
39963996

3997+
/* errno can be either EAGAIN or EWOULDBLOCK for a socket() read that
3998+
is non-blocking but would have blocked if blocking
3999+
*/
4000+
PERL_STATIC_INLINE bool
4001+
error_is_would_block(int err) {
4002+
#ifdef EAGAIN
4003+
if (err == EAGAIN)
4004+
return true;
4005+
#endif
4006+
#ifdef EWOULDBLOCK
4007+
if (err == EWOULDBLOCK)
4008+
return true;
4009+
#endif
4010+
return false;
4011+
}
39974012

39984013
/* Perl_do_readline(): implement <$fh>, readline($fh) and glob('*.h')
39994014
*
@@ -4236,6 +4251,9 @@ Perl_do_readline(pTHX)
42364251
(STATUS_CURRENT & 0x80) ? ", core dumped" : "");
42374252
}
42384253
}
4254+
else if (error_is_would_block(errno)) {
4255+
PerlIO_clearerr(fp);
4256+
}
42394257

42404258
if (gimme == G_SCALAR) {
42414259
if (type != OP_RCATLINE) {

t/op/readline_nb.t

Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
#!./perl
2+
3+
BEGIN {
4+
chdir 't' if -d 't';
5+
require './test.pl';
6+
set_up_inc('../lib');
7+
require Config; Config->import;
8+
9+
skip_all_if_miniperl();
10+
}
11+
12+
use strict;
13+
use IO::Select;
14+
15+
$Config{d_pipe}
16+
or skip_all("No pipe");
17+
18+
my ($in, $out);
19+
pipe($in, $out)
20+
or skip_all("Cannot pipe: $!");
21+
22+
$in->blocking(0)
23+
or skip_all("Cannot make pipe non-blocking");
24+
25+
my $line = <$in>;
26+
is($line, undef, "error reading");
27+
ok(!$in->error, "but did not set error flag");
28+
close $out;
29+
$line = <$in>;
30+
is($line, undef, "nothing to read, but eof");
31+
ok(!$in->error, "still did not set error flag");
32+
ok($in->eof, "did set eof");
33+
ok(close($in), "close success");
34+
35+
36+
done_testing();

0 commit comments

Comments
 (0)