conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

added set-port-position! for string and bytevector input ports.

This commit is contained in:
Abdulaziz Ghuloum 2008-12-09 05:27:50 -05:00
parent eec9567014
commit e315324cbf
3 changed files with 38 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
scheme/ikarus.io.ss
View File

@ -286,13 +286,20 @@
(define who 'set-port-position!)
(define (set-position! p pos flush?)
(let ([setpos! ($port-set-position! p)])
(unless setpos! (die who "port does not support port position" p))
(when flush? (flush-output-port p))
(setpos! pos)
($set-port-index! p 0)
($set-port-size! p 0)
(let ([pos-vec ($port-position p)])
(vector-set! pos-vec 0 pos))))
(cond
[(procedure? setpos!)
(when flush? (flush-output-port p))
(setpos! pos)
($set-port-index! p 0)
($set-port-size! p 0)
(let ([pos-vec ($port-position p)])
(vector-set! pos-vec 0 pos))]
[(eqv? setpos! #t)
(if (<= pos ($port-size p))
($set-port-index! p pos)
(die who "position out of range" pos))]
[else
(die who "port does not support port position" p)])))
(unless (and (or (fixnum? pos) (bignum? pos)) (>= pos 0))
(die who "position must be a nonnegative exact integer" pos))
(cond
@ -474,7 +481,7 @@
(lambda (bv i c) 0) ;;; read!
#f ;;; write!
#t ;;; get-position
#f ;;; set-position!
#t ;;; set-position!
#f ;;; close
#f
(vector 0))]))
@ -644,7 +651,7 @@
(lambda (str i c) 0) ;;; read!
#f ;;; write!
#t ;;; get-position
#f ;;; set-position!
#t ;;; set-position!
#f ;;; close
#f ;;; cookie
(vector 0)))

2
scheme/last-revision
View File

@ -1 +1 @@
1711
1712

22
scheme/tests/set-position.ss
View File

@ -47,7 +47,27 @@
(close-input-port p))
(delete-file fname))
(define (test-fixed-input-ports)
(assert (eof-object?
(let ([p (open-string-input-port "Hello")])
(set-port-position! p 5)
(get-char p))))
(assert (char=? #\o
(let ([p (open-string-input-port "Hello")])
(set-port-position! p 4)
(get-char p))))
(assert (eof-object?
(let ([p (open-bytevector-input-port #vu8(1 2 3 4 5))])
(set-port-position! p 5)
(get-u8 p))))
(assert (= 5
(let ([p (open-bytevector-input-port #vu8(1 2 3 4 5))])
(set-port-position! p 4)
(get-u8 p)))))
(define (run-tests)
(test-setting-position-for-binary-output-files)
(test-setting-position-for-binary-input-files)))
(test-setting-position-for-binary-input-files)
(test-fixed-input-ports)))