Commit b3907e26 authored by Juho Snellman's avatar Juho Snellman
Browse files

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.
parent 1600081c
Loading
Loading
Loading
Loading
+15 −4
Original line number Diff line number Diff line
@@ -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.
+15 −2
Original line number Diff line number Diff line
@@ -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~%")
+22 −10
Original line number Diff line number Diff line
@@ -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
  (let ((ok t))
    (let ((threads (loop repeat 10 collect
                         (sb-thread:make-thread
                          (lambda ()
                            (handler-case
                                (sb-ext:with-timeout 0.5
                                  (sleep 5)
             (assert nil))))))
                                  (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))
+1 −1
Original line number Diff line number Diff line
@@ -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"