Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-10 22:47:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fixing 4 byte utf8 read-char. Fixing resized strings in custom ports.

Browse source
This commit is contained in:
Alex Shinn 2014-04-26 13:39:26 +09:00
parent e7cd4b6c33
commit 76a4cfa952
3 changed files with 24 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
eval.c
View file

@ -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;
}

13
sexp.c
View file

@ -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;
}

22
tests/r7rs-tests.scm
View file

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