~ chicken-core (chicken-5) 5649c906ee021f1310ccfee6693f4056929455ce

commit 5649c906ee021f1310ccfee6693f4056929455ce
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Sun Jan 5 20:38:43 2014 +0100
Commit:     Christian Kellermann <ckeen@pestilenz.org>
CommitDate: Thu Jan 23 10:58:02 2014 +0100

    Fix race condition in #877.
    
    Don't allow a flood of identical signals to hog the signal queue.
    
    In the test, just to be sure, first set up a signal that the child can
    send the parent when it's ready.  Then start sending signals to the child,
    so we know the child managed to set up all its handlers.
    
    Finally, wait for acknowledgement of child shutdown so we can detect
    whether the error persists.
    
    Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>

diff --git a/runtime.c b/runtime.c
index c90b9ddd..695abcfe 100644
--- a/runtime.c
+++ b/runtime.c
@@ -4471,9 +4471,16 @@ C_regparm void C_fcall C_raise_interrupt(int reason)
 #endif
       interrupt_time = C_cpu_milliseconds();
       pending_interrupts[ pending_interrupts_count++ ] = reason;
-    } else if(reason != C_TIMER_INTERRUPT_NUMBER &&
-              pending_interrupts_count < MAX_PENDING_INTERRUPTS) {
-      /* drop signals if too many */
+    } else if(pending_interrupts_count < MAX_PENDING_INTERRUPTS) {
+      int i;
+      /*
+       * Drop signals if too many, but don't queue up multiple entries
+       * for the same signal.
+       */
+      for (i = 0; i < pending_interrupts_count; ++i) {
+        if (pending_interrupts[i] == reason)
+          return;
+      }
       pending_interrupts[ pending_interrupts_count++ ] = reason;
     }
   }
diff --git a/tests/signal-tests.scm b/tests/signal-tests.scm
index 3d685e2f..0289fdc9 100644
--- a/tests/signal-tests.scm
+++ b/tests/signal-tests.scm
@@ -9,6 +9,12 @@
 
 (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)
@@ -29,41 +35,61 @@
 (define (fini _)
   (printf "~%child terminating, received: ~a USR1, ~a USR2~%"
     received1 received2)
+  (thread-sleep! 0.5)
+  (process-signal (parent-process-id) signal/usr1)
   (exit))
 
 (define (child)
   (print "child started")
-  (thread-start! 
+  (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)   
-  (do () (#f) 
+  (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))
-  (sleep 1)
-  (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))
+  (print "Sleeping until child wakes us up") ; signal *should* interrupt the sleep
+  (print "would have slept for " (sleep 5) " 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 ...")
+	 (all-go? #f)
+	 (print "Sending signal and waiting for acknowledgement from child")
+	 (process-signal pid signal/term)
+	 (unless (all-go?) ; There's a bit of a race condition here, but that's okay
+	   (print "Would've slept for " (sleep 5) " more seconds"))
+	 (cond ((all-go?)
+		(print "Everything is ok!")
+		(exit 0))
+	       (else
+		(print "ERROR! Did not receive acknowledgement of child shutdown within 5 seconds, or another process awoke us")
+		(print "Attempting to kill child forcefully via SIGKILL")
+		(process-signal pid signal/kill)
+		(exit 1))))
+	(else (print "ERROR! Did not receive a signal from child within 10 seconds, or another process awoke us")
+	      (print "terminating child process ...")
+	      (exit 1))))