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.

____________________
 Racket Users list:
 http://lists.racket-lang.org/users

Reply via email to