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
1 changed files with 13 additions and 4 deletions

View File

@ -234,7 +234,9 @@
`((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))))
@ -243,7 +245,9 @@
(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)))
@ -264,7 +268,10 @@
`(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)))
@ -293,7 +300,9 @@
`((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))))))