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

fixed bug in port-position returning 0 for 

(port-position 
    (let ([p (open-string-input-port "Hello")]) (read p) p))
This commit is contained in:
Abdulaziz Ghuloum 2008-12-09 02:06:46 -05:00
parent 8a277aa95a
commit 4861daf6fc
2 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
scheme/ikarus.io.ss
View File

@ -286,7 +286,7 @@
(if (port? p) (if (port? p)
(and ($port-get-position p) #t) (and ($port-get-position p) #t)
(die who "not a port" p))) (die who "not a port" p)))
(define guarded-port (define guarded-port
(let ([G (make-guardian)]) (let ([G (make-guardian)])
(define (clean-up) (define (clean-up)
@ -1061,6 +1061,8 @@
(die who "invalid return value from read!" n)) (die who "invalid return value from read!" n))
(unless (<= 0 n (string-length str)) (unless (<= 0 n (string-length str))
(die who "return value from read! is out of range" n)) (die who "return value from read! is out of range" n))
(let ([idx ($port-index p)] [pos-vec ($port-position p)])
(vector-set! pos-vec 0 (+ idx (vector-ref pos-vec 0))))
($set-port-index! p 0) ($set-port-index! p 0)
($set-port-size! p n) ($set-port-size! p n)
(cond (cond
@ -1113,6 +1115,8 @@
(die who "invalid return value from read!" n)) (die who "invalid return value from read!" n))
(unless (<= 0 n (string-length str)) (unless (<= 0 n (string-length str))
(die who "return value from read! is out of range" n)) (die who "return value from read! is out of range" n))
(let ([idx ($port-index p)] [pos-vec ($port-position p)])
(vector-set! pos-vec 0 (+ idx (vector-ref pos-vec 0))))
($set-port-size! p n) ($set-port-size! p n)
(cond (cond
[(fx= n 0) [(fx= n 0)

2
scheme/last-revision
View File

@ -1 +1 @@
1706 1707