sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

stress tests: use a new timeout condition

Browse source
This commit is contained in:
Daniel Kochmański 2020-05-12 12:47:19 +02:00
parent 0ab85fc9d5
commit a059991c12
1 changed files with 2 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
src/tests/stress-tests/multiprocessing.lsp
View file

@ -162,11 +162,6 @@
;; Interrupts
(define-condition timeout (serious-condition)
((value :initarg :value :reader timeout-value))
(:report (lambda (c s)
(format s "timeout at ~a seconds" (timeout-value c)))))
;;; simplified version of with-timeout from bordeaux-threads
(defmacro with-timeout ((timeout) &body body)
`(let (sleeper)
@ -184,7 +179,7 @@
(ignore-errors
(throw 'timeout nil)))))))
(throw 'exit (progn ,@body))))
(error 'timeout :value ,timeout))
(error 'ext:timeout :value ,timeout))
(when (mp:process-active-p sleeper)
(ignore-errors (mp:process-kill sleeper))))))
@ -202,7 +197,7 @@
(let ((timeout-value (log-random 1e-8 1e-2)))
(handler-case
(with-timeout (timeout-value) (sleep (* timeout-value 10)))
(timeout (c)))))))
(ext:timeout (c)))))))
;; interrupt safety of binding special variables
(defvar *test-var* 0)