WITH-SPINLOCK compatibility layer was broken
authorNikodemus Siivola <nikodemus@random-state.net>
Fri, 9 Dec 2011 19:00:44 +0000 (21:00 +0200)
committerNikodemus Siivola <nikodemus@random-state.net>
Fri, 9 Dec 2011 21:52:17 +0000 (23:52 +0200)
  Copy-paste damage from WITH-RECURSIVE-LOCK, looks like.  We don't have a
  WITH-LOCK and never did, should be WITH-MUTEX.

src/code/thread.lisp
tests/threads.impure.lisp

index a780b16..5188793 100644 (file)
@@ -95,7 +95,7 @@ stale value, use MUTEX-OWNER instead."
 
 (sb!xc:defmacro with-spinlock ((lock) &body body)
   (deprecation-warning :early "1.0.53.11" 'with-recursive-spinlock 'with-mutex)
-  `(with-lock (,lock)
+  `(with-mutex (,lock)
      ,@body))
 
 (sb!xc:defmacro without-thread-waiting-for ((&key already-without-interrupts) &body body)
index 71eb25e..8bd9f19 100644 (file)
     (let ((res (list (sb-thread:join-thread t1)
                      (sb-thread:join-thread t2))))
       (assert (equal '(:ok :ok) res)))))
+
+(with-test (:name :spinlock-api)
+  (let* ((warned 0)
+         (funs
+           (handler-bind ((sb-int:early-deprecation-warning (lambda (_)
+                                                              (declare (ignore _))
+                                                              (incf warned))))
+             (list (compile nil `(lambda (lock)
+                                   (sb-thread::with-spinlock (lock)
+                                     t)))
+                   (compile nil `(lambda ()
+                                   (sb-thread::make-spinlock :name "foo")))
+                   (compile nil `(lambda (lock)
+                                   (sb-thread::get-spinlock lock)))
+                   (compile nil `(lambda (lock)
+                                   (sb-thread::release-spinlock lock)))))))
+    (assert (eql 4 warned))
+    (handler-bind ((warning #'error))
+      (destructuring-bind (with make get release) funs
+        (let ((lock (funcall make)))
+          (funcall get lock)
+          (funcall release lock)
+          (assert (eq t (funcall with lock))))))))