Hi all,
Today I noticed an intermittent failure in the scsh-process tests.
After some debugging, it turned out that my last patch for
fast_read_string_from_file() was incomplete; if we receive a signal
while reading and nothing has been read yet, fread() will return
exactly 0 bytes and set an error condition due to EINTR.
fast_read_string_from_file will then take the branch in library.scm:125:
...
} else if (ferror (fp)) {
if (0 == m) {
return C_SCHEME_FALSE;
}
}
...
This will not clear the error. I think this extra case at the start
is just mistaken, and should be ripped out. Attached is a patch which
does exactly that. This should simplify the function to be more
understandable. I've also taken the opportunity to replace some of
those evil []-style brackets with proper parentheses ;)
I'm unsure about fast_read_line_from_file(). At least I can't trigger
the error with the test program when using read-line instead of
read-string, so I guess this particular error situation is handled
correctly.
I've also attached a test program which triggers this bug on NetBSD.
On Linux I wasn't able to reproduce this bug (I think I've pointed
out before that it doesn't seem to return with EINTR on signals but
just restarts the read itself). Again I haven't added this to the
test suite because it's so specific to (Net)BSD.
Cheers,
Peter
--
http://sjamaan.ath.cx
--
"The process of preparing programs for a digital computer
is especially attractive, not only because it can be economically
and scientifically rewarding, but also because it can be an aesthetic
experience much like composing poetry or music."
-- Donald Knuth
>From 214ad34c65ab320ad5de2afbe2e1ea4d7bc15998 Mon Sep 17 00:00:00 2001
From: Peter Bex <peter....@xs4all.nl>
Date: Sat, 3 Nov 2012 21:47:11 +0100
Subject: [PATCH] Simplify and fix fast_read_string_from_file so it will
correctly keep reading when interrupted after having read 0
bytes (by always clearing errors)
---
library.scm | 27 ++++++++++-----------------
1 file changed, 10 insertions(+), 17 deletions(-)
diff --git a/library.scm b/library.scm
index 438004a..38cd477 100644
--- a/library.scm
+++ b/library.scm
@@ -117,16 +117,10 @@ fast_read_string_from_file(C_word dest, C_word port,
C_word len, C_word pos)
size_t m = fread (buf, sizeof (char), n, fp);
if (m < n) {
- if (feof (fp)) {
- if (0 == m)
- return C_SCHEME_END_OF_FILE;
- } else if (ferror (fp)) {
- if (0 == m) {
- return C_SCHEME_FALSE;
- } else {
- clearerr (fp);
- }
- }
+ if (ferror(fp)) /* Report to Scheme, which may retry, so clear errors */
+ clearerr(fp);
+ else if (feof(fp) && 0 == m) /* eof but m > 0? Return data first, below */
+ return C_SCHEME_END_OF_FILE; /* Calling again will get us here */
}
return C_fix (m);
@@ -1789,9 +1783,8 @@ EOF
(lambda (p n dest start) ; read-string!
(let loop ([rem (or n (fx- (##sys#size dest) start))] [act 0]
[start start])
(let ([len (##core#inline "fast_read_string_from_file" dest p rem
start)])
- (cond [(or (not len) ; error returns EOF
- (eof-object? len)) ; EOF returns 0 bytes read
- act]
+ (cond ((eof-object? len) ; EOF returns 0 bytes read
+ act)
((fx< len 0)
(##sys#update-errno)
(if (eq? (errno) (foreign-value "EINTR" int))
@@ -1803,10 +1796,10 @@ EOF
#:file-error 'read-string!
(##sys#string-append "cannot read from port - "
strerror)
p n dest start)))
- [(fx< len rem)
- (loop (fx- rem len) (fx+ act len) (fx+ start len))]
- [else
- (fx+ act len) ] ) )))
+ ((fx< len rem)
+ (loop (fx- rem len) (fx+ act len) (fx+ start len)))
+ (else
+ (fx+ act len) ) ) )))
(lambda (p rlimit) ; read-line
(if rlimit (##sys#check-exact rlimit 'read-line))
(let ((sblen read-line-buffer-initial-size))
--
1.7.12.2
(use posix extras)
(set-signal-handler! signal/chld void)
(let lp ((n 0))
(receive (in out)
(create-pipe)
(let ((pid1 (process-fork (lambda ()
(file-close in)
(fprintf (open-output-file* out)
"hi, there\n")
(exit 0))))
;; Trigger an early sigchld while reading from pid1's output
(pid2 (process-fork void)))
(file-close out)
(let ((res (read-string #f (open-input-file* in))))
(process-wait pid1)
(process-wait pid2)
(unless (string=? "hi, there\n" res)
(printf "ERROR after ~A runs, got ~S\n" n res)
(exit 1))))
(lp (fx+ n 1))))
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
