security-and-privacy/gnupg
security-and-privacy/gnupg
1
0
Fork 0
mirror of git://git.gnupg.org/gnupg.git synced 2025-07-02 22:46:30 +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

11
tests/gpgscm/tests.scm
View file

@ -130,7 +130,8 @@
(let ((result (call-with-io what "")))
(if (= 0 (:retcode result))
(:stdout result)
(throw (list what "failed:" (:stderr result))))))
(throw (string-append (stringify what) " failed")
(:stderr result)))))
(define (call-popen command input-string)
(let ((result (call-with-io command input-string)))
@ -246,7 +247,7 @@
(let ((,result-sym
,(if (= 1 (length (cadr form)))
`(catch (begin (close ,(caaadr form))
(apply throw *error*))
(rethrow *error*))
,@(cddr form))
`(letfd ,(cdadr form) ,@(cddr form)))))
(close ,(caaadr form))
@ -257,7 +258,7 @@
`(let* ((,cwd-sym (getcwd))
(_ (if ,(cadr form) (chdir ,(cadr form))))
(,result-sym (catch (begin (chdir ,cwd-sym)
(apply throw *error*))
(rethrow *error*))
,@(cddr form))))
(chdir ,cwd-sym)
,result-sym)))
@ -281,7 +282,7 @@
(_ (chdir ,tmp-sym))
(,result-sym (catch (begin (chdir ,cwd-sym)
(unlink-recursively ,tmp-sym)
(apply throw *error*))
(rethrow *error*))
,@(cdr form))))
(chdir ,cwd-sym)
(unlink-recursively ,tmp-sym)
@ -312,7 +313,7 @@
(let ((,result-sym
,(if (= 1 (length (cadr form)))
`(catch (begin (remove-temporary-file ,(caadr form))
(apply throw *error*))
(rethrow *error*))
,@(cddr form))
`(lettmp ,(cdadr form) ,@(cddr form)))))
(remove-temporary-file ,(caadr form))