X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fthreads.impure.lisp;h=2d72ec1f895e4bbbdb9c8dbc630f2ed28fb4897e;hb=c70733ce291ef0f5b0f2dc19f085dfdeb1896b81;hp=d9d6f02980c784cedc1c58ca6dda4b210aeec44e;hpb=af4d83b57531e98d455f31980ef6359465d3d5a7;p=sbcl.git

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index d9d6f02..2d72ec1 100644
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -114,11 +114,10 @@
     (with-mutex (l)
       (with-recursive-lock (l)))))
 
-(let ((l (make-spinlock :name "spinlock"))
-      (p *current-thread*))
+(let ((l (make-spinlock :name "spinlock")))
   (assert (eql (spinlock-value l) 0) nil "1")
   (with-spinlock (l)
-    (assert (eql (spinlock-value l) p) nil "2"))
+    (assert (eql (spinlock-value l) 1) nil "2"))
   (assert (eql (spinlock-value l) 0) nil "3"))
 
 ;; test that SLEEP actually sleeps for at least the given time, even
@@ -497,7 +496,7 @@
 
 (defun send-gc ()
   (loop until (< *n-gcs-done* *n-gcs-requested*))
-  (format t "G" *n-gcs-requested* *n-gcs-done*)
+  (format t "G")
   (force-output)
   (sb-ext:gc)
   (incf *n-gcs-done*))
@@ -527,6 +526,7 @@
            (push (sb-thread:make-thread #'exercise-binding) threads)
            (push (sb-thread:make-thread (lambda ()
                                           (loop
+                                           (sleep 0.1)
                                            (send-gc))))
                  threads)
            (sleep 4))
@@ -534,7 +534,31 @@
 
 (format t "~&binding test done~%")
 
+;; Try to corrupt the NEXT-VECTOR. Operations on a hash table with a
+;; cyclic NEXT-VECTOR can loop endlessly in a WITHOUT-GCING form
+;; causing the next gc hang SBCL.
+(with-test (:name (:hash-table-thread-safety))
+  (let* ((hash (make-hash-table))
+         (threads (list (sb-thread:make-thread
+                         (lambda ()
+                           (loop
+                            ;;(princ "1") (force-output)
+                            (setf (gethash (random 100) hash) 'h))))
+                        (sb-thread:make-thread
+                         (lambda ()
+                           (loop
+                            ;;(princ "2") (force-output)
+                            (remhash (random 100) hash))))
+                        (sb-thread:make-thread
+                         (lambda ()
+                           (loop
+                            (sleep (random 1.0))
+                            (sb-ext:gc :full t)))))))
+    (unwind-protect
+         (sleep 5)
+      (mapc #'sb-thread:terminate-thread threads))))
 
+(format t "~&hash table test done~%")
 #|  ;; a cll post from eric marsden
 | (defun crash ()
 |   (setq *debugger-hook*