[git] GnuPG - branch, master, updated. gnupg-2.1.15-138-g884e78e
by Justus Winter
cvs at cvs.gnupg.org
Mon Sep 19 18:50:50 CEST 2016
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "The GNU Privacy Guard".
The branch, master has been updated
via 884e78efe1f3ba50513bf81c8b4804d22b25eac4 (commit)
via 9a0659a65c52378de1c4736a0eddf8518eb20948 (commit)
via 58007e52593e6b0f838de2e464ceeacf22757018 (commit)
via ab483eff9a8254adf127cdee178e14ba74f0a2b3 (commit)
via 83a406b38a21d0eeb4963db824a27783c212d2fb (commit)
from 998643666c016dbacf10f813c22efc97deadec65 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 884e78efe1f3ba50513bf81c8b4804d22b25eac4
Author: Justus Winter <justus at g10code.com>
Date: Mon Sep 19 18:45:44 2016 +0200
tests: Refine the repl function.
* tests/gpgscm/repl.scm (repl): Add an argument 'environment'.
(interactive-repl): Add an optional argument 'environment'.
--
With this change, we can drop
(interactive-repl (current-environment))
anywhere into the code and do some interactive debugging.
Signed-off-by: Justus Winter <justus at g10code.com>
diff --git a/tests/gpgscm/repl.scm b/tests/gpgscm/repl.scm
index 896554f..78b8151 100644
--- a/tests/gpgscm/repl.scm
+++ b/tests/gpgscm/repl.scm
@@ -20,25 +20,24 @@
;; Interactive repl using 'prompt' function. P must be a function
;; that given the current entered prefix returns the prompt to
;; display.
-(define (repl p)
- (let ((repl-environment (make-environment)))
- (call/cc
- (lambda (exit)
- (let loop ((prefix ""))
- (let ((line (prompt (p prefix))))
- (if (and (not (eof-object? line)) (= 0 (string-length line)))
- (exit (loop prefix)))
- (if (not (eof-object? line))
- (let* ((next (string-append prefix line))
- (c (catch (begin (echo "Parse error:" *error*)
- (loop prefix))
- (read (open-input-string next)))))
- (if (not (eof-object? c))
- (begin
- (catch (echo "Error:" *error*)
- (echo " ===>" (eval c repl-environment)))
- (exit (loop ""))))
- (exit (loop next))))))))))
+(define (repl p environment)
+ (call/cc
+ (lambda (exit)
+ (let loop ((prefix ""))
+ (let ((line (prompt (p prefix))))
+ (if (and (not (eof-object? line)) (= 0 (string-length line)))
+ (exit (loop prefix)))
+ (if (not (eof-object? line))
+ (let* ((next (string-append prefix line))
+ (c (catch (begin (echo "Parse error:" *error*)
+ (loop prefix))
+ (read (open-input-string next)))))
+ (if (not (eof-object? c))
+ (begin
+ (catch (echo "Error:" *error*)
+ (echo " ===>" (eval c environment)))
+ (exit (loop ""))))
+ (exit (loop next)))))))))
(define (prompt-append-prefix prompt prefix)
(string-append prompt (if (> (string-length prefix) 0)
@@ -46,5 +45,6 @@
"> ")))
;; Default repl run by main.c.
-(define (interactive-repl)
- (repl (lambda (p) (prompt-append-prefix "gpgscm " p))))
+(define (interactive-repl . environment)
+ (repl (lambda (p) (prompt-append-prefix "gpgscm " p))
+ (if (null? environment) (interaction-environment) (car environment))))
commit 9a0659a65c52378de1c4736a0eddf8518eb20948
Author: Justus Winter <justus at g10code.com>
Date: Mon Sep 19 18:42:36 2016 +0200
tests: Implement interpreter shutdown using exceptions.
* tests/gpgscm/ffi.c (ffi_init): Rename 'exit' to '_exit'.
* tests/gpgscm/ffi.scm (*interpreter-exit*): New variable.
(throw): New function.
(exit): New function.
--
This allows a proper cleanup of resources.
Signed-off-by: Justus Winter <justus at g10code.com>
diff --git a/tests/gpgscm/ffi.c b/tests/gpgscm/ffi.c
index 0816067..4559f10 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 7c2f93a..72a2a8f 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))
commit 58007e52593e6b0f838de2e464ceeacf22757018
Author: Justus Winter <justus at g10code.com>
Date: Mon Sep 19 17:24:03 2016 +0200
tests: Correctly handle exceptions in resource handling macros.
* tests/gpgscm/tests.scm (letfd): Correctly release resources when an
exception is thrown.
(with-working-directory): Likewise.
(with-temporary-working-directory): Likewise.
(lettmp): Likewise.
Signed-off-by: Justus Winter <justus at g10code.com>
diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm
index 7b88e0e..71ca369 100644
--- a/tests/gpgscm/tests.scm
+++ b/tests/gpgscm/tests.scm
@@ -234,7 +234,9 @@
`((lambda (,(caaadr form))
(let ((,result-sym
,(if (= 1 (length (cadr form)))
- `(begin ,@(cddr form))
+ `(catch (begin (close ,(caaadr form))
+ (apply throw *error*))
+ ,@(cddr form))
`(letfd ,(cdadr form) ,@(cddr form)))))
(close ,(caaadr form))
,result-sym)) ,@(cdaadr form))))
@@ -243,7 +245,9 @@
(let ((result-sym (gensym)) (cwd-sym (gensym)))
`(let* ((,cwd-sym (getcwd))
(_ (if ,(cadr form) (chdir ,(cadr form))))
- (,result-sym (begin ,@(cddr form))))
+ (,result-sym (catch (begin (chdir ,cwd-sym)
+ (apply throw *error*))
+ ,@(cddr form))))
(chdir ,cwd-sym)
,result-sym)))
@@ -264,7 +268,10 @@
`(let* ((,cwd-sym (getcwd))
(,tmp-sym (mkdtemp))
(_ (chdir ,tmp-sym))
- (,result-sym (begin ,@(cdr form))))
+ (,result-sym (catch (begin (chdir ,cwd-sym)
+ (unlink-recursively ,tmp-sym)
+ (apply throw *error*))
+ ,@(cdr form))))
(chdir ,cwd-sym)
(unlink-recursively ,tmp-sym)
,result-sym)))
@@ -293,7 +300,9 @@
`((lambda (,(caadr form))
(let ((,result-sym
,(if (= 1 (length (cadr form)))
- `(begin ,@(cddr form))
+ `(catch (begin (remove-temporary-file ,(caadr form))
+ (apply throw *error*))
+ ,@(cddr form))
`(lettmp ,(cdadr form) ,@(cddr form)))))
(remove-temporary-file ,(caadr form))
,result-sym)) (make-temporary-file ,(symbol->string (caadr form))))))
commit ab483eff9a8254adf127cdee178e14ba74f0a2b3
Author: Justus Winter <justus at g10code.com>
Date: Mon Sep 19 17:19:00 2016 +0200
tests: Refine exception handling.
* tests/gpgscm/init.scm (catch): Bind all arguments to '*error*' in
the error handler, update and fix comment.
(*error-hook*): Revert to original definition.
* tests/gpgscm/tests.scm (tr:do): Adapt accordingly.
* tests/openpgp/issue2419.scm: Likewise.
Signed-off-by: Justus Winter <justus at g10code.com>
diff --git a/tests/gpgscm/init.scm b/tests/gpgscm/init.scm
index b32172b..f8fd71a 100644
--- a/tests/gpgscm/init.scm
+++ b/tests/gpgscm/init.scm
@@ -544,13 +544,14 @@
;
; "Catch" establishes a scope spanning multiple call-frames until
; another "catch" is encountered. Within the recovery expression
-; the thrown exception is bound to *error*.
+; the thrown exception is bound to *error*. Errors can be rethrown
+; using (apply throw *error*).
;
; Exceptions are thrown with:
;
; (throw "message")
;
-; If used outside a (catch ...), reverts to (error "message)
+; If used outside a (catch ...), reverts to (error "message")
(define *handlers* (list))
@@ -573,13 +574,12 @@
(macro (catch form)
(let ((label (gensym)))
`(call/cc (lambda (**exit**)
- (push-handler (lambda (*error*) (**exit** ,(cadr form))))
+ (push-handler (lambda *error* (**exit** ,(cadr form))))
(let ((,label (begin ,@(cddr form))))
(pop-handler)
,label)))))
-(define (*error-hook* . args)
- (throw args))
+(define *error-hook* throw)
;;;;; Definition of MAKE-ENVIRONMENT, to be used with two-argument EVAL
diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm
index 0738bc6..7b88e0e 100644
--- a/tests/gpgscm/tests.scm
+++ b/tests/gpgscm/tests.scm
@@ -411,7 +411,7 @@
(if error
(begin
(for-each remove-temporary-file tmpfiles')
- (throw error)))
+ (apply throw error)))
(loop tmpfiles' sink (cdr cmds))))))
(define (tr:open pathname)
diff --git a/tests/openpgp/issue2419.scm b/tests/openpgp/issue2419.scm
index efc42a6..1f87d1b 100755
--- a/tests/openpgp/issue2419.scm
+++ b/tests/openpgp/issue2419.scm
@@ -23,6 +23,6 @@
(lettmp
(onebyte)
(dearmor (in-srcdir "samplemsgs/issue2419.asc") onebyte)
- (catch (assert (string-contains? *error* "invalid packet"))
+ (catch (assert (string-contains? (car *error*) "invalid packet"))
(call-popen `(, at GPG --list-packets ,onebyte) "")
(error "Expected an error but got none")))
commit 83a406b38a21d0eeb4963db824a27783c212d2fb
Author: Justus Winter <justus at g10code.com>
Date: Mon Sep 19 15:59:19 2016 +0200
tests: Use descriptive temporary file names.
* tests/gpgscm/ffi.c (do_get_isotime): New function.
(ffi_init): Add parameter 'scriptname', bind new function and
scriptname.
* tests/gpgscm/ffi.h (ffi_init): Update prototype.
* tests/gpgscm/main.c (main): Hand in the script name.
* tests/gpgscm/tests.scm (mkdtemp): Use current time and script name
for the names of temporary directories.
Signed-off-by: Justus Winter <justus at g10code.com>
diff --git a/tests/gpgscm/ffi.c b/tests/gpgscm/ffi.c
index 57de286..0816067 100644
--- a/tests/gpgscm/ffi.c
+++ b/tests/gpgscm/ffi.c
@@ -460,6 +460,16 @@ do_rmdir (scheme *sc, pointer args)
FFI_RETURN (sc);
}
+static pointer
+do_get_isotime (scheme *sc, pointer args)
+{
+ FFI_PROLOG ();
+ gnupg_isotime_t timebuf;
+ FFI_ARGS_DONE_OR_RETURN (sc, args);
+ gnupg_get_isotime (timebuf);
+ FFI_RETURN_STRING (sc, timebuf);
+}
+
/* estream functions. */
@@ -1209,7 +1219,8 @@ ffi_scheme_eval (scheme *sc, const char *format, ...)
}
gpg_error_t
-ffi_init (scheme *sc, const char *argv0, int argc, const char **argv)
+ffi_init (scheme *sc, const char *argv0, const char *scriptname,
+ int argc, const char **argv)
{
int i;
pointer args = sc->NIL;
@@ -1255,6 +1266,7 @@ ffi_init (scheme *sc, const char *argv0, int argc, const char **argv)
ffi_define_function (sc, getcwd);
ffi_define_function (sc, mkdir);
ffi_define_function (sc, rmdir);
+ ffi_define_function (sc, get_isotime);
/* Process management. */
ffi_define_function (sc, spawn_process);
@@ -1288,6 +1300,7 @@ ffi_init (scheme *sc, const char *argv0, int argc, const char **argv)
ffi_define_function_name (sc, "*set-verbose!*", set_verbose);
ffi_define (sc, "*argv0*", sc->vptr->mk_string (sc, argv0));
+ ffi_define (sc, "*scriptname*", sc->vptr->mk_string (sc, scriptname));
for (i = argc - 1; i >= 0; i--)
{
pointer value = sc->vptr->mk_string (sc, argv[i]);
diff --git a/tests/gpgscm/ffi.h b/tests/gpgscm/ffi.h
index 02dd99d..9bd710f 100644
--- a/tests/gpgscm/ffi.h
+++ b/tests/gpgscm/ffi.h
@@ -24,7 +24,7 @@
#include <gpg-error.h>
#include "scheme.h"
-gpg_error_t ffi_init (scheme *sc, const char *argv0,
+gpg_error_t ffi_init (scheme *sc, const char *argv0, const char *scriptname,
int argc, const char **argv);
#endif /* GPGSCM_FFI_H */
diff --git a/tests/gpgscm/main.c b/tests/gpgscm/main.c
index 02681ff..f7c6b0d 100644
--- a/tests/gpgscm/main.c
+++ b/tests/gpgscm/main.c
@@ -263,7 +263,8 @@ main (int argc, char **argv)
if (! err)
err = load (sc, "ffi.scm", 0, 1);
if (! err)
- err = ffi_init (sc, argv0, argc, (const char **) argv);
+ err = ffi_init (sc, argv0, script ? script : "interactive",
+ argc, (const char **) argv);
if (! err)
err = load (sc, "lib.scm", 0, 1);
if (! err)
diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm
index 8283eba..0738bc6 100644
--- a/tests/gpgscm/tests.scm
+++ b/tests/gpgscm/tests.scm
@@ -253,7 +253,10 @@
;; generic name is used.
(define (mkdtemp . components)
(_mkdtemp (if (null? components)
- (path-join (getenv "TMP") "gpgscm-XXXXXX")
+ (path-join (getenv "TMP")
+ (string-append "gpgscm-" (get-isotime) "-"
+ (basename-suffix *scriptname* ".scm")
+ "-XXXXXX"))
(apply path-join components))))
(macro (with-temporary-working-directory form)
-----------------------------------------------------------------------
Summary of changes:
tests/gpgscm/ffi.c | 17 +++++++++++++++--
tests/gpgscm/ffi.h | 2 +-
tests/gpgscm/ffi.scm | 22 ++++++++++++++++++++++
tests/gpgscm/init.scm | 10 +++++-----
tests/gpgscm/main.c | 3 ++-
tests/gpgscm/repl.scm | 42 +++++++++++++++++++++---------------------
tests/gpgscm/tests.scm | 24 ++++++++++++++++++------
tests/openpgp/issue2419.scm | 2 +-
8 files changed, 85 insertions(+), 37 deletions(-)
hooks/post-receive
--
The GNU Privacy Guard
http://git.gnupg.org
More information about the Gnupg-commits
mailing list