security-and-privacy/gnupg
security-and-privacy/gnupg
1
0
Fork 0
mirror of git://git.gnupg.org/gnupg.git synced 2025-04-17 15:44:34 +02:00
Code Activity

tests: Implement interpreter shutdown using exceptions.

Browse Source 
* 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 <justus@g10code.com>
This commit is contained in:
Justus Winter 2016-09-19 18:42:36 +02:00
parent 58007e5259
commit 9a0659a65c
2 changed files with 23 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
tests/gpgscm/ffi.c
View File

@ -1255,7 +1255,7 @@ ffi_init (scheme *sc, const char *argv0, const char *scriptname,
ffi_define_function (sc, strerror); ffi_define_function (sc, strerror);
ffi_define_function (sc, getenv); ffi_define_function (sc, getenv);
ffi_define_function (sc, setenv); 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, open);
ffi_define_function (sc, fdopen); ffi_define_function (sc, fdopen);
ffi_define_function (sc, close); ffi_define_function (sc, close);

22
tests/gpgscm/ffi.scm
View File

@ -42,3 +42,25 @@
;; Pseudo-definitions for foreign functions. Evaluates to no code, ;; Pseudo-definitions for foreign functions. Evaluates to no code,
;; but serves as documentation. ;; but serves as documentation.
(macro (ffi-define form)) (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))