Check whether the file is opened non-blocking and call read-block with

'immediate in this case.
This commit is contained in:
mainzelm 2003-01-08 17:59:48 +00:00
parent 7e8b106c3a
commit 52c50f9410
1 changed files with 21 additions and 17 deletions

View File

@ -17,7 +17,7 @@
(start 0)
(end (string-length s)))
(if (bogus-substring-spec? s start end)
(error "Bad substring indices" s start end))
(error "Bad substring indices" s start end))
(cond ((integer? fd/port)
(let ((port (fdes->inport fd/port)))
@ -27,19 +27,26 @@
((open-input-port? fd/port)
(if (= start end)
0
(let* ((buffer (if (= start 0)
s
(make-string (- end start))))
(needed (if (> (byte-vector-length (port-buffer fd/port)) 1)
'any
'immediate)) ;bufpol/none may return with 0
(nread (read-block buffer 0 needed fd/port)))
(let* ((needed (if (= 0 (bitwise-and open/non-blocking
(fdes-status fd/port)))
'any
'immediate))
(nread (if (= end (string-length s))
(read-block s start needed fd/port)
;;; READ-BLOCK doesn't allow us to specify a
;;; maximum number of characters to read/partial
;;; but fills the buffer at most to the end.
;;; Therefore we allocate a new buffer here:
(let* ((buf (make-string (- end start)))
(nread-any
(read-block buf 0 needed fd/port)))
(if (not (eof-object? nread-any))
(copy-bytes! buf 0 s start nread-any))
nread-any))))
(if (eof-object? nread)
#f
(begin
(if (not (eq? s buffer))
(copy-bytes! buffer 0 s start nread))
nread)))))
nread))))
(else
(apply error "Not a fd/port in read-string!/partial" s args)))))
@ -56,11 +63,8 @@
(if (= len 0)
0
(let* ((buffer (make-string len))
(needed (if (> (byte-vector-length (port-buffer fd/port)) 1)
'any
'immediate));; bufpol/none may return with 0
(nread (read-block buffer 0 needed fd/port)))
(cond ((eof-object? nread) #f)
(nread (read-string!/partial buffer fd/port)))
(cond ((not nread) #f)
((= nread len) buffer)
(else (substring buffer 0 nread))))))
(else