diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2018-04-08 07:24:11 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2018-04-08 07:24:11 -0700 |
commit | 5bb2c0f79e82fe0089b7f0ea89312f27753be4f9 (patch) | |
tree | 2bd1b98ebaabd0c7832d79f51dcb616d118165ec | |
parent | de38c6bb5c6d3f20a8f2b69a79f320fea7262540 (diff) | |
download | txr-5bb2c0f79e82fe0089b7f0ea89312f27753be4f9.tar.gz txr-5bb2c0f79e82fe0089b7f0ea89312f27753be4f9.tar.bz2 txr-5bb2c0f79e82fe0089b7f0ea89312f27753be4f9.zip |
trace: bugfix: redefine check mustn't throw exceptions.
* share/txr/stdlib/trace.tl (sys:trace-canonicalize-name):
Don't call static-slot-home on something that might not be a
struct type symbol. Otherwise the trace module will throw
whenever some lookup is performed for a non-existent
method. That means that when trace is loaded, it is impossible
to define a method with defun.
-rw-r--r-- | share/txr/stdlib/trace.tl | 16 |
1 files changed, 10 insertions, 6 deletions
diff --git a/share/txr/stdlib/trace.tl b/share/txr/stdlib/trace.tl index 44dba55f..4815ab4f 100644 --- a/share/txr/stdlib/trace.tl +++ b/share/txr/stdlib/trace.tl @@ -41,12 +41,16 @@ (defun sys:trace-canonicalize-name (name) (if (and (consp name) (eq (car name) 'meth)) - (let* ((req-type (cadr name)) - (sym (caddr name))) - (let ((actual-type (static-slot-home req-type sym))) - (if (eq req-type actual-type) - name - ^(meth ,actual-type ,sym)))) + (let* ((req-type-sym (cadr name)) + (slot-sym (caddr name)) + (req-type (find-struct-type req-type-sym)) + (s-s-p (if req-type + (static-slot-p req-type slot-sym))) + (actual-type-sym (if s-s-p + (static-slot-home req-type-sym slot-sym)))) + (if (and s-s-p (neq req-type-sym actual-type-sym)) + ^(meth ,actual-type-sym ,slot-sym) + name)) name)) (defun sys:trace (names) |