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 @@ -6410,6 +6410,7 @@ t/op/range.t See if .. works
6410
6410
t/op/read.t See if read() works
6411
6411
t/op/readdir.t See if readdir() works
6412
6412
t/op/readline.t See if <> / readline / rcatline work
6413
+ t/op/readline_nb.t Test <> error handling on non-blocking handles
6413
6414
t/op/recurse.t See if deep recursion works
6414
6415
t/op/ref.t See if refs and objects work
6415
6416
t/op/refstack.t See if a ref counted stack fixes things
Original file line number Diff line number Diff line change @@ -3994,6 +3994,21 @@ PP(pp_match)
3994
3994
return NORMAL ;
3995
3995
}
3996
3996
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
+ }
3997
4012
3998
4013
/* Perl_do_readline(): implement <$fh>, readline($fh) and glob('*.h')
3999
4014
*
@@ -4236,6 +4251,9 @@ Perl_do_readline(pTHX)
4236
4251
(STATUS_CURRENT & 0x80 ) ? ", core dumped" : "" );
4237
4252
}
4238
4253
}
4254
+ else if (error_is_would_block (errno )) {
4255
+ PerlIO_clearerr (fp );
4256
+ }
4239
4257
4240
4258
if (gimme == G_SCALAR ) {
4241
4259
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