diff options
| -rw-r--r-- | share/txr/stdlib/error.tl | 5 | ||||
| -rw-r--r-- | tests/012/ifa.tl | 3 | ||||
| -rw-r--r-- | tests/common.tl | 7 |
3 files changed, 13 insertions, 2 deletions
diff --git a/share/txr/stdlib/error.tl b/share/txr/stdlib/error.tl index 42d5d6b9..a7885c3f 100644 --- a/share/txr/stdlib/error.tl +++ b/share/txr/stdlib/error.tl @@ -39,7 +39,10 @@ (loc (sys:loc nctx)) (name (sys:ctx-name nctx))) (dump-deferred-warnings *stderr*) - (throwf 'eval-error `@loc: ~s: @fmt` name . args))) + (let ((msg (fmt `@loc: ~s: @fmt` name . args))) + (when *load-recursive* + (put-line msg *stderr*)) + (throw 'eval-error msg)))) (defun compile-warning (ctx fmt . args) (let* ((nctx (sys:dig ctx)) diff --git a/tests/012/ifa.tl b/tests/012/ifa.tl index 45a2939b..05b47ab3 100644 --- a/tests/012/ifa.tl +++ b/tests/012/ifa.tl @@ -14,7 +14,8 @@ (test (let ((x 1) (y 0)) (ifa (> x y) it)) 1) ;; multiple it-candidates: error -(test (let (x y) (ifa (> (* x x) (* y y)) it)) :error) +(macro-time-let ((*stderr* *stdnull*)) + (test (let (x y) (ifa (> (* x x) (* y y)) it)) :error)) ;; "it" is (+ 3 (* 2 x)) (test (let ((x 5)) diff --git a/tests/common.tl b/tests/common.tl index cdfc6c6a..accbf1f7 100644 --- a/tests/common.tl +++ b/tests/common.tl @@ -39,3 +39,10 @@ (caseql (os-symbol) ((:linux :solaris :macos :android) (dlopen nil)) ((:cygwin) (dlopen "cygwin1.dll")))) + +(defmacro macro-time-let (:env env bindings . body) + (with-gensyms (invoke) + ^(macrolet ((,invoke () + (let ,bindings + (expand '(progn ,*body) ,env)))) + (,invoke)))) |