Check string indices and simplify calls to set-port-buffering.

This commit is contained in:
mainzelm 2003-01-07 14:58:13 +00:00
parent b0a5aef735
commit f35bd77442
1 changed files with 16 additions and 4 deletions

View File

@ -16,9 +16,12 @@
(let-optionals args ((fd/port (current-input-port))
(start 0)
(end (string-length s)))
(if (bogus-substring-spec? s start end)
(error "Bad substring indices" s start end))
(cond ((integer? fd/port)
(let ((port (fdes->inport fd/port)))
(set-port-buffering port bufpol/block (max (- end start) 0))
(set-port-buffering port bufpol/block (- end start))
(read-string!/partial port start end)))
(else ; no differnce between fd/ports and s48 ports
@ -51,9 +54,12 @@
(let-optionals args ((fd/port (current-input-port))
(start 0)
(end (string-length s)))
(if (bogus-substring-spec? s start end)
(error "Bad substring indices" s start end))
(cond ((integer? fd/port)
(let ((port (fdes->inport fd/port)))
(set-port-buffering port bufpol/block (max (- end start) 0))
(set-port-buffering port bufpol/block (- end start))
(read-string! port start end)))
(else ; no differnce between fd/port and s48 ports
@ -79,9 +85,12 @@
(let-optionals args ((fd/port (current-output-port))
(start 0)
(end (string-length s)))
(if (bogus-substring-spec? s start end)
(error "Bad substring indices" s start end))
(cond ((integer? fd/port)
(let ((port (fdes->outport fd/port)))
(set-port-buffering port bufpol/block (max (- end start) 0))
(set-port-buffering port bufpol/block (- end start))
(write-string/partial s port start end)))
(else
;; the only way to implement this, would be to use
@ -98,8 +107,11 @@ See the RELEASE file for details")))))
(let-optionals args ((fd/port (current-output-port))
(start 0)
(end (string-length s)))
(if (bogus-substring-spec? s start end)
(error "Bad substring indices" s start end))
(cond ((integer? fd/port)
(let ((port (fdes->outport fd/port)))
(set-port-buffering port bufpol/block (max (- end start) 0))
(set-port-buffering port bufpol/block (- end start))
(write-string s port start end)))
(else (write-block s start (- end start) fd/port)))))