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

@ -27,19 +27,26 @@
((open-input-port? fd/port) ((open-input-port? fd/port)
(if (= start end) (if (= start end)
0 0
(let* ((buffer (if (= start 0) (let* ((needed (if (= 0 (bitwise-and open/non-blocking
s (fdes-status fd/port)))
(make-string (- end start))))
(needed (if (> (byte-vector-length (port-buffer fd/port)) 1)
'any 'any
'immediate)) ;bufpol/none may return with 0 'immediate))
(nread (read-block buffer 0 needed fd/port))) (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) (if (eof-object? nread)
#f #f
(begin nread))))
(if (not (eq? s buffer))
(copy-bytes! buffer 0 s start nread))
nread)))))
(else (else
(apply error "Not a fd/port in read-string!/partial" s args))))) (apply error "Not a fd/port in read-string!/partial" s args)))))
@ -56,11 +63,8 @@
(if (= len 0) (if (= len 0)
0 0
(let* ((buffer (make-string len)) (let* ((buffer (make-string len))
(needed (if (> (byte-vector-length (port-buffer fd/port)) 1) (nread (read-string!/partial buffer fd/port)))
'any (cond ((not nread) #f)
'immediate));; bufpol/none may return with 0
(nread (read-block buffer 0 needed fd/port)))
(cond ((eof-object? nread) #f)
((= nread len) buffer) ((= nread len) buffer)
(else (substring buffer 0 nread)))))) (else (substring buffer 0 nread))))))
(else (else