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

added more tests for set/get position

This commit is contained in:
Abdulaziz Ghuloum 2008-12-09 03:47:08 -05:00
parent d6a950ae23
commit b31454d592
2 changed files with 8 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/last-revision
View File

@ -1 +1 @@
1709 1710

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

@ -12,7 +12,9 @@
(for-each (for-each
(lambda (x) (lambda (x)
(set-port-position! p (car x)) (set-port-position! p (car x))
(put-u8 p (cadr x))) (assert (= (port-position p) (car x)))
(put-u8 p (cadr x))
(assert (= (port-position p) (add1 (car x)))))
pos-list) pos-list)
(close-output-port p))) (close-output-port p)))
@ -25,8 +27,7 @@
(define (test-setting-position-for-binary-output-files) (define (test-setting-position-for-binary-output-files)
(write-bytes) (write-bytes)
(let ([bv (get-bytes)]) (let ([bv (get-bytes)])
(assert (= (bytevector-length bv) (assert (= (bytevector-length bv) (add1 (apply max (map car pos-list)))))
(add1 (apply max (map car pos-list)))))
(for-each (for-each
(lambda (x) (lambda (x)
(assert (= (bytevector-u8-ref bv (car x)) (cadr x)))) (assert (= (bytevector-u8-ref bv (car x)) (cadr x))))
@ -38,7 +39,9 @@
(let ([p (open-file-input-port fname)]) (let ([p (open-file-input-port fname)])
(define (check-pos x) (define (check-pos x)
(set-port-position! p (car x)) (set-port-position! p (car x))
(assert (= (get-u8 p) (cadr x)))) (assert (= (port-position p) (car x)))
(assert (= (get-u8 p) (cadr x)))
(assert (= (port-position p) (add1 (car x)))))
(for-each check-pos pos-list) (for-each check-pos pos-list)
(for-each check-pos (reverse pos-list)) (for-each check-pos (reverse pos-list))
(close-input-port p)) (close-input-port p))