X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fthreads.impure.lisp;h=d2140d4c81384784f54208e03c0c4a5cb81cc93c;hb=68ea71d0f020f2726e3c56c1ec491d0af734b3a4;hp=c285c81acca221e1332be9b3d25d65be488da495;hpb=402958f92506b9d3de852601b8c1ccb99b5ee558;p=sbcl.git

diff --git a/tests/threads.impure.lisp b/tests/threads.impure.lisp
index c285c81..d2140d4 100644
--- a/tests/threads.impure.lisp
+++ b/tests/threads.impure.lisp
@@ -83,7 +83,8 @@
   (format o "void loop_forever() { while(1) ; }~%"))
 (sb-ext:run-program
  #-sunos "cc" #+sunos "gcc"
- (or #+(or linux freebsd sunos) '("-shared" "-o" "threads-foreign.so" "threads-foreign.c")
+ (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")
      (error "Missing shared library compilation options for this platform"))
  :search t)
@@ -609,11 +610,49 @@
               (force-output)
               (condition-broadcast queue)))))
 
+(format t "waitqueue wakeup tests done~%")
+
 (with-test (:name (:mutex :finalization))
   (let ((a nil))
     (dotimes (i 500000)
       (setf a (make-mutex)))))
 
+(format t "mutex finalization test done~%")
+
+;;; Check that INFO is thread-safe, at least when we're just doing reads.
+
+(let* ((symbols (loop repeat 10000 collect (gensym)))
+       (functions (loop for (symbol . rest) on symbols
+                        for next = (car rest)
+                        for fun = (let ((next next))
+                                    (lambda (n)
+                                      (if next
+                                          (funcall next (1- n))
+                                          n)))
+                        do (setf (symbol-function symbol) fun)
+                        collect fun)))
+  (defun infodb-test ()
+    (funcall (car functions) 9999)))
+
+(with-test (:name (:infodb :read))
+  (let* ((ok t)
+         (threads (loop for i from 0 to 10
+                        collect (sb-thread:make-thread
+                                 (let ((i i))
+                                   (lambda ()
+                                     (dotimes (j 100)
+                                       (write-char #\-)
+                                       (finish-output)
+                                       (let ((n (infodb-test)))
+                                         (unless (zerop n)
+                                           (setf ok nil)
+                                           (format t "N != 0 (~A)~%" n)
+                                           (quit))))))))))
+    (wait-for-threads threads)
+    (assert ok)))
+
+(format t "infodb test done~%")
+