From 77bdb0758460b284d7fb2afc8fa8e3cac6ba44ca Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Sun, 11 Nov 2012 15:35:35 +0900
Subject: [PATCH] Adding start/end parameters to string<->utf8.

---
 lib/chibi/io/io.scm  | 21 +++++++++++++++------
 lib/chibi/io/io.stub |  2 +-
 tests/r7rs-tests.scm | 11 ++++++++++-
 3 files changed, 26 insertions(+), 8 deletions(-)

diff --git a/lib/chibi/io/io.scm b/lib/chibi/io/io.scm
index f7a4b747..9a7d30d4 100644
--- a/lib/chibi/io/io.scm
+++ b/lib/chibi/io/io.scm
@@ -14,8 +14,19 @@
       ((>= i to))
     (string-set! dst j (string-ref src i))))
 
-(define (utf8->string vec)
-  (string-copy (utf8->string! vec)))
+(define (utf8->string vec . o)
+  (if (pair? o)
+      (let ((start (car o))
+            (end (if (pair? (cdr o)) (cadr o) (bytevector-length vec))))
+        (utf8->string (subbytes vec start end)))
+      (string-copy (utf8->string! vec))))
+
+(define (string->utf8 str . o)
+  (if (pair? o)
+      (let ((start (car o))
+            (end (if (pair? (cdr o)) (cadr o) (string-length str))))
+        (string->utf8 (substring str start end)))
+      (%string->utf8 str)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; reading and writing
@@ -38,10 +49,8 @@
   (let ((out (if (pair? o) (car o) (current-output-port)))
         (o (if (pair? o) (cdr o) o)))
     (if (pair? o)
-        (let ((start (if (pair? o) (car o) 0))
-              (end (if (and (pair? o) (pair? (cdr o)))
-                       (cadr o)
-                       (string-length str))))
+        (let ((start (car o))
+              (end (if (pair? (cdr o)) (cadr o) (string-length str))))
           (cond-expand
            (string-streams
             (if (zero? start)
diff --git a/lib/chibi/io/io.stub b/lib/chibi/io/io.stub
index c1b962e3..e5ed4f0e 100644
--- a/lib/chibi/io/io.stub
+++ b/lib/chibi/io/io.stub
@@ -35,7 +35,7 @@
 
 (define-c sexp (string-count "sexp_string_count")
   ((value ctx sexp) (value self sexp) sexp sexp sexp (default NULL sexp)))
-(define-c sexp (string->utf8 "sexp_string_to_utf8")
+(define-c sexp (%string->utf8 "sexp_string_to_utf8")
   ((value ctx sexp) (value self sexp) sexp))
 (define-c sexp (utf8->string! "sexp_utf8_to_string_x")
   ((value ctx sexp) (value self sexp) sexp))
diff --git a/tests/r7rs-tests.scm b/tests/r7rs-tests.scm
index bd9992f5..493ef3b7 100644
--- a/tests/r7rs-tests.scm
+++ b/tests/r7rs-tests.scm
@@ -1145,7 +1145,13 @@
 (test #u8(0 1 2 3 4) (bytevector-append #u8(0 1 2) #u8(3 4)))
 (test #u8(0 1 2 3 4 5) (bytevector-append #u8(0 1 2) #u8(3 4) #u8(5)))
 
-(test "A" (utf8->string #u8(#x41)))
+(test "ABC" (utf8->string #u8(#x41 #x42 #x43)))
+(test "ABC" (utf8->string #u8(0 #x41 #x42 #x43) 1))
+(test "ABC" (utf8->string #u8(0 #x41  #x42 #x43 0) 1 4))
+(test "λ" (utf8->string #u8(0 #xCE #xBB 0) 1 3))
+(test #u8(#x41 #x42 #x43) (string->utf8 "ABC"))
+(test #u8(#x42 #x43) (string->utf8 "ABC" 1))
+(test #u8(#x42) (string->utf8 "ABC" 1 2))
 (test #u8(#xCE #xBB) (string->utf8 "λ"))
 
 ;; 6.10 Control Features
@@ -1737,4 +1743,7 @@
 (test #t (list? (features)))
 (test #t (and (memq 'r7rs (features)) #t))
 
+(test #t (file-exists? "."))
+(test #f (file-exists? " no such file "))
+
 (test-end)