From 76a4cfa95253cccafc6f85e14f400f894884571e Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sat, 26 Apr 2014 13:39:26 +0900 Subject: [PATCH] Fixing 4 byte utf8 read-char. Fixing resized strings in custom ports. --- eval.c | 2 +- sexp.c | 13 +++++++++---- tests/r7rs-tests.scm | 22 ++++++++++++++-------- 3 files changed, 24 insertions(+), 13 deletions(-) diff --git a/eval.c b/eval.c index 55cb7af9..fe4faf29 100644 --- a/eval.c +++ b/eval.c @@ -1755,7 +1755,7 @@ sexp sexp_read_utf8_char (sexp ctx, sexp port, int i) { i = ((i&0x1F)<<12) + ((sexp_read_char(ctx, port)&0x3F)<<6); i += sexp_read_char(ctx, port)&0x3F; } else { - i = ((i&0x0F)<<16) + ((sexp_read_char(ctx, port)&0x3F)<<12); + i = ((i&0x0F)<<18) + ((sexp_read_char(ctx, port)&0x3F)<<12); i += (sexp_read_char(ctx, port)&0x3F)<<6; i += sexp_read_char(ctx, port)&0x3F; } diff --git a/sexp.c b/sexp.c index eb02ad22..88337d13 100644 --- a/sexp.c +++ b/sexp.c @@ -1418,7 +1418,7 @@ sexp sexp_open_output_file_descriptor (sexp ctx, sexp self, sexp_sint_t n, sexp #else /* ! SEXP_USE_STRING_STREAMS */ int sexp_buffered_read_char (sexp ctx, sexp p) { - sexp_gc_var1(tmp); + sexp_gc_var2(tmp, origbytes); int res = 0; if (sexp_port_offset(p) < sexp_port_size(p)) { return ((unsigned char*)sexp_port_buf(p))[sexp_port_offset(p)++]; @@ -1439,20 +1439,25 @@ int sexp_buffered_read_char (sexp ctx, sexp p) { ? ((unsigned char*)sexp_port_buf(p))[sexp_port_offset(p)++] : EOF); } } else if (sexp_port_customp(p)) { - sexp_gc_preserve1(ctx, tmp); + sexp_gc_preserve2(ctx, tmp, origbytes); tmp = sexp_list2(ctx, SEXP_ZERO, sexp_make_fixnum(SEXP_PORT_BUFFER_SIZE)); - tmp = sexp_cons(ctx, sexp_port_binaryp(p) ? sexp_string_bytes(sexp_port_buffer(p)) : sexp_port_buffer(p), tmp); + origbytes = sexp_port_binaryp(p) ? sexp_string_bytes(sexp_port_buffer(p)) : sexp_port_buffer(p); + tmp = sexp_cons(ctx, origbytes, tmp); tmp = sexp_apply(ctx, sexp_port_reader(p), tmp); if (sexp_fixnump(tmp) && sexp_unbox_fixnum(tmp) > 0) { sexp_port_offset(p) = 0; sexp_port_size(p) = sexp_unbox_fixnum(tmp); + if (!sexp_port_binaryp(p) && origbytes != sexp_string_bytes(sexp_port_buffer(p))) { + /* handle resize */ + memcpy(sexp_port_buf(p), sexp_bytes_data(sexp_string_bytes(sexp_port_buffer(p))), sexp_port_size(p)); + } res = ((sexp_port_offset(p) < sexp_port_size(p)) ? ((unsigned char*)sexp_port_buf(p))[sexp_port_offset(p)++] : EOF); } else { res = EOF; sexp_port_size(p) = 0; } - sexp_gc_release1(ctx); + sexp_gc_release2(ctx); } else { res = EOF; } diff --git a/tests/r7rs-tests.scm b/tests/r7rs-tests.scm index 184e25d2..3cb73c65 100644 --- a/tests/r7rs-tests.scm +++ b/tests/r7rs-tests.scm @@ -1101,6 +1101,11 @@ (test "a-c" (let ((str (string #\a #\b #\c))) (string-set! str 1 #\-) str)) +(test (string #\a #\x1F700 #\c) + (let ((s (string #\a #\b #\c))) + (string-set! s 1 #\x1F700) + s)) + (test #t (string=? "" "")) (test #t (string=? "abc" "abc" "abc")) (test #f (string=? "" "abc")) @@ -1763,17 +1768,18 @@ (test "abc" (read-string 3 (open-input-string "abcd"))) (test "abc" (read-string 3 (open-input-string "abc\ndef\n"))) -(let* ((s (string #\x1F700 #\x1F701 #\x1F702)) - (in (open-input-string s))) - (test #\x1F700 (string-ref s 0)) - (test #\x1F701 (string-ref s 1)) - (test #\x1F702 (string-ref s 2)) +(let ((in (open-input-string (string #\x10F700 #\x10F701 #\x10F702)))) (let* ((c1 (read-char in)) (c2 (read-char in)) (c3 (read-char in))) - (test #\x1F700 c1) - (test #\x1F701 c2) - (test #\x1F702 c3))) + (test #\x10F700 c1) + (test #\x10F701 c2) + (test #\x10F702 c3))) + +(test (string #\x10F700) + (let ((out (open-output-string))) + (write-char #\x10F700 out) + (get-output-string out))) (test "abc" (let ((out (open-output-string)))