diff options
| -rw-r--r-- | src/interp.c | 4 | ||||
| -rw-r--r-- | tests/arithmetic.lisp | 10 | ||||
| -rw-r--r-- | tests/control-flow.lisp | 36 | ||||
| -rw-r--r-- | tests/error.lisp | 10 | ||||
| -rw-r--r-- | tests/lambda.lisp | 14 | ||||
| -rw-r--r-- | tests/logic.lisp | 27 | ||||
| -rw-r--r-- | tests/tailcall.lisp | 17 | ||||
| -rw-r--r-- | tests/test.lisp | 3 |
8 files changed, 119 insertions, 2 deletions
diff --git a/src/interp.c b/src/interp.c index a99440c..df995ca 100644 --- a/src/interp.c +++ b/src/interp.c @@ -674,7 +674,7 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp, bool istail) { LispPrimitive primitive_fn = PrimitiveEntryVector_ref(&interp->primitives, i)->fn; ret = (*primitive_fn)(interp, CDR(sexp), istail); - if (VALTYPE(ret) == kTailcallSExp) { + if (VALTYPE(ret) == kTailcallSExp && !istail) { fn = REF(ret)->tailcall.fn; args = REF(ret)->tailcall.args; goto tailcall; @@ -693,7 +693,7 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp, bool istail) { PUSH_REG(funcallargs); ret = primitive_funcall(interp, funcallargs, istail); POP_REG(); - if (VALTYPE(ret) == kTailcallSExp) { + if (VALTYPE(ret) == kTailcallSExp && !istail) { fn = REF(ret)->tailcall.fn; args = REF(ret)->tailcall.args; goto tailcall; diff --git a/tests/arithmetic.lisp b/tests/arithmetic.lisp index 2764b10..05459f6 100644 --- a/tests/arithmetic.lisp +++ b/tests/arithmetic.lisp @@ -5,6 +5,16 @@ (assert (= 2 (i/ 11 5))) (assert (= 1 (mod 11 5))) +(assert (< 1 2)) +(assert (< 1.0 2)) +(assert (not (> 1 2))) +(assert (= 1.0 1.0)) +(assert (= 1 1.0)) +(assert (not (= 1 2))) +(assert (>= 2 1)) +(assert (>= 1 1)) +(assert (not (>= 0 1))) + (assert-error (+ 1 "a")) (assert-error (- 1 "a")) (assert-error (* 1 "a")) diff --git a/tests/control-flow.lisp b/tests/control-flow.lisp index 75095ec..321aae0 100644 --- a/tests/control-flow.lisp +++ b/tests/control-flow.lisp @@ -27,6 +27,42 @@ (assert (= i 10)) (assert (= flag 0))) +(let ((f nil)) + (setq f + (lambda (x) + (cond ((> x 5) 1) + ((> x 0) (+ 1 1)) + (#t (+ x 1))))) + (assert (= 1 (funcall f 10))) + (assert (= 2 (funcall f 3))) + (assert (= 0 (funcall f -1)))) + +(let ((r nil)) + (if (> 2 1) + (setq r 1) + (setq r 2)) + (assert (= r 1))) + +(let ((r 1)) + (when (> 2 1) + (setq r 2)) + (assert (= r 2))) + +(let ((r 1)) + (when (> 1 2) + (setq r 2)) + (assert (= r 1))) + +(let ((r 1)) + (unless (> 1 2) + (setq r 2)) + (assert (= r 2))) + +(let ((r 1)) + (unless (> 2 1) + (setq r 2)) + (assert (= r 1))) + (assert-error (funcall (lambda () (break)))) (assert-error (funcall (lambda () (continue)))) (assert (= 1 (funcall (lambda () (return 1))))) diff --git a/tests/error.lisp b/tests/error.lisp new file mode 100644 index 0000000..e0e0c4a --- /dev/null +++ b/tests/error.lisp @@ -0,0 +1,10 @@ +(assert-error (error "")) +(assert-error (let () (error "") #t)) +(assert-error (if (error "") #t #t)) +(assert-error (and (error ""))) +(assert-error (or (error ""))) +(assert-error (funcall (lambda () (error "")))) +(assert-error (while #t (error ""))) +(assert-error (cond (#t (error "")))) +(assert-error (cond ((error "") #t))) + diff --git a/tests/lambda.lisp b/tests/lambda.lisp index 5c93bdb..18bbd8b 100644 --- a/tests/lambda.lisp +++ b/tests/lambda.lisp @@ -3,10 +3,24 @@ (lambda (g) (funcall g g)) (lambda (h) (funcall f (lambda args (apply (funcall h h) args)))))) + (defun fibo-impl (self) (lambda (n) (if (<= n 2) 1 (+ (funcall self (- n 1)) (funcall self (- n 2)))))) + (defvar fibo (Y #'fibo-impl)) + (assert (= 55 (funcall fibo 10))) + +(defun generate-counter (init) + (let ((i init)) + (lambda () + (setq i (+ 1 i)) + i))) + +(let ((c (generate-counter 0))) + (assert (= 1 (funcall c))) + (assert (= 2 (funcall c))) + (assert (= 3 (funcall c)))) diff --git a/tests/logic.lisp b/tests/logic.lisp new file mode 100644 index 0000000..5d086de --- /dev/null +++ b/tests/logic.lisp @@ -0,0 +1,27 @@ +(assert (and #t)) +(assert (and #t #t)) +(assert (and #t #t #t)) +(assert (not (and #t #f #t))) +(assert (not (and #f #t #t))) +(assert (not (and #f #t #t))) +(assert (not (or #f))) +(assert (not (or #f #f))) +(assert (not (or #f #f #f))) +(assert (or #t #f #f)) +(assert (or #f #t #f)) +(assert (or #t #t #f)) + +(let ((t #f)) + (or #t + (setq t #t)) + (assert (not t))) + +(let ((t #f)) + (and #t + (setq t #t)) + (assert t)) + +(let ((t #t)) + (and (setq t #f) + (setq t #t)) + (assert (not t))) diff --git a/tests/tailcall.lisp b/tests/tailcall.lisp new file mode 100644 index 0000000..8cea496 --- /dev/null +++ b/tests/tailcall.lisp @@ -0,0 +1,17 @@ +(defun is-even (x) + (if (= x 0) + #t + (is-odd (- x 1)))) + +(defun is-odd (x) + (is-even (- x 1))) + +(assert (is-even 10000)) +(assert (is-even 10)) +(assert (is-even 0)) +(assert (is-odd 1)) +(assert (is-even 2)) + +;; can pass without stack overflow, +;; but comment out for too time-consuming +;; (assert (is-even 1000000)) diff --git a/tests/test.lisp b/tests/test.lisp index 07bdd5b..4ca2964 100644 --- a/tests/test.lisp +++ b/tests/test.lisp @@ -5,6 +5,9 @@ (princ (format "[PASS] %s\n" ,name)))) (test-module "arithmetic") +(test-module "error") +(test-module "logic") +(test-module "tailcall") (test-module "control-flow") (test-module "lambda") (test-module "comment") |