Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1:/tmp/cvs-serv560/tests
Modified Files:
Tag: stop_the_world_branch
threads.impure.lisp
Log Message:
0.8.2.38.stop_the_world.4
Scavenging the registers of other threads in interrupt
contexts is easier when they actually save said interrupt contexts
Clean up some compiler warnings in gencgc.c so that next-error
gets me to the real errors more quickly
Index: threads.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/threads.impure.lisp,v
retrieving revision 1.2
retrieving revision 1.2.2.1
diff -u -d -r1.2 -r1.2.2.1
--- threads.impure.lisp 16 Aug 2003 20:38:40 -0000 1.2
+++ threads.impure.lisp 20 Aug 2003 19:20:50 -0000 1.2.2.1
@@ -100,7 +100,8 @@
child))
;;; separate tests for (a) interrupting Lisp code, (b) C code, (c) a syscall,
-;;; (d) waiting on a lock
+;;; (d) waiting on a lock, (e) some code which we hope is likely to be
+;;; in pseudo-atomic
(let ((child (test-interrupt (lambda () (loop))))) (terminate-thread child))
@@ -124,5 +125,19 @@
;;hold onto lock for long enough that child can't get it immediately
(sleep 5))
(terminate-thread child))
+
+(defun alloc-stuff () (copy-list '(1 2 3 4 5)))
+(let ((c (test-interrupt (lambda () (loop (alloc-stuff))))))
+ ;; NB this only works on x86
+ (dotimes (i 100)
+ (sleep (random 1d0))
+ (interrupt-thread c
+ (lambda ()
+ (assert (not SB-KERNEL:*PSEUDO-ATOMIC-ATOMIC*))))))
+
+
+;; give the other thread time to die before we leave, otherwise the
+;; overall exit status is 0, not 104
+(sleep 2)
(sb-ext:quit :unix-status 104)
|