[Sbcl-commits] CVS: sbcl/tests threads.impure.lisp,1.2,1.2.2.1

[Daniel B. <da...@us...>]

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)