tests: Correctly handle exceptions in resource handling macros.
authorJustus Winter <justus@g10code.com>
Mon, 19 Sep 2016 15:24:03 +0000 (17:24 +0200)
committerJustus Winter <justus@g10code.com>
Mon, 19 Sep 2016 16:49:17 +0000 (18:49 +0200)
* tests/gpgscm/tests.scm (letfd): Correctly release resources when an
exception is thrown.
(with-working-directory): Likewise.
(with-temporary-working-directory): Likewise.
(lettmp): Likewise.

Signed-off-by: Justus Winter <justus@g10code.com>
tests/gpgscm/tests.scm

index 7b88e0e..71ca369 100644 (file)
     `((lambda (,(caaadr form))
        (let ((,result-sym
               ,(if (= 1 (length (cadr form)))
-                   `(begin ,@(cddr form))
+                   `(catch (begin (close ,(caaadr form))
+                                  (apply throw *error*))
+                           ,@(cddr form))
                    `(letfd ,(cdadr form) ,@(cddr form)))))
          (close ,(caaadr form))
          ,result-sym)) ,@(cdaadr form))))
   (let ((result-sym (gensym)) (cwd-sym (gensym)))
     `(let* ((,cwd-sym (getcwd))
            (_ (if ,(cadr form) (chdir ,(cadr form))))
-           (,result-sym (begin ,@(cddr form))))
+           (,result-sym (catch (begin (chdir ,cwd-sym)
+                                      (apply throw *error*))
+                               ,@(cddr form))))
        (chdir ,cwd-sym)
        ,result-sym)))
 
     `(let* ((,cwd-sym (getcwd))
            (,tmp-sym (mkdtemp))
            (_ (chdir ,tmp-sym))
-           (,result-sym (begin ,@(cdr form))))
+           (,result-sym (catch (begin (chdir ,cwd-sym)
+                                      (unlink-recursively ,tmp-sym)
+                                      (apply throw *error*))
+                               ,@(cdr form))))
        (chdir ,cwd-sym)
        (unlink-recursively ,tmp-sym)
        ,result-sym)))
     `((lambda (,(caadr form))
        (let ((,result-sym
               ,(if (= 1 (length (cadr form)))
-                   `(begin ,@(cddr form))
+                   `(catch (begin (remove-temporary-file ,(caadr form))
+                                  (apply throw *error*))
+                           ,@(cddr form))
                    `(lettmp ,(cdadr form) ,@(cddr form)))))
          (remove-temporary-file ,(caadr form))
          ,result-sym)) (make-temporary-file ,(symbol->string (caadr form))))))