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))