~ 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