~ chicken-core (chicken-5) 908b2015140c67a558087e31b83e66bb7110b98f
commit 908b2015140c67a558087e31b83e66bb7110b98f Author: felix <felix@call-with-current-continuation.org> AuthorDate: Fri Aug 13 03:23:47 2010 -0400 Commit: felix <felix@call-with-current-continuation.org> CommitDate: Fri Aug 13 03:23:47 2010 -0400 copy-port fixes and tests diff --git a/ports.scm b/ports.scm index 9070fcab..38582a24 100644 --- a/ports.scm +++ b/ports.scm @@ -80,7 +80,7 @@ (define (write-buf buf n port writer) (do ((i 0 (fx+ i 1))) ((fx>= i n)) - (writer (integer->char (##sys#byte buf n)) port))) + (writer (integer->char (##sys#byte buf i)) port))) (define (read-and-write reader writer) (let loop () diff --git a/tests/library-tests.scm b/tests/library-tests.scm index a58b5960..ee851334 100644 --- a/tests/library-tests.scm +++ b/tests/library-tests.scm @@ -68,3 +68,14 @@ (assert (= -42.0 (fpceiling -42.2))) (assert (not (fpinteger? 2.3))) (assert (fpinteger? 1.0)) + +;; string->symbol + +;; by Jim Ursetto +(assert + (eq? '|3| + (with-input-from-string + (with-output-to-string + (lambda () + (write (string->symbol "3")))) + read))) diff --git a/tests/port-tests.scm b/tests/port-tests.scm index 6a9a1d68..72795418 100644 --- a/tests/port-tests.scm +++ b/tests/port-tests.scm @@ -35,26 +35,47 @@ EOF (assert (= 20 (length (read-lines (open-input-string *text*))))) -;;; port operations +;;; copy-port (assert (string=? *text* (with-output-to-string (lambda () - (copy-port (open-input-string *text*) (current-output-port)))))) + (copy-port (open-input-string *text*) (current-output-port)))))) ; read-char -> write-char (assert (equal? '(3 2 1) (let ((out '())) - (copy-port + (copy-port ; read -> custom (open-input-string "1 2 3") #f read (lambda (x port) (set! out (cons x out)))) out))) +(assert + (equal? + "abc" + (let ((out (open-output-string))) + (copy-port ; read-char -> custom + (open-input-string "abc") + out + read-char + (lambda (x out) (write-char x out))) + (get-output-string out)))) + +(assert + (equal? + "abc" + (let ((in (open-input-string "abc") ) + (out (open-output-string))) + (copy-port ; custom -> write-char + in out + (lambda (in) (read-char in))) + (get-output-string out)))) + ;; fill buffers (read-all "compiler.scm")Trap