1.0.44.5: teach UNTRACE-1 how to actually untrace unbound functions

  Fixes the remainder of lp#667657.

diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp
index 6e32b1d..5476378 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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"