(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))
((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.
(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~%")
(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))
(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
(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))
;;; 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"