diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-04-19 07:23:47 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-04-19 07:23:47 -0700 |
| commit | b0469c2779c0879a25631675b3547a13f55e3e91 (patch) | |
| tree | e5432da40b2175742b3a1b62feb0ed7adb550109 | |
| parent | 35db3eee550d7d97e35c1dc58615b6530dd13360 (diff) | |
| download | txr-b0469c2779c0879a25631675b3547a13f55e3e91.tar.gz txr-b0469c2779c0879a25631675b3547a13f55e3e91.tar.bz2 txr-b0469c2779c0879a25631675b3547a13f55e3e91.zip | |
compile/eval: print compiler error on *stderr*.
* share/txr/stdlib/error.tl (compile-error): Print the
error message on *stderr*, like we do with warnings.
This allows the programming environment to pick up the
error message and navigate to that line accordingly.
The error message is also output by the unhandled exception
logic but with a prefix that prevents parsing by the tooling.
To avoid sending double error messages to the interactive
user, we only issue the *stderr* message if *load-recursive*
is true.
* tests/common.tl (macro-time-let): New macro. This lets us
bind special variables around the macro-expansion of the body,
which is useful when expansion-time logic reacts to values
of special variables.
* tests/012/ifa.tl: Use macro-time-let to suppress *stderr*
around the expansion of the erroneous ifa form.
We now needs this because the error situation spits out a
message on *stderr*, in addition to throwing.
| -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)))) |