From 23953bc6b14c93f59268996554c18706c8e16581 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Thu, 13 Mar 2008 10:32:40 +0000 Subject: [PATCH] 1.0.15.21: SB-BSD-SOCKETS:NAME-SERVICE-ERROR to inherit from ERROR * Thanks to Stanislaw Halik. --- NEWS | 5 +++ contrib/sb-bsd-sockets/name-service.lisp | 2 +- tests/timer.impure.lisp | 68 +++++++++++++++++++++++++++++- 3 files changed, 73 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index 87652e1..2aa14d3 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,8 @@ changes in sbcl-1.0.16 relative to 1.0.15: * minor incompatible change: change PROBE-FILE back to returning NIL whenever we can't get a truename, as was the case before 1.0.14. + * minor incompatible change: SB-BSD-SOCKETS:NAME-SERVICE-ERROR now + inherits from ERROR instead of just CONDITION. * optimization: binding special variables now generates smaller code on threaded platforms. * optimization: MEMBER and ASSOC are over 50% faster for :TEST #'EQ @@ -11,6 +13,9 @@ changes in sbcl-1.0.16 relative to 1.0.15: * optimization: modular arithmetic for a particular requested width is implemented using a tagged representation unless a better representation is available. + * bug fix: attempt to obtain *SCHEDULER-LOCK* recursively when + unscheduling timer at the same time as another timer fires. + * bug fix: don't reschedule timers for dead threads. * bug fix: periodic polling was broken. (thanks to Espen S Johnsen) * bug fix: copying output from RUN-PROGRAM to a stream signalled bogus errors if select() was interrupted. diff --git a/contrib/sb-bsd-sockets/name-service.lisp b/contrib/sb-bsd-sockets/name-service.lisp index 3378ffa..3b2d576 100644 --- a/contrib/sb-bsd-sockets/name-service.lisp +++ b/contrib/sb-bsd-sockets/name-service.lisp @@ -170,7 +170,7 @@ GET-NAME-SERVICE-ERRNO") (let ((condition (condition-for-name-service-error-code error-code))) (error condition :error-code error-code :syscall where))) -(define-condition name-service-error (condition) +(define-condition name-service-error (error) ((errno :initform nil :initarg :errno :reader name-service-error-errno) (error-code :initform nil :initarg :error-code :reader name-service-error-error-code) diff --git a/tests/timer.impure.lisp b/tests/timer.impure.lisp index 0c8bca3..29d2fbd 100644 --- a/tests/timer.impure.lisp +++ b/tests/timer.impure.lisp @@ -151,7 +151,7 @@ ;;; FIXME: Since timeouts do not work on Windows this would loop ;;; forever. #-win32 -(with-test (:name '(:hash-cache :interrupt)) +(with-test (:name (:hash-cache :interrupt)) (let* ((type1 (random-type 500)) (type2 (random-type 500)) (wanted (subtypep type1 type2))) @@ -164,3 +164,69 @@ 0.05) (loop (assert (eq wanted (subtypep type1 type2)))))))) + +#+sb-thread +(with-test (:name (:timer :parallel-unschedule)) + (let ((timer (sb-ext:make-timer (lambda () 42) :name "parallel schedulers")) + (other nil)) + (flet ((flop () + (sleep (random 0.01)) + (loop repeat 10000 + do (sb-ext:unschedule-timer timer)))) + (loop repeat 5 + do (mapcar #'sb-thread:join-thread + (loop for i from 1 upto 10 + collect (let* ((thread (sb-thread:make-thread #'flop + :name (format nil "scheduler ~A" i))) + (ticker (sb-ext:make-timer (lambda () 13) :thread (or other thread) + :name (format nil "ticker ~A" i)))) + (setf other thread) + (sb-ext:schedule-timer ticker 0 :repeat-interval 0.00001) + thread))))))) + +;;;; OS X doesn't like these being at all, and gives us a SIGSEGV +;;;; instead of using the Mach expection system! Our or OS X's fault? +;;;; :/ + +(with-test (:name (:timer :schedule-stress)) + (flet ((test () + (let* ((slow-timers (loop for i from 1 upto 100 + collect (sb-ext:make-timer (lambda () 13) :name (format nil "slow ~A" i)))) + (fast-timer (sb-ext:make-timer (lambda () 42) :name "fast"))) + (sb-ext:schedule-timer fast-timer 0.0001 :repeat-interval 0.0001) + (dolist (timer slow-timers) + (sb-ext:schedule-timer timer (random 0.1) :repeat-interval (random 0.1))) + (dolist (timer slow-timers) + (sb-ext:unschedule-timer timer)) + (sb-ext:unschedule-timer fast-timer)))) + #+sb-thread + (mapcar #'sb-thread:join-thread (loop repeat 10 collect (sb-thread:make-thread #'test))) + #-sb-thread + (loop repeat 10 do (test)))) + +#+sb-thread +(with-test (:name (:timer :threaded-stress)) + (let ((barrier (sb-thread:make-semaphore)) + (goal 100)) + (flet ((wait-for-goal () + (let ((*n* 0)) + (declare (special *n*)) + (sb-thread:signal-semaphore barrier) + (loop until (eql *n* goal)))) + (one () + (declare (special *n*)) + (incf *n*))) + (let ((threads (list (sb-thread:make-thread #'wait-for-goal) + (sb-thread:make-thread #'wait-for-goal) + (sb-thread:make-thread #'wait-for-goal)))) + (sb-thread:wait-on-semaphore barrier) + (sb-thread:wait-on-semaphore barrier) + (sb-thread:wait-on-semaphore barrier) + (flet ((sched (thread) + (sb-thread:make-thread (lambda () + (loop repeat goal + do (sb-ext:schedule-timer (make-timer #'one :thread thread) 0.001)))))) + (dolist (thread threads) + (sched thread))) + (with-timeout (truncate goal 100) + (mapcar #'sb-thread:join-thread threads)))))) -- 1.7.10.4