Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-12 15:37:35 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Adding start/end parameters to string<->utf8.

Browse source
This commit is contained in:
Alex Shinn 2012-11-11 15:35:35 +09:00
parent 54483179d2
commit 77bdb07584
3 changed files with 26 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
lib/chibi/io/io.scm
View file

@ -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)

2
lib/chibi/io/io.stub
View file

@ -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))

11
tests/r7rs-tests.scm
View file

@ -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)