diff options
| -rw-r--r-- | tests/012/lambda.tl | 5 | ||||
| -rw-r--r-- | tests/common.tl | 69 |
2 files changed, 51 insertions, 23 deletions
diff --git a/tests/012/lambda.tl b/tests/012/lambda.tl index 408ea939..2ddca48f 100644 --- a/tests/012/lambda.tl +++ b/tests/012/lambda.tl @@ -86,3 +86,8 @@ (mtest [(lambda (x y : (a 3) (b 4)) (list x y a b)) . vl] (a b c d) [(lambda (x y : (a 3) (b 4)) (list x y a b)) 1 . vl] :error) + +(cond + (*compile-test* (exit t)) + (t (set *compile-test* t) + (load (base-name *load-path*)))) diff --git a/tests/common.tl b/tests/common.tl index b9e46ad3..b94960cf 100644 --- a/tests/common.tl +++ b/tests/common.tl @@ -1,31 +1,54 @@ +(defvar *compile-test*) + (defmacro error-to-sym (expr) - ^(catch ,expr - (error (cond) :error) - (warning (cond) :warning))) + ^(catch ,expr + (error (cond) :error) + (warning (cond) :warning))) (defmacro vtest (:env env expr expected) (if-match (quote @(as sym @(or :error :warning))) expected (set expected sym)) - (if (mequal expected :error :warning :warnerror) - (catch - (let ((expr-expn (expand expr env))) - ^(ifa (not (equal (error-to-sym ,expr-expn) ,expected)) - (error "test case ~s failed: produced ~s; expected ~s" - ',expr it ,expected))) - (error (exc) - (if (eq expected :warning) - (error "test case ~s produced error during expansion, expected ~s" - expr expected))) - (warning (exc) - (if (eq expected :error) - (error "test case ~s warned during expansion, expected ~s" - expr expected)))) - (let ((expr-expn (expand expr env)) - (expval (gensym))) - ^(let ((,expval ,expected)) - (ifa (not (equal ,expr-expn ,expval)) - (error "test case ~s failed: produced ~s; expected ~s" - ',expr it ,expval)))))) + (if *compile-test* + (if (meq expected :error :warning) + (with-gensyms (code) + ^(let ((,code (catch + (compile-toplevel ',expr) + (error (exc) + (if (eq ,expected :warning) + (error "test case ~s produced error during compilation, expected ~s" + ',expr ,expected))) + (warning (exc) + (if (eq ,expected :error) + (error "test case ~s warned during compilation, expected ~s" + ',expr ,expected)))))) + (ifa (not (equal (error-to-sym (call ,code)) ,expected)) + (error "test case ~s failed: produced ~s; expected ~s" + ',expr it ,expected)))) + (with-gensyms (expval) + ^(let ((,expval ,expected)) + (ifa (not (equal (call (compile-toplevel ',expr)) ,expval)) + (error "test case ~s failed: produced ~s; expected ~s" + ',expr it ,expval))))) + (if (meq expected :error :warning) + (catch + (let ((expr-expn (expand expr env))) + ^(ifa (not (equal (error-to-sym ,expr-expn) ,expected)) + (error "test case ~s failed: produced ~s; expected ~s" + ',expr it ,expected))) + (error (exc) + (if (eq expected :warning) + (error "test case ~s produced error during expansion, expected ~s" + expr expected))) + (warning (exc) + (if (eq expected :error) + (error "test case ~s warned during expansion, expected ~s" + expr expected)))) + (let ((expr-expn (expand expr env)) + (expval (gensym))) + ^(let ((,expval ,expected)) + (ifa (not (equal ,expr-expn ,expval)) + (error "test case ~s failed: produced ~s; expected ~s" + ',expr it ,expval))))))) (defmacro test (expr expected) ^(vtest ,expr ',expected)) |