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 <justus@g10code.com>

1 files changed, 13 insertions, 8 deletions

diff --git a/tests/gpgscm/main.c b/tests/gpgscm/main.c
index 2f77ac5aa..c96dcf189 100644
--- a/tests/gpgscm/main.c
+++ b/tests/gpgscm/main.c
@@ -150,7 +150,10 @@ load (scheme *sc, char *file_name,
 
         h = fopen (qualified_name, "r");
         if (h)
-          break;
+          {
+            err = 0;
+            break;
+          }
 
         if (n > 1)
           {
@@ -170,23 +173,23 @@ load (scheme *sc, char *file_name,
         fprintf (stderr,
                  "Consider using GPGSCM_PATH to specify the location "
                  "of the Scheme library.\n");
-      return err;
+      goto leave;
     }
   if (verbose > 1)
     fprintf (stderr, "Loading %s...\n", qualified_name);
   scheme_load_named_file (sc, h, qualified_name);
   fclose (h);
 
-  if (sc->retcode)
+  if (sc->retcode && sc->nesting)
     {
-      if (sc->nesting)
-        fprintf (stderr, "%s: Unbalanced parenthesis\n", qualified_name);
-      return gpg_error (GPG_ERR_GENERAL);
+      fprintf (stderr, "%s: Unbalanced parenthesis\n", qualified_name);
+      err = gpg_error (GPG_ERR_GENERAL);
     }
 
+ leave:
   if (file_name != qualified_name)
     free (qualified_name);
-  return 0;
+  return err;
 }
 
 
@@ -194,6 +197,7 @@ load (scheme *sc, char *file_name,
 int
 main (int argc, char **argv)
 {
+  int retcode;
   gpg_error_t err;
   char *argv0;
   ARGPARSE_ARGS pargs;
@@ -291,8 +295,9 @@ main (int argc, char **argv)
         log_fatal ("%s: %s", script, gpg_strerror (err));
     }
 
+  retcode = sc->retcode;
   scheme_load_string (sc, "(*run-atexit-handlers*)");
   scheme_deinit (sc);
   xfree (sc);
-  return EXIT_SUCCESS;
+  return retcode;
 }