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)) ((>= i to))
(string-set! dst j (string-ref src i)))) (string-set! dst j (string-ref src i))))
(define (utf8->string vec) (define (utf8->string vec . o)
(string-copy (utf8->string! vec))) (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 ;; reading and writing
@ -38,10 +49,8 @@
(let ((out (if (pair? o) (car o) (current-output-port))) (let ((out (if (pair? o) (car o) (current-output-port)))
(o (if (pair? o) (cdr o) o))) (o (if (pair? o) (cdr o) o)))
(if (pair? o) (if (pair? o)
(let ((start (if (pair? o) (car o) 0)) (let ((start (car o))
(end (if (and (pair? o) (pair? (cdr o))) (end (if (pair? (cdr o)) (cadr o) (string-length str))))
(cadr o)
(string-length str))))
(cond-expand (cond-expand
(string-streams (string-streams
(if (zero? start) (if (zero? start)

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

@ -35,7 +35,7 @@
(define-c sexp (string-count "sexp_string_count") (define-c sexp (string-count "sexp_string_count")
((value ctx sexp) (value self sexp) sexp sexp sexp (default NULL sexp))) ((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)) ((value ctx sexp) (value self sexp) sexp))
(define-c sexp (utf8->string! "sexp_utf8_to_string_x") (define-c sexp (utf8->string! "sexp_utf8_to_string_x")
((value ctx sexp) (value self sexp) sexp)) ((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) (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 #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 "λ")) (test #u8(#xCE #xBB) (string->utf8 "λ"))
;; 6.10 Control Features ;; 6.10 Control Features
@ -1737,4 +1743,7 @@
(test #t (list? (features))) (test #t (list? (features)))
(test #t (and (memq 'r7rs (features)) #t)) (test #t (and (memq 'r7rs (features)) #t))
(test #t (file-exists? "."))
(test #f (file-exists? " no such file "))
(test-end) (test-end)