security-and-privacy/gnupg
security-and-privacy/gnupg
1
0
Fork 0
mirror of git://git.gnupg.org/gnupg.git synced 2025-07-03 22:56:33 +02:00
Code Activity

gpgscm: Better error reporting.

Browse source 
* tests/gpgscm/ffi.scm: Move the customized exception handling and
atexit logic...
* tests/gpgscm/init.scm: ... here.
(throw): Record the current history.
(throw'): New function that is history-aware.
(rethrow): New function.
(*error-hook*): Use the new throw'.
* tests/gpgscm/main.c (load): Fix error handling.
(main): Save and use the 'sc->retcode' as exit code.
* tests/gpgscm/repl.scm (repl): Print call history.
* tests/gpgscm/scheme.c (_Error_1): Make a snapshot of the history,
use it to provide a accurate location of the expression causing the
error at runtime, and hand the history trace to the '*error-hook*'.
(opexe_5): Tag all lists at parse time with the current location.
* tests/gpgscm/tests.scm: Update calls to 'throw', use 'rethrow'.

Signed-off-by: Justus Winter <justus@g10code.com>
This commit is contained in:
Justus Winter 2016-11-18 13:36:23 +01:00
parent 404e8a4136
commit e7429b1ced
6 changed files with 122 additions and 62 deletions
Download patch file Download diff file Expand all files Collapse all files

36
tests/gpgscm/ffi.scm
View file

@ -47,39 +47,3 @@
;; 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)))
(*run-atexit-handlers*)
(_exit (cadr x)))
(else
(apply error x))))
(set! *error-hook* throw)
;; Terminate the process returning STATUS to the parent.
(define (exit status)
(throw *interpreter-exit* status))
;; A list of functions run at interpreter shutdown.
(define *atexit-handlers* (list))
;; Execute all these functions.
(define (*run-atexit-handlers*)
(unless (null? *atexit-handlers*)
(let ((proc (car *atexit-handlers*)))
;; Drop proc from the list so that it will not get
;; executed again even if it raises an exception.
(set! *atexit-handlers* (cdr *atexit-handlers*))
(proc)
(*run-atexit-handlers*))))
;; Register a function to be run at interpreter shutdown.
(define (atexit proc)
(set! *atexit-handlers* (cons proc *atexit-handlers*)))