diff options
| author | Justus Winter <justus@g10code.com> | 2016-09-19 17:24:03 +0200 |
|---|---|---|
| committer | Justus Winter <justus@g10code.com> | 2016-09-19 18:49:17 +0200 |
| commit | 58007e52593e6b0f838de2e464ceeacf22757018 (patch) | |
| tree | 31eb389c681bdb95ee6294494f9fc228b97183e8 /tests | |
| parent | tests: Refine exception handling. (diff) | |
| download | gnupg2-58007e52593e6b0f838de2e464ceeacf22757018.tar.xz gnupg2-58007e52593e6b0f838de2e464ceeacf22757018.zip | |
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>
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/gpgscm/tests.scm | 17 |
1 files changed, 13 insertions, 4 deletions
diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm index 7b88e0ebb..71ca3692a 100644 --- a/tests/gpgscm/tests.scm +++ b/tests/gpgscm/tests.scm @@ -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)))))) |