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 who 'set-port-position!)
(define (set-position! p pos flush?) (define (set-position! p pos flush?)
(let ([setpos! ($port-set-position! p)]) (let ([setpos! ($port-set-position! p)])
(unless setpos! (die who "port does not support port position" p)) (cond
(when flush? (flush-output-port p)) [(procedure? setpos!)
(setpos! pos) (when flush? (flush-output-port p))
($set-port-index! p 0) (setpos! pos)
($set-port-size! p 0) ($set-port-index! p 0)
(let ([pos-vec ($port-position p)]) ($set-port-size! p 0)
(vector-set! pos-vec 0 pos)))) (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)) (unless (and (or (fixnum? pos) (bignum? pos)) (>= pos 0))
(die who "position must be a nonnegative exact integer" pos)) (die who "position must be a nonnegative exact integer" pos))
(cond (cond
@ -474,7 +481,7 @@
(lambda (bv i c) 0) ;;; read! (lambda (bv i c) 0) ;;; read!
#f ;;; write! #f ;;; write!
#t ;;; get-position #t ;;; get-position
#f ;;; set-position! #t ;;; set-position!
#f ;;; close #f ;;; close
#f #f
(vector 0))])) (vector 0))]))
@ -644,7 +651,7 @@
(lambda (str i c) 0) ;;; read! (lambda (str i c) 0) ;;; read!
#f ;;; write! #f ;;; write!
#t ;;; get-position #t ;;; get-position
#f ;;; set-position! #t ;;; set-position!
#f ;;; close #f ;;; close
#f ;;; cookie #f ;;; cookie
(vector 0))) (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)) (close-input-port p))
(delete-file fname)) (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) (define (run-tests)
(test-setting-position-for-binary-output-files) (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)))