[Pkg-gnupg-commit] [gnupg2] 226/292: tests: Log and display output from tests when run in parallel.

[Daniel Kahn Gillmor]

This is an automated email from the git hooks/post-receive script.

dkg pushed a commit to branch master
in repository gnupg2.

commit 2a7615c48ed79e6b28710cc293ce30c812b2e5b0
Author: Justus Winter <justus at g10code.com>
Date:   Tue Nov 8 15:54:56 2016 +0100

    tests: Log and display output from tests when run in parallel.
    
    * tests/openpgp/run-tests.scm (test): Add field 'logfd'.
    (test::new, test::set-*): Adapt accordingly.
    (test::set-logfd): New function.
    (test::open-log-file): Likewise.
    (test::run-sync): Use the new function.
    (test::run-async): Likewise.
    (test::report): Replay the log.
    (run-tests-parallel): Reverse the results to restore the original
    order.
    
    Signed-off-by: Justus Winter <justus at g10code.com>
---
 tests/openpgp/run-tests.scm | 33 ++++++++++++++++++++++-----------
 1 file changed, 22 insertions(+), 11 deletions(-)

diff --git a/tests/openpgp/run-tests.scm b/tests/openpgp/run-tests.scm
index 23ff8a2..90879a6 100644
--- a/tests/openpgp/run-tests.scm
+++ b/tests/openpgp/run-tests.scm
@@ -73,18 +73,23 @@
   (package
    (define (scm name . args)
      (new name #f `(,*argv0* ,@(verbosity (*verbose*)) , at args
-			     ,(in-srcdir name)) #f #f))
-   (define (new name directory command pid retcode)
+			     ,(in-srcdir name)) #f #f CLOSED_FD))
+   (define (new name directory command pid retcode logfd)
      (package
       (define (set-directory x)
-	(new name x command pid retcode))
+	(new name x command pid retcode logfd))
       (define (set-retcode x)
-	(new name directory command pid x))
+	(new name directory command pid x logfd))
       (define (set-pid x)
-	(new name directory command x retcode))
+	(new name directory command x retcode logfd))
+      (define (set-logfd x)
+	(new name directory command pid retcode x))
+      (define (open-log-file)
+	(let ((filename (string-append name ".log")))
+	  (catch '() (unlink filename))
+	  (open filename (logior O_RDWR O_BINARY O_CREAT) #o600)))
       (define (run-sync . args)
-	(letfd ((log (open (string-append name ".log")
-			   (logior O_WRONLY O_BINARY O_CREAT) #o600)))
+	(letfd ((log (open-log-file)))
 	  (with-working-directory directory
 	    (let* ((p (inbound-pipe))
 		   (pid (spawn-process-fd (append command args) 0
@@ -102,13 +107,19 @@
 	    name (spawn-process-fd (append command args)
 				   CLOSED_FD CLOSED_FD CLOSED_FD) #t))))
       (define (run-async . args)
-	(with-working-directory directory
-	  (set-pid (spawn-process-fd (append command args)
-				     CLOSED_FD CLOSED_FD CLOSED_FD))))
+	(let ((log (open-log-file)))
+	  (with-working-directory directory
+	    (new name directory command
+		 (spawn-process-fd (append command args) CLOSED_FD log log)
+		 retcode log))))
       (define (status)
 	(let ((t (assoc retcode '((0 "PASS") (77 "SKIP") (99 "ERROR")))))
 	  (if (not t) "FAIL" (cadr t))))
       (define (report)
+	(unless (= logfd CLOSED_FD)
+		(seek logfd 0 SEEK_SET)
+		(splice logfd STDERR_FILENO)
+		(close logfd))
 	(echo (string-append (status retcode) ":") name))))))
 
 (define (run-tests-parallel setup tests)
@@ -120,7 +131,7 @@
 	    (for-each (lambda (t)
 			(catch (echo "Removing" t::directory "failed:" *error*)
 			       (unlink-recursively t::directory))
-			(t::report)) results::procs)
+			(t::report)) (reverse results::procs))
 	    (exit (results::report)))
 	  (let* ((wd (mkdtemp))
 		 (test (car tests'))

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-gnupg/gnupg2.git