~ 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