How long does this wait? pasted by sjamaan on Sun Jan 5 20:27:19 2014

;;;; signal-tests.scm


#+mingw32
(begin
  (print "this test can not be run on Windows/mingw")
  (exit))


(use posix srfi-18 extras)

(define all-go? (make-parameter #f))

;; This is set before starting the child to avoid the race condition
;; from #877.  The child itself overwrites these signal handlers
;; before sending the "all go" signal (usr1) to the parent.
(set-signal-handler! signal/usr1 (lambda (sig) (all-go? #t)))

(define received1 0)
(define received2 0)

(define (tick c)
  (write-char c)
  (flush-output))

(define (handler sig)
  (select sig
    ((signal/usr1)
     (tick #\1)
     (set! received1 (add1 received1)))
    ((signal/usr2)
     (tick #\2)
     (set! received2 (add1 received2)))))

(define (fini _)
  (printf "~%child terminating, received: ~a USR1, ~a USR2~%"
    received1 received2)
  (exit))

(define (child)
  (print "child started")
  (thread-start!
   (lambda ()
     (do () (#f)
       (thread-sleep! 0.5)
       (tick #\_))))
  (set-signal-handler! signal/usr1 handler)
  (set-signal-handler! signal/usr2 handler)
  (set-signal-handler! signal/term fini)
  (process-signal (parent-process-id) signal/usr1)
  (do () (#f)
    (thread-sleep! 1)
    (tick #\.)))

(let ((pid (process-fork child))
      (sent1 0)
      (sent2 0))
  (print "Sleeping until child wakes us up") ; signal will interrupt the sleep
  (print "would have slept for " (sleep 10) " more seconds")
  (cond ((all-go?)
	 (print "sending signals to " pid)
	 (do ((i 1000 (sub1 i)))
	     ((zero? i))
	   (thread-sleep! (/ (random 10) 1000))
	   (do ((j (random 4) (sub1 j)))
	       ((zero? j))
	     (case (random 2)
	       ((0)
		(tick #\A)
		(set! sent1 (add1 sent1))
		(process-signal pid signal/usr1))
	       ((1)
		(tick #\B)
		(set! sent2 (add1 sent2))
		(process-signal pid signal/usr2)))))
	 (printf "~%signals sent: ~a USR1, ~a USR2~%" sent1 sent2)	
	 (print "terminating child process ...")
	 (process-signal pid)
	 (exit 0))
	(else (print "ERROR! Did not receive a signal from child within 10 seconds, or another process awoke us")
	      (print "terminating child process ...")
	      (exit 1))))

t.scm added by me and myself on Sun Jan 5 20:31:35 2014

Version 4.8.3 (rev 05d663c)
openbsd-unix-gnu-x86 [ manyargs dload ptables ]
compiled 2014-01-03 on necronomicon.my.domain (OpenBSD)



;; Compiled
; ./t
Sleeping until child wakes us up
child started
would have slept for 10 more seconds
sending signals to 32399
BAAA12.BB2.BB2.BA12.B2.B2.BBB2.AA1.B2.AAA1.A1.BA12.ABA12.A1.BAA12.BBB2.AAA1.ABB12._BBB2.B2.A1.BAB12.A1.AAA1.ABB12.BA12.ABB12.BAA12.A1.ABA12.AAA1.BBA12.BAA12.AB12._BA12.ABA12.AAB12.BBB2.ABB12.BB2.BAA12.BA12.B2.A1.AAB12.BA12.A1.A1.ABA12.BAA12.AAB12.BAB12.AA1.BAA12._B2.B2.BB2.BA12.BA12.ABA12.BBA12.BBA12.BA12.A1.AAB12.AAB12.A1.B2.A1.B2.AB12.BB2.B2.AA1.BBB2._B2.A1.A1.AA1.BA12.A1.AA1.ABA12.A1.A1.ABB12.AAAB12.B2.B2.A1.A1.ABA12._AA1.A1.BABA12.BA12.B2.AA1.BB2.AA1.BA12.AAA1.AA1.BB2.A1.A1.BBB2.AAB12.A1.BAABB12.BA12._A1.ABB12.AB12.B2.B2.AAA1.AA1.B2.AB12.BB2.AB12.AB12.AA1.AA1.ABA12.ABAAB12.AA1._B2.B2.AAA1.A1.AAA1.ABB12.A1.BB2.AABBA12.BA21.AB12.A1.AAA1.A1.AAA1.ABB12._BA12.B2.AA1.BA12.AB12.AAA1.B2.A1.BBA12.BAB12.BBA12.BB2.A1.A1.BB2.AABBAB12.B2.AA1.AB12.ABA12.AA1.B2.A1._BA12.AAB12.BAA12.A1.B2.BBA12.BA12.AA1.A1.A1B.2AA1.A1.ABA12.B2.AB12.BAA12.BA12.BB2.A1.BA12.BAB12.AB12.B2._AABB12.BAA12.AB12.BBA12.BB2.ABB12.ABB12.A1.B2.B2.B2.B2.BAA12.AB12.BA12.B2.A1.AA1.B2.BB2.B2._BBB2.BA12.A1.BBB2.ABA12.BBA12.AAB12.AB12.BA12.BAA12.AA1.BBA12.BBB2.B2.A1.A1._AA1.A1.B2.ABA12.BAA12.AB12.AAB12.ABA12.A1.ABA12.BBB2.BAA12.ABBB12.BBB2.BB2.BAA12.AA1.BBA12._BB2.AB12.AA1.B2.B2.A1.B2.B2.B2.AB12.BBA12.BAB12.AA1.ABA12.AAB12.A1.ABB12.BBA12.B2.ABAAAA12._BBA12.AB12.AAB12.BAA12.B2.AAA1.BAB12.BA12.BAB12.AAB12.BB2.B2.BAB12.A1.AB12.A1.BBA12.ABB12.AB12._B2.AB12.AB12.BA12.A1.BBB2.B2.A1.AB12.B2.BB2.A1.A1.BAA12.BB2.AAAA1.B2.BAB12.A1.AAB12.A1._AAA1.AAB12.ABA12.BBB2.AAAAAA1.B2.BB2.AB12.AAB12.B2AB21.BAB12.ABBA12.AA1.B2.B2.A1.AB12.BB2.BB2.A1._AA1.A1.A1.AA1.ABAABB12.B2.AAA1.AABAA12.B2.AAB12.AAAABBB12.BBBB2.AAA1.BB2.BA12.BA12.BBB2.BBB2.BB2.B2.AA1.AB12.AAB12._ABA12.A1.A1.A1.AAA1.BB2.BBA12.B2.BAB12.A1.BB2.A1.BAA12.AA1.BB2.B2.BAB12.BBA12.BA12._BB2.AB12.B2.BBBAAA12.BAA12.AA1.B2.A1.BAB12.BB2.B2.A1.AA1.AA1.BB2.A1.BBAAAB12.BB2.BBB2.BAA12.B2._AA1.AAABBB12.ABA12.B2.AAB12.A1.B2.BAA12.BB2.BBA12.AB12.AAB12.AB12.BBB2.AB12.BB2.BB2.BBA12._AA1.BA12.B2.A1.AAB12.AB12.BA12.AAA1.BBB2.ABA12.AA1.AA1.ABA12.A1.ABB12.AA1.B2.BA12.B2.AB12.ABA12._A1.A1.A1.BB2.AAA1.B2.BAB12.BB2.A1.AAABAB12.AAB12.ABB12.ABB12.A1.B2.BA12.ABB12.A1.A1.BAA12.BA12._AB12.B2.AAB12.BA12.AA1.ABA12.BBA12.ABA12.ABA12.AA1.A1.BA12.AB12.A1.BAB12.BBA12.ABABBAB12.B2._BBA12.ABB12.AA1.BAB12.BA12.BBB2.B2.BB2.A1.B2.AB12.BB2.ABB12.BABB12.BA12.BAB12.BA12.A1.BAA12.AAB12.BBB2._AAB12.AAB12.BB2.BAA12.BAA12.B2.B2.BA12.AA1.B2.ABBA12.ABB12.BAA12.B2.ABA12.BAB12.B2.AAB12._AA1.B2.AAB12.A1.AABAA12.B2.A1.AB12.BA12.BAB12.ABB12.AA1.A1.A1.BB2.BB2.AA1.BAB12._BA12.BBB2.BBAAAB12.BBA12.BA12.BBB2.BBB2.B2.BA12.AA1.B2.BAB12.B2.B2.ABB12.BBA12.B2.A1.A1._BAB12.AB12.A1.A1.ABA12.BA12.BA12.AA1.B2.AB12.BBB2.AA1.BBB2.AB12.B2.A1.B2.A1.BB2.AAA1._BB2.BBB2.AB12.BA12.B2.BBBB2.BBA12.B2.B2.AA1.AAA1.A1.BB2.A1.AABAA12.BA12.AAB12.BBA12.BBA12._BB2.AB12.BAA12.BAB12.AB12.AB12.BB2.A1.BBA12.BAA12.B2.AA1.BA12.BA12.A1.BB2.AA1._B2.ABBAAB12.ABB12.BAB12.BA12.AA1.A1.ABB12.B2.AAB12.BAB12.BA12.A1.A1.ABB12.AAB12.B2._BBA12.BAABAB12.BA12.BAB12.BB2.B2.AB12.AA1.A1.A1.A1.B2.B2.B2.ABA12.BAB12.BA12.A1.BABA12._AAB12.BA12.AA1.A1.A1.A1.BBA12.ABB12.AABAA12.AB12.AA1.BBB2.AA1.BAB12.BB2.B2.BB2.BBB2.AAA1.B2.BAABA12.AAA1._AA1.AB12.BA12.BAA12.AAA1.BBB2.A1.AA1.BAA12.ABA12.BBB2.BA12.BAA12.AB12.ABB12.A1.BBB2._ABB12.A1.AB
signals sent: 751 USR1, 728 USR2
terminating child process ...

child terminating, received: 494 USR1, 489 USR2