Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 06:09:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

need to close string ports

Browse source
This commit is contained in:
Alex Shinn 2009-06-28 01:48:12 +09:00
parent baa8b07d63
commit 63b8f63fec
2 changed files with 22 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
init.scm
View file

@ -480,12 +480,17 @@
(define (load file) (%load file (interaction-environment))) (define (load file) (%load file (interaction-environment)))
(define (call-with-input-string str proc) (define (call-with-input-string str proc)
(proc (open-input-string str))) (let* ((in (open-input-string str))
(res (proc in)))
(close-input-port in)
res))
(define (call-with-output-string proc) (define (call-with-output-string proc)
(let ((out (open-output-string))) (let ((out (open-output-string)))
(proc out) (proc out)
(get-output-string out))) (let ((res (get-output-string out)))
(close-output-port out)
res)))
(define (call-with-input-file file proc) (define (call-with-input-file file proc)
(let* ((in (open-input-file file)) (let* ((in (open-input-file file))

28
sexp.c
View file

@ -392,9 +392,10 @@ sexp sexp_make_flonum(sexp ctx, double f) {
sexp sexp_make_string(sexp ctx, sexp len, sexp ch) { sexp sexp_make_string(sexp ctx, sexp len, sexp ch) {
sexp_sint_t clen = sexp_unbox_integer(len); sexp_sint_t clen = sexp_unbox_integer(len);
sexp s = sexp_alloc_atomic(ctx, sexp_sizeof(string)+clen+1); sexp s;
sexp_pointer_tag(s) = SEXP_STRING;
if (clen < 0) return sexp_type_exception(ctx, "negative length", len); if (clen < 0) return sexp_type_exception(ctx, "negative length", len);
s = sexp_alloc_atomic(ctx, sexp_sizeof(string)+clen+1);
sexp_pointer_tag(s) = SEXP_STRING;
sexp_string_length(s) = clen; sexp_string_length(s) = clen;
if (sexp_charp(ch)) if (sexp_charp(ch))
memset(sexp_string_data(s), sexp_unbox_character(ch), clen); memset(sexp_string_data(s), sexp_unbox_character(ch), clen);
@ -450,6 +451,7 @@ sexp sexp_string_concatenate (sexp ctx, sexp str_ls) {
memcpy(p, sexp_string_data(sexp_car(ls)), len); memcpy(p, sexp_string_data(sexp_car(ls)), len);
p += len; p += len;
} }
*p = '\0';
return res; return res;
} }
@ -702,15 +704,14 @@ sexp sexp_buffered_flush (sexp ctx, sexp p) {
else { else {
if (sexp_port_stream(p)) { if (sexp_port_stream(p)) {
fwrite(sexp_port_buf(p), 1, sexp_port_offset(p), sexp_port_stream(p)); fwrite(sexp_port_buf(p), 1, sexp_port_offset(p), sexp_port_stream(p));
sexp_port_offset(p) = 0;
fflush(sexp_port_stream(p)); fflush(sexp_port_stream(p));
} else if (sexp_port_offset(p) > 0) { } else if (sexp_port_offset(p) > 0) {
sexp_gc_preserve(ctx, tmp, s_tmp); sexp_gc_preserve(ctx, tmp, s_tmp);
tmp = sexp_c_string(ctx, sexp_port_buf(p), sexp_port_offset(p)); tmp = sexp_c_string(ctx, sexp_port_buf(p), sexp_port_offset(p));
sexp_push(ctx, sexp_port_cookie(p), tmp); sexp_push(ctx, sexp_port_cookie(p), tmp);
sexp_port_offset(p) = 0;
sexp_gc_release(ctx, tmp, s_tmp); sexp_gc_release(ctx, tmp, s_tmp);
} }
sexp_port_offset(p) = 0;
return SEXP_VOID; return SEXP_VOID;
} }
} }
@ -735,17 +736,18 @@ sexp sexp_make_output_string_port (sexp ctx) {
sexp sexp_get_output_string (sexp ctx, sexp out) { sexp sexp_get_output_string (sexp ctx, sexp out) {
sexp res; sexp res;
sexp_gc_var(ctx, ls, s_ls);
sexp_gc_var(ctx, tmp, s_tmp); sexp_gc_var(ctx, tmp, s_tmp);
sexp_gc_preserve(ctx, ls, s_ls);
sexp_gc_preserve(ctx, tmp, s_tmp); sexp_gc_preserve(ctx, tmp, s_tmp);
tmp = ((sexp_port_offset(out) > 0) if (sexp_port_offset(out) > 0) {
? sexp_cons(ctx, tmp = sexp_c_string(ctx, sexp_port_buf(out), sexp_port_offset(out));
tmp=sexp_c_string(ctx, ls = sexp_cons(ctx, tmp, sexp_port_cookie(out));
sexp_port_buf(out), } else {
sexp_port_offset(out)), ls = sexp_port_cookie(out);
sexp_port_cookie(out)) }
: sexp_port_cookie(out)); res = sexp_string_concatenate(ctx, ls);
res = sexp_string_concatenate(ctx, tmp); sexp_gc_release(ctx, ls, s_ls);
sexp_gc_release(ctx, tmp, s_tmp);
return res; return res;
} }