From c215d9ec1ce108844b14c0c2952199a0da5f4176 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 16 Mar 2020 12:18:59 +0100 Subject: tests: opensmtpd: Gracefully handle test failure. Previously the 'wait' loop would run for ~1024 seconds, at which point we'd reach the file descriptor limit due to the leak in 'queue-empty?'. * gnu/tests/mail.scm (run-opensmtpd-test)[test]("mail arrived"): In 'queue-empty?', close PIPE to avoid file descriptor leak. In 'wait' loop, arrange to run at most 20 times. --- gnu/tests/mail.scm | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) (limited to 'gnu/tests') diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm index 298918b3a7..58172cd1d6 100644 --- a/gnu/tests/mail.scm +++ b/gnu/tests/mail.scm @@ -140,16 +140,21 @@ (define (read-reply-code port) (ice-9 rdelim)) (define (queue-empty?) - (eof-object? - (read-line - (open-input-pipe - (string-append #$(file-append opensmtpd "/sbin/smtpctl") - " show queue"))))) - - (let wait () - (if (queue-empty?) - (file-exists? "/var/mail/root") - (begin (sleep 1) (wait))))) + (let* ((pipe (open-pipe* OPEN_READ + #$(file-append opensmtpd + "/sbin/smtpctl") + "show" "queue")) + (line (read-line pipe))) + (close-pipe pipe) + (eof-object? line))) + + (let wait ((n 20)) + (cond ((queue-empty?) + (file-exists? "/var/mail/root")) + ((zero? n) + (error "root mailbox didn't show up")) + (else + (sleep 1) (wait (- n 1)))))) marionette)) (test-end) -- cgit v1.2.3