aboutsummaryrefslogtreecommitdiffstats
path: root/tests/gpgscm/init.scm
diff options
context:
space:
mode:
authorJustus Winter <[email protected]>2016-12-22 13:42:50 +0000
committerJustus Winter <[email protected]>2017-01-02 10:02:34 +0000
commitb79274a3b7e58f88e9a8c1dc1fb24dd3e983543c (patch)
treec2a73dd4a9288f804d50794e6fd9439514d53d0f /tests/gpgscm/init.scm
parentgpgscm: Use boxed values for source locations. (diff)
downloadgnupg-b79274a3b7e58f88e9a8c1dc1fb24dd3e983543c.tar.gz
gnupg-b79274a3b7e58f88e9a8c1dc1fb24dd3e983543c.zip
gpgscm: Add 'finally', rework all macros.
* tests/gpgscm/init.scm (finally): New macro. * tests/gpgscm/tests.scm (letfd): Rewrite. (with-working-directory): Likewise. (with-temporary-working-directory): Likewise. (lettmp): Likewise. -- Rewrite all our macros using 'define-macro'. Use the new control flow mechanism 'finally', or 'dynamic-wind' where appropriate. Make sure the macros are hygienic. Reduce code duplication. Signed-off-by: Justus Winter <[email protected]>
Diffstat (limited to '')
-rw-r--r--tests/gpgscm/init.scm17
1 files changed, 17 insertions, 0 deletions
diff --git a/tests/gpgscm/init.scm b/tests/gpgscm/init.scm
index 106afd554..83261b001 100644
--- a/tests/gpgscm/init.scm
+++ b/tests/gpgscm/init.scm
@@ -569,6 +569,16 @@
; the thrown exception is bound to *error*. Errors can be rethrown
; using (rethrow *error*).
;
+; Finalization can be expressed using "finally":
+;
+; (finally (finalize-something called-purely-for side-effects)
+; (whether-or-not something goes-wrong)
+; (with-these calls))
+;
+; The final expression is executed purely for its side-effects,
+; both when the function exits successfully, and when an exception
+; is thrown.
+;
; Exceptions are thrown with:
;
; (throw "message")
@@ -622,6 +632,13 @@
(pop-handler)
,label)))))
+(define-macro (finally final-expression . expressions)
+ (let ((result (gensym)))
+ `(let ((,result (catch (begin ,final-expression (rethrow *error*))
+ ,@expressions)))
+ ,final-expression
+ ,result)))
+
;; Make the vm use throw'.
(define *error-hook* throw')