From f3a4e8c3101f41b39ada1841c69e6e74453a5783 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Sun, 15 Mar 2009 14:07:28 +0900 Subject: [PATCH] adding initial test suite --- Makefile | 10 ++++++++ eval.c | 54 ++++++++++++++++++----------------------- init.scm | 6 +++++ sexp.c | 35 +++++++++----------------- sexp.h | 5 ++-- tests/test00-fact-3.res | 1 + tests/test00-fact-3.scm | 14 +++++++++++ tests/test01-apply.res | 8 ++++++ tests/test01-apply.scm | 18 ++++++++++++++ tests/test02-callcc.res | 1 + tests/test02-callcc.scm | 34 ++++++++++++++++++++++++++ 11 files changed, 130 insertions(+), 56 deletions(-) create mode 100644 tests/test00-fact-3.res create mode 100644 tests/test00-fact-3.scm create mode 100644 tests/test01-apply.res create mode 100644 tests/test01-apply.scm create mode 100644 tests/test02-callcc.res create mode 100644 tests/test02-callcc.scm diff --git a/Makefile b/Makefile index c62c1921..f3ce3824 100644 --- a/Makefile +++ b/Makefile @@ -29,3 +29,13 @@ cleaner: clean rm -f chibi-scheme rm -rf *.dSYM +test: chibi-scheme + for f in tests/*.scm; do \ + ./chibi-scheme $$f >$${f%.scm}.out 2>$${f%.scm}.err; \ + if diff -q $${f%.scm}.out $${f%.scm}.res; then \ + echo "[PASS] $${f%.scm}"; \ + else \ + echo "[FAIL] $${f%.scm}"; \ + fi; \ + done + diff --git a/eval.c b/eval.c index d8e16c22..674564b5 100644 --- a/eval.c +++ b/eval.c @@ -282,7 +282,7 @@ void analyze(sexp obj, bytecode *bc, unsigned int *i, env e, && (((core_form)SEXP_CDR(o2))->code == CORE_LAMBDA) && sexp_listp(SEXP_CADR(SEXP_CAR(obj)))) { /* let */ - tmp1 = sexp_length(SEXP_CADR(SEXP_CAR(obj))); + tmp1 = sexp_unbox_integer(sexp_length(SEXP_CADR(SEXP_CAR(obj)))); e2 = extend_env_closure(e, SEXP_CADR(SEXP_CAR(obj)), (*d)+(tmp1-1)); for (o2=sexp_reverse(SEXP_CDR(obj)); SEXP_PAIRP(o2); o2=SEXP_CDR(o2)) analyze(SEXP_CAR(o2), bc, i, e, params, fv, sv, d, 0); @@ -330,7 +330,7 @@ void analyze_opcode (opcode op, sexp obj, bytecode *bc, unsigned int *i, env e, case OPC_CONSTRUCTOR: case OPC_ACCESSOR: case OPC_GENERIC: - tmp1 = sexp_length(SEXP_CDR(obj)); + tmp1 = sexp_unbox_integer(sexp_length(SEXP_CDR(obj))); if (tmp1 == 0) { errx(1, "opcode with no arguments: %s", op->name); } else if (tmp1 == 1) { @@ -355,7 +355,7 @@ void analyze_opcode (opcode op, sexp obj, bytecode *bc, unsigned int *i, env e, } break; case OPC_IO: - tmp1 = sexp_length(SEXP_CDR(obj)); + tmp1 = sexp_unbox_integer(sexp_length(SEXP_CDR(obj))); if (tmp1 == op->num_args && op->var_args_p) { emit(bc, i, OP_PARAMETER); emit_word(bc, i, (sexp_uint_t) op->data); @@ -378,7 +378,7 @@ void analyze_opcode (opcode op, sexp obj, bytecode *bc, unsigned int *i, env e, } emit_push(bc, i, op->data); emit(bc, i, op->op_name); - (*d) -= (sexp_length(SEXP_CDR(obj))-1); + (*d) -= (sexp_unbox_integer(sexp_length(SEXP_CDR(obj)))-1); break; default: errx(1, "unknown opcode class: %d", op->op_class); @@ -418,7 +418,7 @@ void analyze_var_ref (sexp obj, bytecode *bc, unsigned int *i, env e, void analyze_app (sexp obj, bytecode *bc, unsigned int *i, env e, sexp params, sexp fv, sexp sv, unsigned int *d, int tailp) { sexp o1; - unsigned long len = sexp_length(SEXP_CDR(obj)); + sexp_uint_t len = sexp_unbox_integer(sexp_length(SEXP_CDR(obj))); /* push the arguments onto the stack */ for (o1 = sexp_reverse(SEXP_CDR(obj)); SEXP_PAIRP(o1); o1 = SEXP_CDR(o1)) { @@ -430,10 +430,8 @@ void analyze_app (sexp obj, bytecode *bc, unsigned int *i, env e, /* maybe overwrite the current frame */ if (tailp) { - fprintf(stderr, "compiling tail call: %d + %d + 3 = %d\n", - sexp_length(params), (*d), sexp_length(params)+(*d)+3); emit(bc, i, OP_TAIL_CALL); - emit_word(bc, i, (sexp_uint_t) sexp_make_integer(sexp_length(params)+(*d)+3)); + emit_word(bc, i, (sexp_uint_t) sexp_make_integer(sexp_unbox_integer(sexp_length(params))+(*d)+3)); emit_word(bc, i, (sexp_uint_t) sexp_make_integer(len)); } else { /* normal call */ @@ -514,7 +512,7 @@ void analyze_lambda (sexp name, sexp formals, sexp body, obj = (sexp) compile(flat_formals, body, e2, fv2, sv, 0); /* push the closed vars */ emit_push(bc, i, SEXP_UNDEF); - emit_push(bc, i, sexp_make_integer(sexp_length(fv2))); + emit_push(bc, i, sexp_length(fv2)); emit(bc, i, OP_MAKE_VECTOR); (*d)++; for (ls=fv2, k=0; SEXP_PAIRP(ls); ls=SEXP_CDR(ls), k++) { @@ -528,7 +526,7 @@ void analyze_lambda (sexp name, sexp formals, sexp body, } /* push the additional procedure info and make the closure */ emit_push(bc, i, obj); - emit_push(bc, i, sexp_make_integer(sexp_length(formals))); + emit_push(bc, i, sexp_length(formals)); emit_push(bc, i, sexp_make_integer(sexp_listp(formals) ? 0 : 1)); emit(bc, i, OP_MAKE_PROCEDURE); } @@ -600,7 +598,7 @@ bytecode compile(sexp params, sexp obj, env e, sexp fv, sexp sv, int done_p) { } } obj = sexp_reverse(ls); - j = sexp_length(internals); + j = sexp_unbox_integer(sexp_length(internals)); if (SEXP_PAIRP(internals)) { /* sexp_write_string("internals: ", cur_error_port); */ /* sexp_write(internals, cur_error_port); */ @@ -642,7 +640,7 @@ bytecode compile(sexp params, sexp obj, env e, sexp fv, sexp sv, int done_p) { sexp sexp_save_stack(sexp *stack, unsigned int to) { sexp res, *data; int i; - res = sexp_make_vector(to, SEXP_UNDEF); + res = sexp_make_vector(sexp_make_integer(to), SEXP_UNDEF); data = sexp_vector_data(res); for (i=0; idata; @@ -1164,6 +1163,7 @@ _OP(OPC_GENERIC, OP_ERROR, 1, SEXP_STRING, 0, 0, 0, "error"), {SEXP_OPCODE, OPC_IO, OP_FLUSH_OUTPUT, 0, 1, 0, SEXP_OPORT, 0, "flush-output", (sexp)&cur_output_port, NULL}, {SEXP_OPCODE, OPC_IO, OP_READ, 0, 1, 0, SEXP_IPORT, 0, "read", (sexp)&cur_input_port, NULL}, {SEXP_OPCODE, OPC_IO, OP_READ_CHAR, 0, 1, 0, SEXP_IPORT, 0, "read-char", (sexp)&cur_input_port, NULL}, +_FN1(SEXP_PAIR, "length", sexp_length), _FN1(SEXP_PAIR, "reverse", sexp_reverse), _FN1(SEXP_PAIR, "list->vector", sexp_list_to_vector), _FN1(SEXP_STRING, "open-input-file", sexp_open_input_file), @@ -1269,18 +1269,13 @@ int main (int argc, char **argv) { env_define(e, err_handler_sym, err_handler); exception_handler_cell = env_cell(e, err_handler_sym); - fprintf(stderr, "current-input-port: %d => %d\n", &cur_input_port, cur_input_port); - /* parse options */ for (i=1; i < argc && argv[i][0] == '-'; i++) { switch (argv[i][1]) { case 'e': case 'p': if (! init_loaded) { - if (stream = fopen(sexp_init_file, "r")) { - sexp_load(sexp_make_input_port(stream)); - fclose(stream); - } + sexp_load(sexp_make_string(sexp_init_file)); init_loaded = 1; } obj = sexp_read_from_string(argv[i+1]); @@ -1301,14 +1296,13 @@ int main (int argc, char **argv) { } if (! quit) { - if (! init_loaded) { - if (stream = fopen(sexp_init_file, "r")) { - sexp_load(sexp_make_input_port(stream)); - fclose(stream); - } - init_loaded = 1; - } - repl(e, stack); + if (! init_loaded) + sexp_load(sexp_make_string(sexp_init_file)); + if (i < argc) + for ( ; i < argc; i++) + sexp_load(sexp_make_string(argv[i])); + else + repl(e, stack); } return 0; } diff --git a/init.scm b/init.scm index 33fe780a..46afc7e2 100644 --- a/init.scm +++ b/init.scm @@ -68,6 +68,12 @@ (map1 cdr lol '()) (cons (apply1 proc (map1 car lol '())) res)))) +;; math utilities + +(define (zero? x) (= x 0)) +(define (positive? x) (> x 0)) +(define (negative? x) (< x 0)) + ;; syntax (define-syntax let diff --git a/sexp.c b/sexp.c index 6fa9cb3e..46597787 100644 --- a/sexp.c +++ b/sexp.c @@ -160,23 +160,11 @@ sexp sexp_append(sexp a, sexp b) { return b; } -sexp sexp_list(int count, ...) { - sexp res = SEXP_NULL; - int i; - va_list ap; - va_start(ap, count); - for (i=0; itag = SEXP_VECTOR; - v->data1 = (void*) len; + v->data1 = (void*) clen; v->data2 = (void*) x; return v; } @@ -289,7 +277,7 @@ sexp sexp_list_to_vector(sexp ls) { } sexp sexp_vector(int count, ...) { - sexp vec = sexp_make_vector(count, SEXP_UNDEF); + sexp vec = sexp_make_vector(sexp_make_integer(count), SEXP_UNDEF); sexp *elts = sexp_vector_data(vec); va_list ap; int i; @@ -593,6 +581,7 @@ sexp sexp_read_raw (sexp in) { /* ... FALLTHROUGH ... */ case ' ': case '\t': + case '\r': case '\n': goto scan_loop; case '\'': diff --git a/sexp.h b/sexp.h index 199be5c8..d8338949 100644 --- a/sexp.h +++ b/sexp.h @@ -225,15 +225,14 @@ sexp sexp_lset_diff(sexp a, sexp b); sexp sexp_reverse(sexp ls); sexp sexp_nreverse(sexp ls); sexp sexp_append(sexp a, sexp b); -sexp sexp_list(int count, ...); sexp sexp_memq(sexp x, sexp ls); sexp sexp_assq(sexp x, sexp ls); -unsigned long sexp_length(sexp ls); +sexp sexp_length(sexp ls); sexp sexp_make_string(char *str); sexp sexp_make_flonum(double f); int sexp_string_hash(char *str, int acc); sexp sexp_intern(char *str); -sexp sexp_make_vector(unsigned int len, sexp dflt); +sexp sexp_make_vector(sexp len, sexp dflt); sexp sexp_list_to_vector(sexp ls); sexp sexp_vector(int count, ...); void sexp_write(sexp obj, sexp out); diff --git a/tests/test00-fact-3.res b/tests/test00-fact-3.res new file mode 100644 index 00000000..f76d3d1e --- /dev/null +++ b/tests/test00-fact-3.res @@ -0,0 +1 @@ +(fact 3) => 6 diff --git a/tests/test00-fact-3.scm b/tests/test00-fact-3.scm new file mode 100644 index 00000000..46441893 --- /dev/null +++ b/tests/test00-fact-3.scm @@ -0,0 +1,14 @@ + +(define (fact-helper x res) + (if (zero? x) + res + (fact-helper (- x 1) (* res x)))) + +(define (fact x) + (fact-helper x 1)) + +(display "(fact 3) => ") +(write (fact 3)) +(newline) + + diff --git a/tests/test01-apply.res b/tests/test01-apply.res new file mode 100644 index 00000000..c5b83af4 --- /dev/null +++ b/tests/test01-apply.res @@ -0,0 +1,8 @@ +11 +(11 10 9 8 7 6 5 4 3 2 1) +(1 2 3 4) +100 +100 +100 +100 +100 diff --git a/tests/test01-apply.scm b/tests/test01-apply.scm new file mode 100644 index 00000000..183a591c --- /dev/null +++ b/tests/test01-apply.scm @@ -0,0 +1,18 @@ + +(define foo + (lambda (a b c d e f g h) + (+ (+ (* a b) (* c d)) (+ (* e f) (* g h))))) + +(define (writeln x) + (write x) + (newline)) + +(writeln (length (reverse (list 1 2 3 4 5 6 7 8 9 10 11)))) +(writeln (reverse (list 1 2 3 4 5 6 7 8 9 10 11))) +(writeln (append (list 1 2) (list 3 4))) +(writeln (foo 1 2 3 4 5 6 7 8)) +(writeln (apply foo (list 1 2 3 4 5 6 7 8))) +(writeln (apply foo 1 (list 2 3 4 5 6 7 8))) +(writeln (apply foo 1 2 3 4 (list 5 6 7 8))) +(writeln (apply foo 1 2 3 4 5 (list 6 7 8))) + diff --git a/tests/test02-callcc.res b/tests/test02-callcc.res new file mode 100644 index 00000000..849baeed --- /dev/null +++ b/tests/test02-callcc.res @@ -0,0 +1 @@ +543 diff --git a/tests/test02-callcc.scm b/tests/test02-callcc.scm new file mode 100644 index 00000000..3a5c355e --- /dev/null +++ b/tests/test02-callcc.scm @@ -0,0 +1,34 @@ + +(define fail + (lambda () 999999)) + +(define in-range + (lambda (a b) + (call-with-current-continuation + (lambda (cont) + (enumerate a b cont))))) + +(define enumerate + (lambda (a b cont) + (if (< b a) + (fail) + (let ((save fail)) + (begin + (set! fail + (lambda () + (begin + (set! fail save) + (enumerate (+ a 1) b cont)))) + (cont a)))))) + +(write + (let ((x (in-range 2 9)) + (y (in-range 2 9)) + (z (in-range 2 9))) + (if (= (* x x) + (+ (* y y) (* z z))) + (+ (* x 100) (+ (* y 10) z)) + (fail)))) + +(newline) +