0.9.1.6:

[sbcl.git] / tests / threads.impure.lisp

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index 4881bc4..6dca7f9 100644 (file)
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -49,7 +49,7 @@
  (or #+linux '("-shared" "-o" "threads-foreign.so" "threads-foreign.c")
      (error "Missing shared library compilation options for this platform"))
  :search t)
-(sb-alien:load-1-foreign "threads-foreign.so")
+(sb-alien:load-shared-object "threads-foreign.so")
 (sb-alien:define-alien-routine loop-forever sb-alien:void)
 
 
@@ -66,6 +66,14 @@
   (assert (eql (mutex-lock l) 0)  nil "6")
   (describe l))
 
+;; test that SLEEP actually sleeps for at least the given time, even
+;; if interrupted by another thread exiting/a gc/anything
+(let ((start-time (get-universal-time)))
+  (make-thread (lambda () (sleep 1))) ; kid waits 1 then dies ->SIG_THREAD_EXIT
+  (sleep 5)
+  (assert (>= (get-universal-time) (+ 5 start-time))))
+
+
 (let ((queue (make-waitqueue :name "queue"))
       (lock (make-mutex :name "lock")))
   (labels ((in-new-thread ()
@@ -194,6 +202,31 @@
   (loop
    (when (and a-done b-done) (return))
    (sleep 1)))
+
+(defun waste (&optional (n 100000))
+  (loop repeat n do (make-string 16384)))
+
+(loop for i below 100 do
+      (format t "LOOP:~A~%" i)
+      (force-output)
+      (sb-thread:make-thread
+       #'(lambda ()
+           (waste)))
+      (waste)
+      (sb-ext:gc))
+
+(defparameter *aaa* nil)
+(loop for i below 100 do
+      (format t "LOOP:~A~%" i)
+      (force-output)
+      (sb-thread:make-thread
+       #'(lambda ()
+           (let ((*aaa* (waste)))
+             (waste))))
+      (let ((*aaa* (waste)))
+        (waste))
+      (sb-ext:gc))
+
 (format t "~&gc test done~%")
 
 #|  ;; a cll post from eric marsden