Skip to content

Commit b43e3d9

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 a1af91d commit b43e3d9

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
@@ -6424,6 +6424,7 @@ t/op/range.t See if .. works
64246424
t/op/read.t See if read() works
64256425
t/op/readdir.t See if readdir() works
64266426
t/op/readline.t See if <> / readline / rcatline work
6427+
t/op/readline_nb.t Test <> error handling on non-blocking handles
64276428
t/op/recurse.t See if deep recursion works
64286429
t/op/ref.t See if refs and objects work
64296430
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
@@ -3985,6 +3985,21 @@ PP(pp_match)
39853985
return NORMAL;
39863986
}
39873987

3988+
/* errno can be either EAGAIN or EWOULDBLOCK for a socket() read that
3989+
is non-blocking but would have blocked if blocking
3990+
*/
3991+
PERL_STATIC_INLINE bool
3992+
error_is_would_block(int err) {
3993+
#ifdef EAGAIN
3994+
if (err == EAGAIN)
3995+
return true;
3996+
#endif
3997+
#ifdef EWOULDBLOCK
3998+
if (err == EWOULDBLOCK)
3999+
return true;
4000+
#endif
4001+
return false;
4002+
}
39884003

39894004
/* Perl_do_readline(): implement <$fh>, readline($fh) and glob('*.h')
39904005
*
@@ -4228,6 +4243,9 @@ Perl_do_readline(pTHX)
42284243
(STATUS_CURRENT & 0x80) ? ", core dumped" : "");
42294244
}
42304245
}
4246+
else if (error_is_would_block(errno)) {
4247+
PerlIO_clearerr(fp);
4248+
}
42314249

42324250
if (gimme == G_SCALAR) {
42334251
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)