0.9.16.29:

        The new timer.impure test added in 0.9.16.21 uncovered some
        completely unrelated problems in a different test. Multiple
        simultaneous FIND-SYMBOLs on the same package could cause the
        package to become corrupted in a way that would cause further
        accesses to it to loop infinitely. This seems a bit harsh.

	* Remove the optimization (moving the table from which a
          symbol was found to the front of the package's table list)
          which was causing this problem. It didn't seem to have much
          of an performance effect anyway.
        * Fix the test that was accidentally triggering this bug and
          add a new test specifically for it.

diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp
index c9ff756..914e9ea 100644 (file)
--- a/src/code/target-package.lisp
+++ b/src/code/target-package.lisp
@@ -694,8 +694,7 @@ error if any of PACKAGES is not a valid package designator."
                  (values symbol nil))))))))
 
 ;;; Check internal and external symbols, then scan down the list
-;;; of hashtables for inherited symbols. When an inherited symbol
-;;; is found pull that table to the beginning of the list.
+;;; of hashtables for inherited symbols.
 (defun find-symbol* (string length package)
   (declare (simple-string string)
            (type index length))
@@ -716,8 +715,20 @@ error if any of PACKAGES is not a valid package designator."
           ((null table) (values nil nil))
         (with-symbol (found symbol (car table) string length hash ehash)
           (when found
-            (unless (eq prev head)
-              (shiftf (cdr prev) (cdr table) (cdr head) table))
+            ;; At this point we used to move the table to the
+            ;; beginning of the list, probably on the theory that we'd
+            ;; soon be looking up further items there. Unfortunately
+            ;; that was very much non-thread safe. Since the failure
+            ;; mode was nasty (corruption of the package in a way
+            ;; which would make symbol lookups loop infinitely) and it
+            ;; would be triggered just by doing reads to a resource
+            ;; that users can't do their own locking on, that code has
+            ;; been removed. If we ever add locking to packages,
+            ;; resurrecting that code might make sense, even though it
+            ;; didn't seem to have much of an performance effect in
+            ;; normal use.
+            ;;
+            ;; -- JES, 2006-09-13
             (return-from find-symbol* (values symbol :inherited))))))))
 
 ;;; Similar to FIND-SYMBOL, but only looks for an external symbol.

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index ed87761..43a60f3 100644 (file)
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -654,6 +654,19 @@
 
 (format t "infodb test done~%")
 
+(with-test (:name (:backtrace))
+  ;; Printing backtraces from several threads at once used to hang the
+  ;; whole SBCL process (discovered by accident due to a timer.impure
+  ;; test misbehaving). The cause was that packages weren't even
+  ;; thread-safe for only doing FIND-SYMBOL, and while printing
+  ;; backtraces a loot of symbol lookups need to be done due to
+  ;; *PRINT-ESCAPE*.
+  (let* ((threads (loop repeat 10
+                        collect (sb-thread:make-thread
+                                 (lambda ()
+                                   (dotimes (i 1000)
+                                     (with-output-to-string (*debug-io*)
+                                       (sb-debug::backtrace 10))))))))
+    (wait-for-threads threads)))
 
-
-
+(format t "backtrace test done~%")

diff --git a/tests/timer.impure.lisp b/tests/timer.impure.lisp
index 8a66453..220c659 100644 (file)
--- a/tests/timer.impure.lisp
+++ b/tests/timer.impure.lisp
@@ -13,6 +13,10 @@
 
 (use-package :test-util)
 
+(defmacro raises-timeout-p (&body body)
+  `(handler-case (progn (progn ,@body) nil)
+    (sb-ext:timeout () t)))
+
 (with-test (:name (:timer :relative))
   (let* ((has-run-p nil)
          (timer (make-timer (lambda () (setq has-run-p t))
@@ -84,10 +88,6 @@
     (sleep 2)
     (assert (zerop (length (sb-impl::%pqueue-contents sb-impl::*schedule*))))))
 
-(defmacro raises-timeout-p (&body body)
-  `(handler-case (progn (progn ,@body) nil)
-    (sb-ext:timeout () t)))
-
 (with-test (:name (:with-timeout :timeout))
   (assert (raises-timeout-p
            (sb-ext:with-timeout 0.2
@@ -110,14 +110,26 @@
             (sb-ext:with-timeout 2
               (sleep 2))))))
 
+(defun wait-for-threads (threads)
+  (loop while (some #'sb-thread:thread-alive-p threads) do (sleep 0.01)))
+
 #+sb-thread
 (with-test (:name (:with-timeout :many-at-the-same-time))
-  (loop repeat 10 do
-        (sb-thread:make-thread
-         (lambda ()
-           (sb-ext:with-timeout 0.5
-             (sleep 5)
-             (assert nil))))))
+  (let ((ok t))
+    (let ((threads (loop repeat 10 collect
+                         (sb-thread:make-thread
+                          (lambda ()
+                            (handler-case
+                                (sb-ext:with-timeout 0.5
+                                  (sleep 5)
+                                  (setf ok nil)
+                                  (format t "~%not ok~%"))
+                              (timeout ()
+                                )))))))
+      (assert (not (raises-timeout-p
+                    (sb-ext:with-timeout 20
+                      (wait-for-threads threads)))))
+      (assert ok))))
 
 #+sb-thread
 (with-test (:name (:with-timeout :dead-thread))

diff --git a/version.lisp-expr b/version.lisp-expr
index b3d0e9f..6c804ea 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".)
-"0.9.16.28"
+"0.9.16.29"