1
0
mirror of git://git.gnupg.org/gnupg.git synced 2024-09-22 15:11:41 +02:00

tests: Correctly handle exceptions in resource handling macros.

* 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>
This commit is contained in:
Justus Winter 2016-09-19 17:24:03 +02:00
parent ab483eff9a
commit 58007e5259

View File

@ -234,7 +234,9 @@
`((lambda (,(caaadr form)) `((lambda (,(caaadr form))
(let ((,result-sym (let ((,result-sym
,(if (= 1 (length (cadr form))) ,(if (= 1 (length (cadr form)))
`(begin ,@(cddr form)) `(catch (begin (close ,(caaadr form))
(apply throw *error*))
,@(cddr form))
`(letfd ,(cdadr form) ,@(cddr form))))) `(letfd ,(cdadr form) ,@(cddr form)))))
(close ,(caaadr form)) (close ,(caaadr form))
,result-sym)) ,@(cdaadr form)))) ,result-sym)) ,@(cdaadr form))))
@ -243,7 +245,9 @@
(let ((result-sym (gensym)) (cwd-sym (gensym))) (let ((result-sym (gensym)) (cwd-sym (gensym)))
`(let* ((,cwd-sym (getcwd)) `(let* ((,cwd-sym (getcwd))
(_ (if ,(cadr form) (chdir ,(cadr form)))) (_ (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) (chdir ,cwd-sym)
,result-sym))) ,result-sym)))
@ -264,7 +268,10 @@
`(let* ((,cwd-sym (getcwd)) `(let* ((,cwd-sym (getcwd))
(,tmp-sym (mkdtemp)) (,tmp-sym (mkdtemp))
(_ (chdir ,tmp-sym)) (_ (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) (chdir ,cwd-sym)
(unlink-recursively ,tmp-sym) (unlink-recursively ,tmp-sym)
,result-sym))) ,result-sym)))
@ -293,7 +300,9 @@
`((lambda (,(caadr form)) `((lambda (,(caadr form))
(let ((,result-sym (let ((,result-sym
,(if (= 1 (length (cadr form))) ,(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))))) `(lettmp ,(cdadr form) ,@(cddr form)))))
(remove-temporary-file ,(caadr form)) (remove-temporary-file ,(caadr form))
,result-sym)) (make-temporary-file ,(symbol->string (caadr form)))))) ,result-sym)) (make-temporary-file ,(symbol->string (caadr form))))))