aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJustus Winter <[email protected]>2016-09-19 16:42:36 +0000
committerJustus Winter <[email protected]>2016-09-19 16:49:17 +0000
commit9a0659a65c52378de1c4736a0eddf8518eb20948 (patch)
treeca0187e499e303017f69f9ba5631b50439544509
parenttests: Correctly handle exceptions in resource handling macros. (diff)
downloadgnupg-9a0659a65c52378de1c4736a0eddf8518eb20948.tar.gz
gnupg-9a0659a65c52378de1c4736a0eddf8518eb20948.zip
tests: Implement interpreter shutdown using exceptions.
* tests/gpgscm/ffi.c (ffi_init): Rename 'exit' to '_exit'. * tests/gpgscm/ffi.scm (*interpreter-exit*): New variable. (throw): New function. (exit): New function. -- This allows a proper cleanup of resources. Signed-off-by: Justus Winter <[email protected]>
-rw-r--r--tests/gpgscm/ffi.c2
-rw-r--r--tests/gpgscm/ffi.scm22
2 files changed, 23 insertions, 1 deletions
diff --git a/tests/gpgscm/ffi.c b/tests/gpgscm/ffi.c
index 08160670f..4559f10ec 100644
--- a/tests/gpgscm/ffi.c
+++ b/tests/gpgscm/ffi.c
@@ -1255,7 +1255,7 @@ ffi_init (scheme *sc, const char *argv0, const char *scriptname,
ffi_define_function (sc, strerror);
ffi_define_function (sc, getenv);
ffi_define_function (sc, setenv);
- ffi_define_function (sc, exit);
+ ffi_define_function_name (sc, "_exit", exit);
ffi_define_function (sc, open);
ffi_define_function (sc, fdopen);
ffi_define_function (sc, close);
diff --git a/tests/gpgscm/ffi.scm b/tests/gpgscm/ffi.scm
index 7c2f93aba..72a2a8f1e 100644
--- a/tests/gpgscm/ffi.scm
+++ b/tests/gpgscm/ffi.scm
@@ -42,3 +42,25 @@
;; Pseudo-definitions for foreign functions. Evaluates to no code,
;; but serves as documentation.
(macro (ffi-define form))
+
+;; Runtime support.
+
+;; Low-level mechanism to terminate the process.
+(ffi-define (_exit status))
+
+;; High-level mechanism to terminate the process is to throw an error
+;; of the form (*interpreter-exit* status). This gives automatic
+;; resource management a chance to clean up.
+(define *interpreter-exit* (gensym))
+(define (throw . x)
+ (cond
+ ((more-handlers?)
+ (apply (pop-handler) x))
+ ((and (= 2 (length x)) (equal? *interpreter-exit* (car x)))
+ (_exit (cadr x)))
+ (else
+ (apply error x))))
+
+;; Terminate the process returning STATUS to the parent.
+(define (exit status)
+ (throw *interpreter-exit* status))