diff options
| author | Justus Winter <[email protected]> | 2016-11-18 12:36:23 +0000 |
|---|---|---|
| committer | Justus Winter <[email protected]> | 2016-12-08 16:22:50 +0000 |
| commit | e7429b1ced0c69fa7901f888f8dc25f00fc346a4 (patch) | |
| tree | ad455250ea1a3d6ff28436301e3c21f9a7eb0857 /tests/gpgscm/tests.scm | |
| parent | gpgscm: Keep a history of calls for error messages. (diff) | |
| download | gnupg-e7429b1ced0c69fa7901f888f8dc25f00fc346a4.tar.gz gnupg-e7429b1ced0c69fa7901f888f8dc25f00fc346a4.zip | |
gpgscm: Better error reporting.
* 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 <[email protected]>
Diffstat (limited to 'tests/gpgscm/tests.scm')
| -rw-r--r-- | tests/gpgscm/tests.scm | 11 |
1 files changed, 6 insertions, 5 deletions
diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm index bd51819d2..bec19223d 100644 --- a/tests/gpgscm/tests.scm +++ b/tests/gpgscm/tests.scm @@ -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)) |