04/07: tests: opensmtpd: Gracefully handle test failure.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit c215d9ec1ce108844b14c0c2952199a0da5f4176
Author: Ludovic Courtès <address@hidden>
AuthorDate: Mon Mar 16 12:18:59 2020 +0100

    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(-)

diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm
index 298918b..58172cd 100644
--- a/gnu/tests/mail.scm
+++ b/gnu/tests/mail.scm
@@ -140,16 +140,21 @@ match from any for local action inbound
                              (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)