File tree Expand file tree Collapse file tree 3 files changed +55
-0
lines changed Expand file tree Collapse file tree 3 files changed +55
-0
lines changed Original file line number Diff line number Diff line change @@ -6424,6 +6424,7 @@ t/op/range.t See if .. works
6424
6424
t/op/read.t See if read() works
6425
6425
t/op/readdir.t See if readdir() works
6426
6426
t/op/readline.t See if <> / readline / rcatline work
6427
+ t/op/readline_nb.t Test <> error handling on non-blocking handles
6427
6428
t/op/recurse.t See if deep recursion works
6428
6429
t/op/ref.t See if refs and objects work
6429
6430
t/op/refstack.t See if a ref counted stack fixes things
Original file line number Diff line number Diff line change @@ -3985,6 +3985,21 @@ PP(pp_match)
3985
3985
return NORMAL ;
3986
3986
}
3987
3987
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
+ }
3988
4003
3989
4004
/* Perl_do_readline(): implement <$fh>, readline($fh) and glob('*.h')
3990
4005
*
@@ -4228,6 +4243,9 @@ Perl_do_readline(pTHX)
4228
4243
(STATUS_CURRENT & 0x80 ) ? ", core dumped" : "" );
4229
4244
}
4230
4245
}
4246
+ else if (error_is_would_block (errno )) {
4247
+ PerlIO_clearerr (fp );
4248
+ }
4231
4249
4232
4250
if (gimme == G_SCALAR ) {
4233
4251
if (type != OP_RCATLINE ) {
Original file line number Diff line number Diff line change
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();
You can’t perform that action at this time.
0 commit comments