[git] GnuPG - branch, master, updated. gnupg-2.1.17-23-gb0e14bd
by Justus Winter
cvs at cvs.gnupg.org
Mon Jan 2 12:53:37 CET 2017
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 b0e14bd6ff8401b12b2b39f75aef94d3ad28017f (commit)
via b79274a3b7e58f88e9a8c1dc1fb24dd3e983543c (commit)
via e8b843508dac96e9d0a3140954dd5a3618669cec (commit)
from 5a4a109354d53cf3673d0636731c67021d3f367a (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 b0e14bd6ff8401b12b2b39f75aef94d3ad28017f
Author: Justus Winter <justus at g10code.com>
Date: Thu Dec 22 15:48:07 2016 +0100
gpgscm: Fail if too many arguments are given.
* tests/gpgscm/scheme.c (opexe_0): Enable check.
* tests/gpgscm/tests.scm (test::report): Remove superfluous argument.
Signed-off-by: Justus Winter <justus at g10code.com>
diff --git a/tests/gpgscm/scheme.c b/tests/gpgscm/scheme.c
index 7cd5217..c4725db 100644
--- a/tests/gpgscm/scheme.c
+++ b/tests/gpgscm/scheme.c
@@ -3364,11 +3364,9 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
}
}
if (x == sc->NIL) {
- /*--
- * if (y != sc->NIL) {
- * Error_0(sc,"too many arguments");
- * }
- */
+ if (y != sc->NIL) {
+ Error_0(sc, "too many arguments");
+ }
} else if (is_symbol(x))
new_slot_in_env(sc, x, y);
else {
diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm
index 5954704..e5858d9 100644
--- a/tests/gpgscm/tests.scm
+++ b/tests/gpgscm/tests.scm
@@ -610,7 +610,7 @@
(seek logfd 0 SEEK_SET)
(splice logfd STDERR_FILENO)
(close logfd))
- (echo (string-append (status retcode) ":") name))))))
+ (echo (string-append (status) ":") name))))))
;; Run the setup target to create an environment, then run all given
;; tests in parallel.
commit b79274a3b7e58f88e9a8c1dc1fb24dd3e983543c
Author: Justus Winter <justus at g10code.com>
Date: Thu Dec 22 14:42:50 2016 +0100
gpgscm: Add 'finally', rework all macros.
* tests/gpgscm/init.scm (finally): New macro.
* tests/gpgscm/tests.scm (letfd): Rewrite.
(with-working-directory): Likewise.
(with-temporary-working-directory): Likewise.
(lettmp): Likewise.
--
Rewrite all our macros using 'define-macro'. Use the new control flow
mechanism 'finally', or 'dynamic-wind' where appropriate. Make sure
the macros are hygienic. Reduce code duplication.
Signed-off-by: Justus Winter <justus at g10code.com>
diff --git a/tests/gpgscm/init.scm b/tests/gpgscm/init.scm
index 106afd5..83261b0 100644
--- a/tests/gpgscm/init.scm
+++ b/tests/gpgscm/init.scm
@@ -569,6 +569,16 @@
; the thrown exception is bound to *error*. Errors can be rethrown
; using (rethrow *error*).
;
+; Finalization can be expressed using "finally":
+;
+; (finally (finalize-something called-purely-for side-effects)
+; (whether-or-not something goes-wrong)
+; (with-these calls))
+;
+; The final expression is executed purely for its side-effects,
+; both when the function exits successfully, and when an exception
+; is thrown.
+;
; Exceptions are thrown with:
;
; (throw "message")
@@ -622,6 +632,13 @@
(pop-handler)
,label)))))
+(define-macro (finally final-expression . expressions)
+ (let ((result (gensym)))
+ `(let ((,result (catch (begin ,final-expression (rethrow *error*))
+ , at expressions)))
+ ,final-expression
+ ,result)))
+
;; Make the vm use throw'.
(define *error-hook* throw')
diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm
index f127a93..5954704 100644
--- a/tests/gpgscm/tests.scm
+++ b/tests/gpgscm/tests.scm
@@ -244,27 +244,26 @@
;;
;; Bind all variables given in <bindings> and initialize each of them
;; to the given initial value, and close them after evaluting <body>.
-(macro (letfd form)
- (let ((result-sym (gensym)))
- `((lambda (,(caaadr form))
- (let ((,result-sym
- ,(if (= 1 (length (cadr form)))
- `(catch (begin (close ,(caaadr form))
- (rethrow *error*))
- ,@(cddr form))
- `(letfd ,(cdadr form) ,@(cddr form)))))
- (close ,(caaadr form))
- ,result-sym)) ,@(cdaadr form))))
-
-(macro (with-working-directory form)
- (let ((result-sym (gensym)) (cwd-sym (gensym)))
- `(let* ((,cwd-sym (getcwd))
- (_ (if ,(cadr form) (chdir ,(cadr form))))
- (,result-sym (catch (begin (chdir ,cwd-sym)
- (rethrow *error*))
- ,@(cddr form))))
- (chdir ,cwd-sym)
- ,result-sym)))
+(define-macro (letfd bindings . body)
+ (let bind ((bindings' bindings))
+ (if (null? bindings')
+ `(begin , at body)
+ (let* ((binding (car bindings'))
+ (name (car binding))
+ (initializer (cadr binding)))
+ `(let ((,name ,initializer))
+ (finally (close ,name)
+ ,(bind (cdr bindings'))))))))
+
+(define-macro (with-working-directory new-directory . expressions)
+ (let ((new-dir (gensym))
+ (old-dir (gensym)))
+ `(let* ((,new-dir ,new-directory)
+ (,old-dir (getcwd)))
+ (dynamic-wind
+ (lambda () (if ,new-dir (chdir ,new-dir)))
+ (lambda () , at expressions)
+ (lambda () (chdir ,old-dir))))))
;; Make a temporary directory. If arguments are given, they are
;; joined using path-join, and must end in a component ending in
@@ -278,18 +277,12 @@
"-XXXXXX"))
(apply path-join components))))
-(macro (with-temporary-working-directory form)
- (let ((result-sym (gensym)) (cwd-sym (gensym)) (tmp-sym (gensym)))
- `(let* ((,cwd-sym (getcwd))
- (,tmp-sym (mkdtemp))
- (_ (chdir ,tmp-sym))
- (,result-sym (catch (begin (chdir ,cwd-sym)
- (unlink-recursively ,tmp-sym)
- (rethrow *error*))
- ,@(cdr form))))
- (chdir ,cwd-sym)
- (unlink-recursively ,tmp-sym)
- ,result-sym)))
+(define-macro (with-temporary-working-directory . expressions)
+ (let ((tmp-sym (gensym)))
+ `(let* ((,tmp-sym (mkdtemp)))
+ (finally (unlink-recursively ,tmp-sym)
+ (with-working-directory ,tmp-sym
+ , at expressions)))))
(define (make-temporary-file . args)
(canonical-path (path-join
@@ -310,17 +303,15 @@
;; Bind all variables given in <bindings>, initialize each of them to
;; a string representing an unique path in the filesystem, and delete
;; them after evaluting <body>.
-(macro (lettmp form)
- (let ((result-sym (gensym)))
- `((lambda (,(caadr form))
- (let ((,result-sym
- ,(if (= 1 (length (cadr form)))
- `(catch (begin (remove-temporary-file ,(caadr form))
- (rethrow *error*))
- ,@(cddr form))
- `(lettmp ,(cdadr form) ,@(cddr form)))))
- (remove-temporary-file ,(caadr form))
- ,result-sym)) (make-temporary-file ,(symbol->string (caadr form))))))
+(define-macro (lettmp bindings . body)
+ (let bind ((bindings' bindings))
+ (if (null? bindings')
+ `(begin , at body)
+ (let ((name (car bindings'))
+ (rest (cdr bindings')))
+ `(let ((,name (make-temporary-file ,(symbol->string name))))
+ (finally (remove-temporary-file ,name)
+ ,(bind rest)))))))
(define (check-execution source transformer)
(lettmp (sink)
commit e8b843508dac96e9d0a3140954dd5a3618669cec
Author: Justus Winter <justus at g10code.com>
Date: Thu Dec 22 10:36:56 2016 +0100
gpgscm: Use boxed values for source locations.
* tests/gpgscm/scheme-private.h (struct port): Use boxed values for
filename and current line. This allows us to use the same Scheme
object for labeling all expressions in a file.
* tests/gpgscm/scheme.c (file_push): Use boxed type for filename.
(mark): Mark location objects of port objects.
(gc): Mark location objects in the load stack.
(port_clear_location): New function.
(port_reset_current_line): Likewise.
(port_increment_current_line): Likewise.
(file_pop): Adapt accordingly.
(port_rep_from_filename): Likewise.
(port_rep_from_file): Likewise.
(port_close): Likewise.
(skipspace): Likewise.
(token): Likewise.
(_Error_1): Likewise.
(opexe_0): Likewise.
(opexe_5): Likewise.
(scheme_deinit): Likewise.
(scheme_load_file): Likewise.
(scheme_load_named_file): Likewise.
Signed-off-by: Justus Winter <justus at g10code.com>
diff --git a/tests/gpgscm/scheme-private.h b/tests/gpgscm/scheme-private.h
index 7f19a6e..aba2319 100644
--- a/tests/gpgscm/scheme-private.h
+++ b/tests/gpgscm/scheme-private.h
@@ -28,8 +28,8 @@ typedef struct port {
FILE *file;
int closeit;
#if SHOW_ERROR_LINE
- int curr_line;
- char *filename;
+ pointer curr_line;
+ pointer filename;
#endif
} stdio;
struct {
diff --git a/tests/gpgscm/scheme.c b/tests/gpgscm/scheme.c
index 2844545..7cd5217 100644
--- a/tests/gpgscm/scheme.c
+++ b/tests/gpgscm/scheme.c
@@ -377,7 +377,7 @@ static int is_ascii_name(const char *name, int *pc) {
#endif
-static int file_push(scheme *sc, const char *fname);
+static int file_push(scheme *sc, pointer fname);
static void file_pop(scheme *sc);
static int file_interactive(scheme *sc);
static INLINE int is_one_of(char *s, int c);
@@ -1552,6 +1552,15 @@ E2: setmark(p);
mark(p+1+i);
}
}
+#if SHOW_ERROR_LINE
+ else if (is_port(p)) {
+ port *pt = p->_object._port;
+ if (pt->kind & port_file) {
+ mark(pt->rep.stdio.curr_line);
+ mark(pt->rep.stdio.filename);
+ }
+ }
+#endif
/* Mark tag if p has one. */
if (has_tag(p))
mark(p + 1);
@@ -1617,6 +1626,13 @@ static void gc(scheme *sc, pointer a, pointer b) {
mark(sc->save_inport);
mark(sc->outport);
mark(sc->loadport);
+ for (i = 0; i <= sc->file_i; i++) {
+ if (! (sc->load_stack[i].kind & port_file))
+ continue;
+
+ mark(sc->load_stack[i].rep.stdio.filename);
+ mark(sc->load_stack[i].rep.stdio.curr_line);
+ }
/* Mark recent objects the interpreter doesn't know about yet. */
mark(car(sc->sink));
@@ -1678,14 +1694,39 @@ static void finalize_cell(scheme *sc, pointer a) {
}
}
+#if SHOW_ERROR_LINE
+static void
+port_clear_location (scheme *sc, port *p)
+{
+ assert(p->kind & port_file);
+ p->rep.stdio.curr_line = sc->NIL;
+ p->rep.stdio.filename = sc->NIL;
+}
+
+static void
+port_reset_current_line (scheme *sc, port *p)
+{
+ assert(p->kind & port_file);
+ p->rep.stdio.curr_line = mk_integer(sc, 0);
+}
+
+static void
+port_increment_current_line (scheme *sc, port *p, long delta)
+{
+ assert(p->kind & port_file);
+ p->rep.stdio.curr_line =
+ mk_integer(sc, ivalue_unchecked(p->rep.stdio.curr_line) + delta);
+}
+#endif
+
/* ========== Routines for Reading ========== */
-static int file_push(scheme *sc, const char *fname) {
+static int file_push(scheme *sc, pointer fname) {
FILE *fin = NULL;
if (sc->file_i == MAXFIL-1)
return 0;
- fin=fopen(fname,"r");
+ fin = fopen(string_value(fname), "r");
if(fin!=0) {
sc->file_i++;
sc->load_stack[sc->file_i].kind=port_file|port_input;
@@ -1695,9 +1736,8 @@ static int file_push(scheme *sc, const char *fname) {
sc->loadport->_object._port=sc->load_stack+sc->file_i;
#if SHOW_ERROR_LINE
- sc->load_stack[sc->file_i].rep.stdio.curr_line = 0;
- if(fname)
- sc->load_stack[sc->file_i].rep.stdio.filename = store_string(sc, strlen(fname), fname, 0);
+ port_reset_current_line(sc, &sc->load_stack[sc->file_i]);
+ sc->load_stack[sc->file_i].rep.stdio.filename = fname;
#endif
}
return fin!=0;
@@ -1707,6 +1747,10 @@ static void file_pop(scheme *sc) {
if(sc->file_i != 0) {
sc->nesting=sc->nesting_stack[sc->file_i];
port_close(sc,sc->loadport,port_input);
+#if SHOW_ERROR_LINE
+ if (sc->load_stack[sc->file_i].kind & port_file)
+ port_clear_location(sc, &sc->load_stack[sc->file_i]);
+#endif
sc->file_i--;
sc->loadport->_object._port=sc->load_stack+sc->file_i;
}
@@ -1736,10 +1780,12 @@ static port *port_rep_from_filename(scheme *sc, const char *fn, int prop) {
pt->rep.stdio.closeit=1;
#if SHOW_ERROR_LINE
- if(fn)
- pt->rep.stdio.filename = store_string(sc, strlen(fn), fn, 0);
+ if (fn)
+ pt->rep.stdio.filename = mk_string(sc, fn);
+ else
+ pt->rep.stdio.filename = mk_string(sc, "<unknown>");
- pt->rep.stdio.curr_line = 0;
+ port_reset_current_line(sc, pt);
#endif
return pt;
}
@@ -1764,6 +1810,10 @@ static port *port_rep_from_file(scheme *sc, FILE *f, int prop)
pt->kind = port_file | prop;
pt->rep.stdio.file = f;
pt->rep.stdio.closeit = 0;
+#if SHOW_ERROR_LINE
+ pt->rep.stdio.filename = mk_string(sc, "<unknown>");
+ port_reset_current_line(sc, pt);
+#endif
return pt;
}
@@ -1837,10 +1887,7 @@ static void port_close(scheme *sc, pointer p, int flag) {
#if SHOW_ERROR_LINE
/* Cleanup is here so (close-*-port) functions could work too */
- pt->rep.stdio.curr_line = 0;
-
- if(pt->rep.stdio.filename)
- sc->free(pt->rep.stdio.filename);
+ port_clear_location(sc, pt);
#endif
fclose(pt->rep.stdio.file);
@@ -2119,8 +2166,11 @@ static INLINE int skipspace(scheme *sc) {
/* record it */
#if SHOW_ERROR_LINE
- if (sc->load_stack[sc->file_i].kind & port_file)
- sc->load_stack[sc->file_i].rep.stdio.curr_line += curr_line;
+ {
+ port *p = &sc->load_stack[sc->file_i];
+ if (p->kind & port_file)
+ port_increment_current_line(sc, p, curr_line);
+ }
#endif
if(c!=EOF) {
@@ -2160,7 +2210,7 @@ static int token(scheme *sc) {
#if SHOW_ERROR_LINE
if(c == '\n' && sc->load_stack[sc->file_i].kind & port_file)
- sc->load_stack[sc->file_i].rep.stdio.curr_line++;
+ port_increment_current_line(sc, &sc->load_stack[sc->file_i], 1);
#endif
if(c == EOF)
@@ -2188,7 +2238,7 @@ static int token(scheme *sc) {
#if SHOW_ERROR_LINE
if(c == '\n' && sc->load_stack[sc->file_i].kind & port_file)
- sc->load_stack[sc->file_i].rep.stdio.curr_line++;
+ port_increment_current_line(sc, &sc->load_stack[sc->file_i], 1);
#endif
if(c == EOF)
@@ -2691,8 +2741,8 @@ static pointer _Error_1(scheme *sc, const char *s, pointer a) {
fname = string_value(car(tag));
ln = ivalue_unchecked(cdr(tag));
} else {
- fname = sc->load_stack[sc->file_i].rep.stdio.filename;
- ln = sc->load_stack[sc->file_i].rep.stdio.curr_line;
+ fname = string_value(sc->load_stack[sc->file_i].rep.stdio.filename);
+ ln = ivalue_unchecked(sc->load_stack[sc->file_i].rep.stdio.curr_line);
}
/* should never happen */
@@ -3105,7 +3155,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
fprintf(sc->outport->_object._port->rep.stdio.file,
"Loading %s\n", strvalue(car(sc->args)));
}
- if (!file_push(sc,strvalue(car(sc->args)))) {
+ if (!file_push(sc, car(sc->args))) {
Error_1(sc,"unable to open", car(sc->args));
}
else
@@ -4839,14 +4889,13 @@ static pointer opexe_5(scheme *sc, enum scheme_opcodes op) {
sc->nesting_stack[sc->file_i]++;
#if USE_TAGS && SHOW_ERROR_LINE
if (sc->load_stack[sc->file_i].kind & port_file) {
- const char *filename =
+ pointer filename =
sc->load_stack[sc->file_i].rep.stdio.filename;
- int lineno =
+ pointer lineno =
sc->load_stack[sc->file_i].rep.stdio.curr_line;
s_save(sc, OP_TAG_VALUE,
- cons(sc, mk_string(sc, filename),
- cons(sc, mk_integer(sc, lineno), sc->NIL)),
+ cons(sc, filename, cons(sc, lineno, sc->NIL)),
sc->NIL);
}
#endif
@@ -4917,7 +4966,8 @@ static pointer opexe_5(scheme *sc, enum scheme_opcodes op) {
backchar(sc,c);
#if SHOW_ERROR_LINE
else if (sc->load_stack[sc->file_i].kind & port_file)
- sc->load_stack[sc->file_i].rep.stdio.curr_line++;
+ port_increment_current_line(sc,
+ &sc->load_stack[sc->file_i], 1);
#endif
sc->nesting_stack[sc->file_i]--;
s_return(sc,reverse_in_place(sc, sc->NIL, sc->args));
@@ -5583,10 +5633,6 @@ void scheme_set_external_data(scheme *sc, void *p) {
void scheme_deinit(scheme *sc) {
int i;
-#if SHOW_ERROR_LINE
- char *fname;
-#endif
-
sc->oblist=sc->NIL;
sc->global_env=sc->NIL;
dump_stack_free(sc);
@@ -5608,6 +5654,14 @@ void scheme_deinit(scheme *sc) {
typeflag(sc->loadport) = T_ATOM;
}
sc->loadport=sc->NIL;
+
+#if SHOW_ERROR_LINE
+ for(i=0; i<=sc->file_i; i++) {
+ if (sc->load_stack[i].kind & port_file)
+ port_clear_location(sc, &sc->load_stack[i]);
+ }
+#endif
+
sc->gc_verbose=0;
gc(sc,sc->NIL,sc->NIL);
@@ -5619,16 +5673,6 @@ void scheme_deinit(scheme *sc) {
sc->free(sc->alloc_seg[i]);
}
sc->free(sc->strbuff);
-
-#if SHOW_ERROR_LINE
- for(i=0; i<=sc->file_i; i++) {
- if (sc->load_stack[i].kind & port_file) {
- fname = sc->load_stack[i].rep.stdio.filename;
- if(fname)
- sc->free(fname);
- }
- }
-#endif
}
void scheme_load_file(scheme *sc, FILE *fin)
@@ -5647,11 +5691,11 @@ void scheme_load_named_file(scheme *sc, FILE *fin, const char *filename) {
}
#if SHOW_ERROR_LINE
- sc->load_stack[0].rep.stdio.curr_line = 0;
+ port_reset_current_line(sc, &sc->load_stack[0]);
if(fin!=stdin && filename)
- sc->load_stack[0].rep.stdio.filename = store_string(sc, strlen(filename), filename, 0);
+ sc->load_stack[0].rep.stdio.filename = mk_string(sc, filename);
else
- sc->load_stack[0].rep.stdio.filename = NULL;
+ sc->load_stack[0].rep.stdio.filename = mk_string(sc, "<unknown>");
#endif
sc->inport=sc->loadport;
@@ -5663,8 +5707,7 @@ void scheme_load_named_file(scheme *sc, FILE *fin, const char *filename) {
}
#if SHOW_ERROR_LINE
- sc->free(sc->load_stack[0].rep.stdio.filename);
- sc->load_stack[0].rep.stdio.filename = NULL;
+ port_clear_location(sc, &sc->load_stack[0]);
#endif
}
-----------------------------------------------------------------------
Summary of changes:
tests/gpgscm/init.scm | 17 ++++++
tests/gpgscm/scheme-private.h | 4 +-
tests/gpgscm/scheme.c | 139 +++++++++++++++++++++++++++---------------
tests/gpgscm/tests.scm | 81 +++++++++++-------------
4 files changed, 145 insertions(+), 96 deletions(-)
hooks/post-receive
--
The GNU Privacy Guard
http://git.gnupg.org
More information about the Gnupg-commits
mailing list