mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

More robust asyncs.test

Browse source 
* test-suite/tests/asyncs.test: Instead of wrapping abort-to-prompt with
false-if-exception, to handle edge cases, guard with
suspendable-continuation?: this also catches recursive invocations.
This commit is contained in:
Andy Wingo 2023-09-18 15:24:37 +02:00
parent 1ad31adf30
commit 850b724f85
1 changed files with 19 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

40
test-suite/tests/asyncs.test
View file

@ -82,11 +82,10 @@
(with-sigprof-interrupts
1000 ; Hz
(lambda ()
;; Could throw an exception if the prompt is
;; not active (i.e. interrupt happens
;; outside running a cothread). Ignore in
;; that case.
(false-if-exception (abort-to-prompt preempt-tag)))
;; Interrupt could fire outside running a cothread, or
;; recursively within an async; ignore in that case.
(when (suspendable-continuation? preempt-tag)
(abort-to-prompt preempt-tag)))
run-cothreads)
(equal? (atomic-box-ref box) 100))))
@ -118,22 +117,21 @@
(atomic-box-set! box (1+ x)))
(lp))))))
(let* ((main-thread (current-thread))
(preempt-thread (call-with-new-thread
(lambda ()
(let lp ()
(unless (= (atomic-box-ref box) 100)
(usleep 1000)
(system-async-mark
(lambda ()
;; Could throw an exception if the
;; prompt is not active
;; (i.e. interrupt happens outside
;; running a cothread). Ignore in
;; that case.
(false-if-exception
(abort-to-prompt preempt-tag)))
main-thread)
(lp)))))))
(preempt-thread
(call-with-new-thread
(lambda ()
(let lp ()
(unless (= (atomic-box-ref box) 100)
(usleep 1000)
(system-async-mark
(lambda ()
;; Interrupt could fire outside running a
;; cothread, or recursively within an async;
;; ignore in that case.
(when (suspendable-continuation? preempt-tag)
(abort-to-prompt preempt-tag)))
main-thread)
(lp)))))))
(run-cothreads)
(join-thread preempt-thread)
(equal? (atomic-box-ref box) 100)))))