[Pkg-gnupg-commit] [gnupg2] 73/124: gpgscm: Make test cleanup more robust.

[Daniel Kahn Gillmor]

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

dkg pushed a commit to branch experimental
in repository gnupg2.

commit 178b6314ab2d2268873067314744c8af74dc331e
Author: Justus Winter <justus at g10code.com>
Date:   Thu Mar 23 10:55:34 2017 +0100

    gpgscm: Make test cleanup more robust.
    
    * tests/gpgscm/tests.scm (mkdtemp-autoremove): New function that
    cleans up at interpreter shutdown.
    (run-tests-parallel): Use the new function.
    (run-tests-sequential): Likewise.
    (make-environment-cache): Execute setup with an temporary working
    directory.
    --
    
    Make sure to remove all resources created in the filesystem even if
    the test runner is interrupted.  Make sure to remove anything that the
    setup script creates.
    
    Signed-off-by: Justus Winter <justus at g10code.com>
---
 tests/gpgscm/tests.scm | 31 +++++++++++++++++--------------
 1 file changed, 17 insertions(+), 14 deletions(-)

diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm
index a4339ca..592b36f 100644
--- a/tests/gpgscm/tests.scm
+++ b/tests/gpgscm/tests.scm
@@ -278,6 +278,15 @@
 						"-XXXXXX"))
 				(apply path-join components)))))
 
+;; Make a temporary directory and remove it at interpreter shutdown.
+;; Note that there are macros that limit the lifetime of temporary
+;; directories and files to a lexical scope.  Use those if possible.
+;; Otherwise this works like mkdtemp.
+(define (mkdtemp-autoremove . components)
+  (let ((dir (apply mkdtemp components)))
+    (atexit (lambda () (unlink-recursively dir)))
+    dir))
+
 (define-macro (with-temporary-working-directory . expressions)
   (let ((tmp-sym (gensym)))
     `(let* ((,tmp-sym (mkdtemp)))
@@ -621,12 +630,9 @@
   (let loop ((pool (test-pool::new '())) (tests' tests))
     (if (null? tests')
 	(let ((results (pool::wait)))
-	  (for-each (lambda (t)
-		      (catch (echo "Removing" t::directory "failed:" *error*)
-			     (unlink-recursively t::directory))
-		      (t::report)) (reverse results::procs))
+	  (for-each (lambda (t) (t::report)) (reverse results::procs))
 	  (exit (results::report)))
-	(let* ((wd (mkdtemp))
+	(let* ((wd (mkdtemp-autoremove))
 	       (test (car tests'))
 	       (test' (test::set-directory wd)))
 	  (loop (pool::add (test'::run-async))
@@ -638,12 +644,8 @@
   (let loop ((pool (test-pool::new '())) (tests' tests))
     (if (null? tests')
 	(let ((results (pool::wait)))
-	  (for-each (lambda (t)
-		      (catch (echo "Removing" t::directory "failed:" *error*)
-			     (unlink-recursively t::directory)))
-		    results::procs)
 	  (exit (results::report)))
-	(let* ((wd (mkdtemp))
+	(let* ((wd (mkdtemp-autoremove))
 	       (test (car tests'))
 	       (test' (test::set-directory wd)))
 	  (loop (pool::add (test'::run-sync))
@@ -654,10 +656,11 @@
 ;; Returns a promise containing the arguments that must be passed to a
 ;; test implementing the consumer side of the cache protocol.
 (define (make-environment-cache setup)
-  (delay (let* ((tarball (make-temporary-file "environment-cache")))
-	   (atexit (lambda () (remove-temporary-file tarball)))
-	   (setup::run-sync '--create-tarball tarball)
-	   `(--unpack-tarball ,tarball))))
+  (delay (with-temporary-working-directory
+	  (let ((tarball (make-temporary-file "environment-cache")))
+	    (atexit (lambda () (remove-temporary-file tarball)))
+	    (setup::run-sync '--create-tarball tarball)
+	    `(--unpack-tarball ,tarball)))))
 
 ;; Command line flag handling.  Returns the elements following KEY in
 ;; ARGUMENTS up to the next argument, or #f if KEY is not in

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