Hi,
It turns out I can't find a repository revision where it works. All of the
major tagged releases fail, including 1.8.1, which makes me suspicious,
because my Debian-installed guile 1.8.1 continues to work (see below). Is
there a place to look for Debian's possible modifications to guile? Might
something else be going on?
I've attached a small test suite that should demonstrate the problem. Can
anyone else reproduce it? Can anyone else see it pass on 1.8.1 or any
other version?
Thanks,
Grem
$ /usr/bin/guile ../test-timeout.scm
1.8.1
good!
$ libguile/guile ../test-timeout.scm
1.8.1
fell asleepExpected: specified handler
Observed: #<unspecified>
should time out with specified handler
$ git log | head -1 # tag release_1-8-1
commit 2e726f11258f3d77557310fd50c02774fdcf014f
Hi,
Gregory Marton <[EMAIL PROTECTED]> writes:
Now with automake 1.10, autoreconf -i --force complains,
configure.in:717: required file `./config.rpath' not found
How may I provide that?
This should be installed by "autoreconf -fi" or "./autogen.sh", or
perhaps by "gettextize -f".
Hope this helps,
Ludovic.
--
------ __@ Gregory A. Marton http://csail.mit.edu/~gremio/
--- _`\<,_ .
-- (*)/ (*) When two hearts race, both win.
~~~~~~~~~~~~~~~~-~~~~~~~~_~~~_~~~~~v~~~~^^^^~~~~~--~~~~~~~~~~~~~~~++~~~~~~~
(define (ensure body-lambda ensuring-lambda)
(dynamic-wind
(lambda () #t)
body-lambda
ensuring-lambda))
(define (with-sigaction signum handler flags lamb)
(let ((old-sigaction (sigaction signum)))
(if flags (sigaction signum handler flags) (sigaction signum handler))
(ensure
lamb
(lambda ()
(sigaction signum (car old-sigaction) (cdr old-sigaction))))))
(define (with-timeout t thunk . handler)
(let ((time-left (alarm 0)) ;;time left on an outer alarm
(start-time (current-time)))
(alarm time-left) ;;continue the outer countdown
(catch 'parent-timeout-error
(lambda ()
(catch 'timeout-error
(lambda ()
(with-sigaction SIGALRM
(lambda (sig)
(if (and (< time-left t) (not (equal? time-left 0)))
(throw 'parent-timeout-error)
(throw 'timeout-error)))
#f
(lambda ()
(ensure
(lambda ()
(begin
(if (or (< t time-left) (equal? time-left 0))
(alarm t)) ;;time out in the shorter time, not the
most recently set time
(thunk)))
(lambda ()
(if (equal? time-left 0)
(alarm 0)
;;reset the outer alarm if there was one, subtracting
time taken by the thunk
(let* ((time-taken (- (current-time) start-time))
(time-remaining (- time-left time-taken)))
(alarm 0)
(if (<= 0 time-remaining) ; guile 1.3 is broken and
(alarm time-remaining) ; this can happen.
(raise SIGALRM))))))))) ;better late than never?
(lambda (k . v)
(if (null? handler)
(throw k)
((car handler))))))
(lambda (k . v)
(raise SIGALRM)))))
(define (assert-equals expected observed message)
(if (equal? expected observed)
#t
(begin
(map display (list "Expected: " expected "\nObserved: " observed
"\n" message "\n"))
#f)))
(display (version)) (newline)
(if (and
(assert-equals 7 (with-timeout 2 (lambda () (+ 2 5)))
"should not time out")
(assert-equals
'caught
(catch 'timeout-error
(lambda () (with-timeout 2 (lambda ()
(while #t "infinite monkeys"))))
(lambda (k . v) 'caught))
"should time out with default handler")
(assert-equals
"specified handler"
(with-timeout 2
(lambda () (begin (sleep 4) (display "fell asleep")))
(lambda () "specified handler"))
"should time out with specified handler")
(assert-equals
9
(with-timeout 2
(lambda ()
(let ((foo (+ 2 3)))
(with-timeout 2 (lambda () (+ foo 4))))))
"nested timeouts that should not time out")
(assert-equals
"inner timeout"
(with-timeout 5
(lambda ()
(let ((foo (+ 2 3)))
(with-timeout 2
(lambda () (sleep 10))
(lambda () "inner timeout"))))
(lambda () "outer timeout"))
"nested timeouts where the inner one should time out")
(assert-equals
"outer timeout"
(with-timeout 2
(lambda ()
(let ((foo (+ 2 3)))
(with-timeout
5
(lambda ()
(begin
(sleep 10)
(display "oh no, you fell asleep!")))
(lambda () "inner timeout"))))
(lambda () "outer timeout"))
"outer time has expired, and outer handler is used")
(assert-equals
"outer timeout"
(with-timeout 2
(lambda ()
(let ((foo (+ 2 3)))
(with-timeout 5
(lambda () (+ 8 7))
(lambda () "inner timeout"))
(sleep 10)
"oh no, you fell asleep!"))
(lambda () "outer timeout"))
(string-append "nested timeouts where the inner one should finish "
"but the outer one should still time out"))
(assert-equals
"outer timeout"
(with-timeout 2
(lambda ()
(let ((foo (+ 2 3)))
(with-timeout 2
(lambda ()
(+ 8 7))
(lambda ()
"inner timeout"))
(sleep 10)
"oh no, you fell asleep!"))
(lambda ()
"outer timeout"))
"when the times are the same, the outer handler is used")
)
(display "good!\n")
(primitive-exit 1))