[Sbcl-commits] CVS: sbcl/tests threads.impure.lisp,1.52,1.53

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv19748/tests

Modified Files:
	threads.impure.lisp 
Log Message:
1.0.6.7: thread-safe UPDATE-DFUN

 * Make GET-SPINLOCK detect unwanted recursion. Despite the old
   comments in GET/RELEASE-SPINLOCK, we can store EQ-comperable lisp
   objects in SPINLOCK-VALUE -- just like we do for mutexes.
   (Potentially freshly consed bignums that the old comments referred
   to are not sanely EQ-comperable, of course.)

 * Implement WITH-RECURSIVE-SPINLOCK.

 * Adjust thread.impure.lisp accordingly.

 * Add a per generic function spinlock. (We could use mutexes, but
   since contention is presumed to be rare we don't want to pay the
   wakeup syscall cost for every UPDATE-DFUN call: if and when our
   mutexes get smart doing the wakeup only when there are threads
   waiting we can and should switch this -- and probably almost all
   uses of spinlocks -- to mutexes.) This spinlock is grabbed to
   ensure that the dfun state, fin function, and name are all updated
   atomically.


Index: threads.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/threads.impure.lisp,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -d -r1.52 -r1.53
--- threads.impure.lisp	10 Apr 2007 04:18:10 -0000	1.52
+++ threads.impure.lisp	30 May 2007 13:56:00 -0000	1.53
@@ -127,16 +127,35 @@
       (assert (ours-p (mutex-value l)) nil "5"))
     (assert (eql (mutex-value l) nil) nil "6")))
 
+(labels ((ours-p (value)
+           (eq *current-thread* value)))
+  (let ((l (make-spinlock :name "rec")))
+    (assert (eql (spinlock-value l) nil) nil "1")
+    (with-recursive-spinlock (l)
+      (assert (ours-p (spinlock-value l)) nil "3")
+      (with-recursive-spinlock (l)
+        (assert (ours-p (spinlock-value l)) nil "4"))
+      (assert (ours-p (spinlock-value l)) nil "5"))
+    (assert (eql (spinlock-value l) nil) nil "6")))
+
 (with-test (:name (:mutex :nesting-mutex-and-recursive-lock))
   (let ((l (make-mutex :name "a mutex")))
     (with-mutex (l)
       (with-recursive-lock (l)))))
 
+(with-test (:name (:spinlock :nesting-spinlock-and-recursive-spinlock))
+  (let ((l (make-spinlock :name "a spinlock")))
+    (with-spinlock (l)
+      (with-recursive-spinlock (l)))))
+
 (let ((l (make-spinlock :name "spinlock")))
-  (assert (eql (spinlock-value l) 0) nil "1")
+  (assert (eql (spinlock-value l) nil) ((spinlock-value l))
+          "spinlock not free (1)")
   (with-spinlock (l)
-    (assert (eql (spinlock-value l) 1) nil "2"))
-  (assert (eql (spinlock-value l) 0) nil "3"))
+    (assert (eql (spinlock-value l) *current-thread*) ((spinlock-value l))
+            "spinlock not taken"))
+  (assert (eql (spinlock-value l) nil) ((spinlock-value l))
+          "spinlock not free (2)"))
 
 ;; test that SLEEP actually sleeps for at least the given time, even
 ;; if interrupted by another thread exiting/a gc/anything