[racket] call-with-timeout

From: Neil Van Dyke (neil at neilvandyke.org)
Date: Fri Nov 15 15:23:28 EST 2013

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.


Posted on the users mailing list.