[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH 3/5] base: Call 'child-cleanup' when 'select' returns an empty se
From: |
Ludovic Courtès |
Subject: |
[PATCH 3/5] base: Call 'child-cleanup' when 'select' returns an empty set. |
Date: |
Sun, 23 Feb 2020 18:49:52 +0100 |
Previously, on Guile >= 2.2, we'd lose this opportunity to call
'child-cleanup', possibly leaving zombies behind us.
* src/mcron/base.scm (run-job-loop): Define 'select*'. Don't expect
'select*' to throw upon EINTR or EAGAIN.
---
src/mcron/base.scm | 40 ++++++++++++++++++++++++++--------------
1 file changed, 26 insertions(+), 14 deletions(-)
diff --git a/src/mcron/base.scm b/src/mcron/base.scm
index 17ddd5c..572d45b 100644
--- a/src/mcron/base.scm
+++ b/src/mcron/base.scm
@@ -1,7 +1,7 @@
;;;; base.scm -- core procedures
;;; Copyright © 2003 Dale Mellor <address@hidden>
;;; Copyright © 2015, 2016, 2018 Mathieu Lirzin <address@hidden>
-;;; Copyright © 2016 Ludovic Courtès <address@hidden>
+;;; Copyright © 2016, 2020 Ludovic Courtès <address@hidden>
;;;
;;; This file is part of GNU Mcron.
;;;
@@ -210,6 +210,20 @@ next value."
;; case we break out of the loop here, and let the main procedure deal with
;; the situation (it will eventually re-call this function, thus maintaining
;; the loop).
+ (cond-expand
+ ((or guile-3.0 guile-2.2) ;2.2 and 3.0
+ (define select* select))
+ (else
+ ;; On Guile 2.0, 'select' could throw upon EINTR or EAGAIN.
+ (define (select* read write except time)
+ (catch 'system-error
+ (lambda ()
+ (select read write except time))
+ (lambda args
+ (if (member (system-error-errno args) (list EAGAIN EINTR))
+ '(() () ())
+ (apply throw args)))))))
+
(call-with-current-continuation
(lambda (break)
(let loop ()
@@ -218,19 +232,17 @@ next value."
(let ((sleep-time (if next-time
(- next-time (current-time))
2000000000)))
- (when (and
- (> sleep-time 0)
- (not (null? (catch 'system-error
- (λ ()
- (car (select fd-list '() '() sleep-time)))
- (λ (key . args)
- (let ((err (car (last args))))
- (cond ((member err (list EINTR EAGAIN))
- (child-cleanup)
- '())
- (else
- (apply throw key args)))))))))
- (break))
+ (when (> sleep-time 0)
+ (match (select* fd-list '() '() sleep-time)
+ ((() () ())
+ ;; 'select' returned an empty set, perhaps because it got
+ ;; EINTR or EAGAIN. It's a good time to wait for child
+ ;; processes.
+ (child-cleanup))
+ (((lst ...) () ())
+ ;; There's some activity so leave the loop.
+ (break))))
+
(for-each run-job next-jobs-lst)
(child-cleanup)
(loop))))))))
--
2.25.1