From 9aac8cfe0d3b3dd27b292e5661104221ddbd1bee Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 8 Nov 2010 13:03:56 +0000 Subject: [PATCH] 1.0.44.5: teach UNTRACE-1 how to actually untrace unbound functions Fixes the remainder of lp#667657. --- src/code/ntrace.lisp | 33 ++++++++++++++++++++------------- tests/debug.impure.lisp | 9 +++++++++ version.lisp-expr | 2 +- 3 files changed, 30 insertions(+), 14 deletions(-) diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp index 6e32b1d..5476378 100644 --- a/src/code/ntrace.lisp +++ b/src/code/ntrace.lisp @@ -648,20 +648,27 @@ are evaluated in the null environment." ;;; Untrace one function. (defun untrace-1 (function-or-name) (let* ((fun (trace-fdefinition function-or-name)) - (info (gethash fun *traced-funs*))) + (info (when fun (gethash fun *traced-funs*)))) (cond - ((not info) - (when fun - (warn "Function is not TRACEd: ~S" function-or-name))) - (t - (cond - ((trace-info-encapsulated info) - (unencapsulate (trace-info-what info) 'trace)) - (t - (sb-di:delete-breakpoint (trace-info-start-breakpoint info)) - (sb-di:delete-breakpoint (trace-info-end-breakpoint info)))) - (setf (trace-info-untraced info) t) - (remhash fun *traced-funs*))))) + ((and fun (not info)) + (warn "Function is not TRACEd: ~S" function-or-name)) + ((not fun) + ;; Someone has FMAKUNBOUND it. + (let ((table *traced-funs*)) + (with-locked-hash-table (table) + (maphash (lambda (fun info) + (when (equal function-or-name (trace-info-what info)) + (remhash fun table))) + table)))) + (t + (cond + ((trace-info-encapsulated info) + (unencapsulate (trace-info-what info) 'trace)) + (t + (sb-di:delete-breakpoint (trace-info-start-breakpoint info)) + (sb-di:delete-breakpoint (trace-info-end-breakpoint info)))) + (setf (trace-info-untraced info) t) + (remhash fun *traced-funs*))))) ;;; Untrace all traced functions. (defun untrace-all () diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp index f33a966..042763e 100644 --- a/tests/debug.impure.lisp +++ b/tests/debug.impure.lisp @@ -455,6 +455,15 @@ (assert (search "returned 1" out)) (assert (search "returned 120" out)))) +(defun trace-and-fmakunbound-this (x) + x) + +(with-test (:name :bug-667657) + (trace trace-and-fmakunbound-this) + (fmakunbound 'trace-and-fmakunbound-this) + (untrace) + (assert (not (trace)))) + (with-test (:name :bug-414) (handler-bind ((warning #'error)) (load (compile-file "bug-414.lisp")) diff --git a/version.lisp-expr b/version.lisp-expr index ce1ff25..deb7218 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.44.4" +"1.0.44.5" -- 1.7.10.4