Check whether the file is opened non-blocking and call read-block with
'immediate in this case.
This commit is contained in:
parent
7e8b106c3a
commit
52c50f9410
38
scsh/rw.scm
38
scsh/rw.scm
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue