X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fthreads.impure.lisp;h=eb4fe5a1b71a7c461777acdfdcdbbf05178758a3;hb=22593170e6f2d5204dd49e876cca93a0e033c02a;hp=144d3baf4e0601fa4c5d8daed82aa1243202db8c;hpb=353d8da16686b5cd1d75f95017c185b50f75cfda;p=sbcl.git diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp index 144d3ba..eb4fe5a 100644 --- a/tests/threads.impure.lisp +++ b/tests/threads.impure.lisp @@ -16,8 +16,10 @@ (use-package :test-util) (use-package "ASSERTOID") +(setf sb-unix::*on-dangerous-select* :error) + (defun wait-for-threads (threads) - (mapc (lambda (thread) (sb-thread:join-thread thread :errorp nil)) threads) + (mapc (lambda (thread) (sb-thread:join-thread thread :default nil)) threads) (assert (not (some #'sb-thread:thread-alive-p threads)))) (assert (eql 1 (length (list-all-threads)))) @@ -55,7 +57,6 @@ (with-test (:name '(:join-thread :nlx :default)) (let ((sym (gensym))) (assert (eq sym (join-thread (make-thread (lambda () (sb-ext:quit))) - :errorp nil :default sym))))) (with-test (:name '(:join-thread :nlx :error)) @@ -100,7 +101,8 @@ #-sunos "cc" #+sunos "gcc" (or #+(or linux freebsd sunos) '(#+x86-64 "-fPIC" "-shared" "-o" "threads-foreign.so" "threads-foreign.c") - #+darwin '("-dynamiclib" "-o" "threads-foreign.so" "threads-foreign.c") + #+darwin '(#+x86-64 "-arch" #+x86-64 "x86_64" + "-dynamiclib" "-o" "threads-foreign.so" "threads-foreign.c") (error "Missing shared library compilation options for this platform")) :search t) (sb-alien:load-shared-object "threads-foreign.so") @@ -127,16 +129,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 @@ -470,6 +491,7 @@ (format t "~&thread startup sigmask test done~%") +;; FIXME: What is this supposed to test? (sb-debug::enable-debugger) (let* ((main-thread *current-thread*) (interruptor-thread @@ -477,7 +499,8 @@ (sleep 2) (interrupt-thread main-thread #'break) (sleep 2) - (interrupt-thread main-thread #'continue))))) + (interrupt-thread main-thread #'continue)) + :name "interruptor"))) (with-session-lock (*session*) (sleep 3)) (loop while (thread-alive-p interruptor-thread)))