[racket] call-with-timeout
If I want to have a procedure or syntax that evaluates a block of code
with a timeout, and it needs to be perfectly reliable[*], then is the
below "call-with-timeout" procedure the way to do it?
[*] Except OK if the actual timeout period is up to a few seconds longer
than the specified one.
#lang racket/base
(define (call-with-timeout #:timeout-seconds timeout-seconds
#:proc proc
#:timeout-proc (timeout-proc #f))
(or (and (real? timeout-seconds)
(> timeout-seconds 0))
(error 'call-with-timeout
"expected timeout-seconds to be a nonnegative number, but
it is ~S"
timeout-seconds))
(let* ((proc-result (void))
(proc-exn #f)
(proc-thread (thread (lambda ()
(with-handlers ((exn? (lambda (e)
(set! proc-exn
e))))
(set! proc-result (proc)))))))
(if (sync/timeout/enable-break timeout-seconds proc-thread)
;; sync returned true, which means proc-thread finished
(if proc-exn
(raise proc-exn)
proc-result)
;; sync returned false, which means timeout
(if timeout-proc
(timeout-proc)
(void)))))
(module+ test
(require (planet neil/overeasy:3))
(test-section 'call-with-timeout
(test 'timeout-with-no-timeout-proc
(call-with-timeout #:timeout-seconds 1
#:proc (lambda () (sleep 30) 'proc-end))
(void))
(test 'timeout-with-timeout-proc
(call-with-timeout #:timeout-seconds 1
#:proc (lambda () (sleep 30) 'proc-end)
#:timeout-proc (lambda () 'timeout))
'timeout)
(test 'non-timeout-with-normal-exit
(call-with-timeout #:timeout-seconds 30
#:proc (lambda () (sleep 1) 'proc-end)
#:timeout-proc (lambda () 'timeout))
'proc-end)
(test #:id 'non-timeout-with-exception
#:code (call-with-timeout #:timeout-seconds 30
#:proc (lambda () (error "i am an
exception"))
#:timeout-proc (lambda () 'timeout))
#:exn "i am an exception")))
(Pardon the perhaps-excessive keywords. Their use makes sense in the
particular system for which this code is written.)
Neil V.