[git] GnuPG - branch, master, updated. gnupg-2.1.21-62-g61ef435

by Justus Winter cvs at cvs.gnupg.org
Mon Jun 19 16:56:26 CEST 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  61ef43546ba9f0209692a1569d2f033436566a02 (commit)
       via  e555e7ed7de20fbbb1e3b005c32e292f29cc4a58 (commit)
       via  6639aedaee051e8104d7f63b9a5812abf79440ed (commit)
       via  4c8be58fd46bb16332e84ab8ce978087dc5c68a3 (commit)
       via  b766d3d1034e6068a91755ada68f7f7dbe2943b6 (commit)
      from  3419a339d9c4e800bf30e9021e05982d8c1021c1 (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 61ef43546ba9f0209692a1569d2f033436566a02
Author: Justus Winter <justus at g10code.com>
Date:   Mon Jun 19 16:31:25 2017 +0200

    gpgscm: Limit the number of parallel jobs.
    
    * ffi.c (do_wait_processes): Suppress the timeout error.
    * tests.scm (semaphore): New definition.
    (test-pool): Only run a bounded number of tests in parallel.
    (test::started?): New function.
    (run-tests-parallel): Do not report results, do not start the tests.
    (run-tests-sequential): Adapt.
    (run-tests): Parse the number of parallel jobs.
    --
    
    This change limits the number of tests that are run in parallel.  This
    way we do not overwhelm the operating systems' scheduler.  As a
    side-effect, we also get more accurate runtime information, and it
    will be easy to implement timeouts on top of this.
    
    Use TESTFLAGS to limit the number of jobs:
    
        $ make check-all TESTFLAGS=--parallel=16
    
    Signed-off-by: Justus Winter <justus at g10code.com>

diff --git a/tests/gpgscm/ffi.c b/tests/gpgscm/ffi.c
index 3af3328..4c03ba6 100644
--- a/tests/gpgscm/ffi.c
+++ b/tests/gpgscm/ffi.c
@@ -915,6 +915,8 @@ do_wait_processes (scheme *sc, pointer args)
                               retcodes);
   if (err == GPG_ERR_GENERAL)
     err = 0;	/* Let the return codes speak.  */
+  if (err == GPG_ERR_TIMEOUT)
+    err = 0;	/* We may have got some results.  */
 
   for (i = 0; i < count; i++)
     retcodes_list =
diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm
index b66240d..a6772d1 100644
--- a/tests/gpgscm/tests.scm
+++ b/tests/gpgscm/tests.scm
@@ -498,29 +498,98 @@
 ;; The main test framework.
 ;;
 
+(define semaphore
+  (package
+   (define (new n)
+     (package
+      (define (acquire!?)
+	(if (> n 0)
+	    (begin
+	      (set! n (- n 1))
+	      #t)
+	    #f))
+      (define (release!)
+	(set! n (+ n 1)))))))
+
 ;; A pool of tests.
 (define test-pool
   (package
-   (define (new procs)
+   (define (new n)
      (package
+      ;; A semaphore to restrict the number of spawned processes.
+      (define sem (semaphore::new n))
+
+      ;; A list of enqueued, but not yet run tests.
+      (define enqueued '())
+
+      ;; A list of running or finished processes.
+      (define procs '())
+
       (define (add test)
-	(set! procs (cons test procs))
+	(if (test::started?)
+	    (set! procs (cons test procs))
+	    (if (sem::acquire!?)
+		(add (test::run-async))
+		(set! enqueued (cons test enqueued))))
 	(current-environment))
+
+      ;; Pop the last of the enqueued tests off the fifo queue.
+      (define (pop-test!)
+	(let ((i (length enqueued)))
+	  (assert (> i 0))
+	  (cond
+	   ((= i 1)
+	    (let ((test (car enqueued)))
+	      (set! enqueued '())
+	      test))
+	   (else
+	    (let* ((tail (list-tail enqueued (- i 2)))
+		   (test (cadr tail)))
+	      (set-cdr! tail '())
+	      (assert (= (length enqueued) (- i 1)))
+	      test)))))
+
       (define (pid->test pid)
 	(let ((t (filter (lambda (x) (= pid x::pid)) procs)))
 	  (if (null? t) #f (car t))))
       (define (wait)
+	(if (null? enqueued)
+	    ;; If no tests are enqueued, we can just block until all
+	    ;; of them finished.
+	    (wait' #t)
+	    ;; Otherwise, we must not block, but give some tests the
+	    ;; chance to finish so that we can start new ones.
+	    (begin
+	      (wait' #f)
+	      (usleep (/ 1000000 10))
+	      (wait))))
+      (define (wait' hang)
 	(let ((unfinished (filter (lambda (t) (not t::retcode)) procs)))
 	  (if (null? unfinished)
 	      (current-environment)
 	      (let ((names (map (lambda (t) t::name) unfinished))
-		    (pids (map (lambda (t) t::pid) unfinished)))
+		    (pids (map (lambda (t) t::pid) unfinished))
+		    (any #f))
 		(for-each
 		 (lambda (test retcode)
-		   (test::set-end-time!)
-		   (test:::set! 'retcode retcode))
+		   (unless (< retcode 0)
+			   (test::set-end-time!)
+			   (test:::set! 'retcode retcode)
+			   (test::report)
+			   (sem::release!)
+			   (set! any #t)))
 		 (map pid->test pids)
-		 (wait-processes (map stringify names) pids #t)))))
+		 (wait-processes (map stringify names) pids hang))
+
+		;; If some processes finished, try to start new ones.
+		(let loop ()
+		  (cond
+		   ((not any) #f)
+		   ((pair? enqueued)
+		    (if (sem::acquire!?)
+			(let ((test (pop-test!)))
+			  (add (test::run-async))
+			  (loop)))))))))
 	(current-environment))
       (define (filter-tests status)
 	(filter (lambda (p) (eq? status (p::status))) procs))
@@ -629,6 +698,10 @@
       (define (set-end-time!)
 	(set! end-time (get-time)))
 
+      ;; Has the test been started yet?
+      (define (started?)
+	(number? pid))
+
       (define (open-log-file)
 	(unless log-file-name
 		(set! log-file-name (string-append (basename name) ".log")))
@@ -713,23 +786,22 @@
 
 ;; Run the setup target to create an environment, then run all given
 ;; tests in parallel.
-(define (run-tests-parallel tests)
-  (let loop ((pool (test-pool::new '())) (tests' tests))
+(define (run-tests-parallel tests n)
+  (let loop ((pool (test-pool::new n)) (tests' tests))
     (if (null? tests')
 	(let ((results (pool::wait)))
-	  (for-each (lambda (t) (t::report)) (reverse results::procs))
 	  ((results::xml) (open-output-file "report.xml"))
 	  (exit (results::report)))
 	(let ((wd (mkdtemp-autoremove))
 	      (test (car tests')))
 	  (test:::set! 'directory wd)
-	  (loop (pool::add (test::run-async))
+	  (loop (pool::add test)
 		(cdr tests'))))))
 
 ;; Run the setup target to create an environment, then run all given
 ;; tests in sequence.
 (define (run-tests-sequential tests)
-  (let loop ((pool (test-pool::new '())) (tests' tests))
+  (let loop ((pool (test-pool::new 1)) (tests' tests))
     (if (null? tests')
 	(let ((results (pool::wait)))
 	  ((results::xml) (open-output-file "report.xml"))
@@ -743,10 +815,14 @@
 ;; Run tests either in sequence or in parallel, depending on the
 ;; number of tests and the command line flags.
 (define (run-tests tests)
-  (if (and (flag "--parallel" *args*)
-	   (> (length tests) 1))
-      (run-tests-parallel tests)
-      (run-tests-sequential tests)))
+  (let ((parallel (flag "--parallel" *args*))
+	(default-parallel-jobs 32))
+    (if (and parallel (> (length tests) 1))
+	(run-tests-parallel tests (if (and (pair? parallel)
+					   (string->number (car parallel)))
+				      (string->number (car parallel))
+				      default-parallel-jobs))
+	(run-tests-sequential tests))))
 
 ;; Load all tests from the given path.
 (define (load-tests . path)

commit e555e7ed7de20fbbb1e3b005c32e292f29cc4a58
Author: Justus Winter <justus at g10code.com>
Date:   Mon Jun 19 16:29:08 2017 +0200

    gpgscm: Improve option parsing.
    
    * tests/gpgscm/tests.scm (flag): Accept arguments of the form
    '--foo=bar'.
    
    Signed-off-by: Justus Winter <justus at g10code.com>

diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm
index eee8ce5..b66240d 100644
--- a/tests/gpgscm/tests.scm
+++ b/tests/gpgscm/tests.scm
@@ -766,7 +766,8 @@
 
 ;; Command line flag handling.  Returns the elements following KEY in
 ;; ARGUMENTS up to the next argument, or #f if KEY is not in
-;; ARGUMENTS.
+;; ARGUMENTS.  If 'KEY=XYZ' is encountered, then the singleton list
+;; containing 'XYZ' is returned.
 (define (flag key arguments)
   (cond
    ((null? arguments)
@@ -777,6 +778,10 @@
       (if (or (null? args) (string-prefix? (car args) "--"))
 	  (reverse acc)
 	  (loop (cons (car args) acc) (cdr args)))))
+   ((string-prefix? (car arguments) (string-append key "="))
+    (list (substring (car arguments)
+		     (+ (string-length key) 1)
+		     (string-length (car arguments)))))
    ((string=? "--" (car arguments))
     #f)
    (else
@@ -784,6 +789,7 @@
 (assert (equal? (flag "--xxx" '("--yyy")) #f))
 (assert (equal? (flag "--xxx" '("--xxx")) '()))
 (assert (equal? (flag "--xxx" '("--xxx" "yyy")) '("yyy")))
+(assert (equal? (flag "--xxx" '("--xxx=foo" "yyy")) '("foo")))
 (assert (equal? (flag "--xxx" '("--xxx" "yyy" "zzz")) '("yyy" "zzz")))
 (assert (equal? (flag "--xxx" '("--xxx" "yyy" "zzz" "--")) '("yyy" "zzz")))
 (assert (equal? (flag "--xxx" '("--xxx" "yyy" "--" "zzz")) '("yyy")))

commit 6639aedaee051e8104d7f63b9a5812abf79440ed
Author: Justus Winter <justus at g10code.com>
Date:   Mon Jun 19 16:24:18 2017 +0200

    gpgscm: Improve error handling of foreign functions.
    
    * tests/gpgscm/ffi.scm (ffi-fail): Do not needlessly join the error
    message.
    
    Signed-off-by: Justus Winter <justus at g10code.com>

diff --git a/tests/gpgscm/ffi.scm b/tests/gpgscm/ffi.scm
index 3f2e553..051c2c2 100644
--- a/tests/gpgscm/ffi.scm
+++ b/tests/gpgscm/ffi.scm
@@ -36,8 +36,7 @@
 (define (ffi-fail name args message)
   (let ((args' (open-output-string)))
     (write (cons (string->symbol name) args) args')
-    (throw (string-append
-	    (get-output-string args') ": " message))))
+    (throw (get-output-string args') message)))
 
 ;; Pseudo-definitions for foreign functions.  Evaluates to no code,
 ;; but serves as documentation.

commit 4c8be58fd46bb16332e84ab8ce978087dc5c68a3
Author: Justus Winter <justus at g10code.com>
Date:   Mon Jun 19 16:13:24 2017 +0200

    gpgscm: Improve error reporting.
    
    * tests/gpgscm/init.scm (throw'): Guard against 'args' being atomic.
    * tests/gpgscm/scheme.c (Eval_Cycle): Remove any superfluous colons in
    error messages.
    
    Signed-off-by: Justus Winter <justus at g10code.com>

diff --git a/tests/gpgscm/init.scm b/tests/gpgscm/init.scm
index 3769ed0..b78a59e 100644
--- a/tests/gpgscm/init.scm
+++ b/tests/gpgscm/init.scm
@@ -615,7 +615,7 @@
     (display message)
     (when (and args (not (null? args)))
 	  (display ": ")
-	  (if (string? (car args))
+	  (if (and (pair? args) (string? (car args)))
 	      (begin (display (car args))
 		     (unless (null? (cdr args))
 			     (newline)
diff --git a/tests/gpgscm/scheme.c b/tests/gpgscm/scheme.c
index 593bc74..f5e52fc 100644
--- a/tests/gpgscm/scheme.c
+++ b/tests/gpgscm/scheme.c
@@ -3565,7 +3565,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
                if (x != sc->NIL) {
                     s_return(sc,slot_value_in_env(x));
                } else {
-                    Error_1(sc,"eval: unbound variable:", sc->code);
+                    Error_1(sc, "eval: unbound variable", sc->code);
                }
           } else if (is_pair(sc->code)) {
                if (is_syntax(x = car(sc->code))) {     /* SYNTAX */
@@ -3677,7 +3677,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
                for (x = car(closure_code(sc->code)), y = sc->args;
                     is_pair(x); x = cdr(x), y = cdr(y)) {
                     if (y == sc->NIL) {
-                         Error_1(sc, "not enough arguments, missing:", x);
+                         Error_1(sc, "not enough arguments, missing", x);
                     } else if (is_symbol(car(x))) {
                          new_slot_in_env(sc, car(x), car(y));
                     } else {
@@ -3692,7 +3692,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
                } else if (is_symbol(x))
                     new_slot_in_env(sc, x, y);
                else {
-                    Error_1(sc,"syntax error in closure: not a symbol:", x);
+                    Error_1(sc, "syntax error in closure: not a symbol", x);
                }
                sc->code = cdr(closure_code(sc->code));
                sc->args = sc->NIL;
@@ -3805,7 +3805,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
                set_slot_in_env(sc, y, sc->value);
                s_return(sc,sc->value);
           } else {
-               Error_1(sc,"set!: unbound variable:", sc->code);
+               Error_1(sc, "set!: unbound variable", sc->code);
           }
 
 
@@ -3855,7 +3855,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
           if (is_pair(sc->code)) { /* continue */
                if (!is_pair(car(sc->code)) || !is_pair(cdar(sc->code))) {
 		    gc_enable(sc);
-                    Error_1(sc, "Bad syntax of binding spec in let :",
+                    Error_1(sc, "Bad syntax of binding spec in let",
                             car(sc->code));
                }
                s_save(sc,OP_LET1, sc->args, cdr(sc->code));
@@ -3881,9 +3881,9 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
           if (is_symbol(car(sc->code))) {    /* named let */
                for (x = cadr(sc->code), sc->args = sc->NIL; x != sc->NIL; x = cdr(x)) {
                     if (!is_pair(x))
-                        Error_1(sc, "Bad syntax of binding in let :", x);
+                        Error_1(sc, "Bad syntax of binding in let", x);
                     if (!is_list(sc, car(x)))
-                        Error_1(sc, "Bad syntax of binding in let :", car(x));
+                        Error_1(sc, "Bad syntax of binding in let", car(x));
 		    gc_disable(sc, 1);
                     sc->args = cons(sc, caar(x), sc->args);
 		    gc_enable(sc);
@@ -3907,7 +3907,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
                s_thread_to(sc,OP_BEGIN);
           }
           if(!is_pair(car(sc->code)) || !is_pair(caar(sc->code)) || !is_pair(cdaar(sc->code))) {
-               Error_1(sc,"Bad syntax of binding spec in let* :",car(sc->code));
+               Error_1(sc, "Bad syntax of binding spec in let*", car(sc->code));
           }
           s_save(sc,OP_LET1AST, cdr(sc->code), car(sc->code));
           sc->code = cadaar(sc->code);
@@ -3946,7 +3946,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
 	  gc_enable(sc);
           if (is_pair(sc->code)) { /* continue */
                if (!is_pair(car(sc->code)) || !is_pair(cdar(sc->code))) {
-                    Error_1(sc, "Bad syntax of binding spec in letrec :",
+                    Error_1(sc, "Bad syntax of binding spec in letrec",
                             car(sc->code));
                }
                s_save(sc,OP_LET1REC, sc->args, cdr(sc->code));
@@ -4165,7 +4165,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
           } else if(modf(rvalue_unchecked(x),&dd)==0.0) {
                s_return(sc,mk_integer(sc,ivalue(x)));
           } else {
-               Error_1(sc,"inexact->exact: not integral:",x);
+               Error_1(sc, "inexact->exact: not integral", x);
           }
 
      CASE(OP_EXP):
@@ -4425,7 +4425,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
             }
           }
           if (pf < 0) {
-            Error_1(sc, "string->atom: bad base:", cadr(sc->args));
+            Error_1(sc, "string->atom: bad base", cadr(sc->args));
           } else if(*s=='#') /* no use of base! */ {
             s_return(sc, mk_sharp_const(sc, s+1));
           } else {
@@ -4466,7 +4466,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
             }
           }
           if (pf < 0) {
-            Error_1(sc, "atom->string: bad base:", cadr(sc->args));
+            Error_1(sc, "atom->string: bad base", cadr(sc->args));
           } else if(is_number(x) || is_character(x) || is_string(x) || is_symbol(x)) {
             char *p;
             int len;
@@ -4474,7 +4474,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
 	    gc_disable(sc, 1);
             s_return_enable_gc(sc, mk_counted_string(sc, p, len));
           } else {
-            Error_1(sc, "atom->string: not an atom:", x);
+            Error_1(sc, "atom->string: not an atom", x);
           }
         }
 
@@ -4504,7 +4504,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
           index=ivalue(cadr(sc->args));
 
           if(index>=strlength(car(sc->args))) {
-               Error_1(sc,"string-ref: out of bounds:",cadr(sc->args));
+               Error_1(sc, "string-ref: out of bounds", cadr(sc->args));
           }
 
 	  gc_disable(sc, 1);
@@ -4518,13 +4518,14 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
           int c;
 
           if(is_immutable(car(sc->args))) {
-               Error_1(sc,"string-set!: unable to alter immutable string:",car(sc->args));
+               Error_1(sc, "string-set!: unable to alter immutable string",
+		       car(sc->args));
           }
           str=strvalue(car(sc->args));
 
           index=ivalue(cadr(sc->args));
           if(index>=strlength(car(sc->args))) {
-               Error_1(sc,"string-set!: out of bounds:",cadr(sc->args));
+               Error_1(sc, "string-set!: out of bounds", cadr(sc->args));
           }
 
           c=charvalue(caddr(sc->args));
@@ -4563,13 +4564,13 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
           index0=ivalue(cadr(sc->args));
 
           if(index0>strlength(car(sc->args))) {
-               Error_1(sc,"substring: start out of bounds:",cadr(sc->args));
+               Error_1(sc, "substring: start out of bounds", cadr(sc->args));
           }
 
           if(cddr(sc->args)!=sc->NIL) {
                index1=ivalue(caddr(sc->args));
                if(index1>strlength(car(sc->args)) || index1<index0) {
-                    Error_1(sc,"substring: end out of bounds:",caddr(sc->args));
+                    Error_1(sc, "substring: end out of bounds", caddr(sc->args));
                }
           } else {
                index1=strlength(car(sc->args));
@@ -4584,7 +4585,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
           pointer vec;
           int len=list_length(sc,sc->args);
           if(len<0) {
-               Error_1(sc,"vector: not a proper list:",sc->args);
+               Error_1(sc, "vector: not a proper list", sc->args);
           }
           vec=mk_vector(sc,len);
           if(sc->no_memory) { s_return(sc, sc->sink); }
@@ -4622,7 +4623,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
           index=ivalue(cadr(sc->args));
 
           if(index >= vector_length(car(sc->args))) {
-               Error_1(sc,"vector-ref: out of bounds:",cadr(sc->args));
+               Error_1(sc, "vector-ref: out of bounds", cadr(sc->args));
           }
 
           s_return(sc,vector_elem(car(sc->args),index));
@@ -4632,12 +4633,13 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
           int index;
 
           if(is_immutable(car(sc->args))) {
-               Error_1(sc,"vector-set!: unable to alter immutable vector:",car(sc->args));
+               Error_1(sc, "vector-set!: unable to alter immutable vector",
+		       car(sc->args));
           }
 
           index=ivalue(cadr(sc->args));
           if(index >= vector_length(car(sc->args))) {
-               Error_1(sc,"vector-set!: out of bounds:",cadr(sc->args));
+               Error_1(sc, "vector-set!: out of bounds", cadr(sc->args));
           }
 
           set_vector_elem(car(sc->args),index,caddr(sc->args));
@@ -4980,7 +4982,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
                s_thread_to(sc,OP_READ_INTERNAL);
           }
           if(!is_inport(car(sc->args))) {
-               Error_1(sc,"read: not an input port:",car(sc->args));
+               Error_1(sc, "read: not an input port", car(sc->args));
           }
           if(car(sc->args)==sc->inport) {
                s_thread_to(sc,OP_READ_INTERNAL);
@@ -5258,7 +5260,7 @@ Eval_Cycle(scheme *sc, enum scheme_opcodes op) {
      CASE(OP_LIST_LENGTH): {   /* length */   /* a.k */
 	  long l = list_length(sc, car(sc->args));
           if(l<0) {
-               Error_1(sc,"length: not a list:",car(sc->args));
+               Error_1(sc, "length: not a list", car(sc->args));
           }
 	  gc_disable(sc, 1);
           s_return_enable_gc(sc, mk_integer(sc, l));

commit b766d3d1034e6068a91755ada68f7f7dbe2943b6
Author: Justus Winter <justus at g10code.com>
Date:   Mon Jun 19 10:17:57 2017 +0200

    tests: Run the OpenPGP tests using the new extended key format.
    
    * tests/openpgp/all-tests.scm: Generalize a bit, and also add a
    variant that uses the new extended key format.
    * tests/openpgp/defs.scm (create-gpghome): Conditionally enable the
    new extended key format.
    
    Signed-off-by: Justus Winter <justus at g10code.com>

diff --git a/tests/openpgp/all-tests.scm b/tests/openpgp/all-tests.scm
index 6584df2..4dd6d6f 100644
--- a/tests/openpgp/all-tests.scm
+++ b/tests/openpgp/all-tests.scm
@@ -33,13 +33,19 @@
      (path-join "tests" "openpgp" "setup.scm")
      (in-srcdir "tests" "openpgp" "setup.scm"))))
 
- (define setup-use-keyring
+ (define (qualify path variant)
+   (string-append "<" variant ">" path))
+
+ (define (setup* variant)
    (make-environment-cache
     (test::scm
      #f
-     (string-append "<use-keyring>" (path-join "tests" "openpgp" "setup.scm"))
+     (qualify (path-join "tests" "openpgp" "setup.scm") variant)
      (in-srcdir "tests" "openpgp" "setup.scm")
-     "--use-keyring")))
+     (string-append "--" variant))))
+
+ (define setup-use-keyring (setup* "use-keyring"))
+ (define setup-extended-key-format (setup* "extended-key-format"))
 
  (define all-tests
    (parse-makefile-expand (in-srcdir "tests" "openpgp" "Makefile.am")
@@ -52,7 +58,11 @@
 		    (in-srcdir "tests" "openpgp" name))) all-tests)
   (map (lambda (name)
 	 (test::scm setup-use-keyring
-		    (string-append "<use-keyring>"
-				   (path-join "tests" "openpgp" name))
+		    (qualify (path-join "tests" "openpgp" name) "use-keyring")
+		    (in-srcdir "tests" "openpgp" name)
+		    "--use-keyring")) all-tests)
+  (map (lambda (name)
+	 (test::scm setup-extended-key-format
+		    (qualify (path-join "tests" "openpgp" name) "extended-key-format")
 		    (in-srcdir "tests" "openpgp" name)
-		    "--use-keyring")) all-tests)))
+		    "--extended-key-format")) all-tests)))
diff --git a/tests/openpgp/defs.scm b/tests/openpgp/defs.scm
index a61e6c3..50976b9 100644
--- a/tests/openpgp/defs.scm
+++ b/tests/openpgp/defs.scm
@@ -348,6 +348,8 @@
 	       "allow-preset-passphrase"
 	       "no-grab"
 	       "enable-ssh-support"
+	       (if (flag "--extended-key-format" *args*)
+		   "enable-extended-key-format" "#enable-extended-key-format")
 	       (string-append "pinentry-program " (tool 'pinentry))
 	       (string-append "scdaemon-program " (tool 'scdaemon))
 	       ))

-----------------------------------------------------------------------

Summary of changes:
 tests/gpgscm/ffi.c          |   2 +
 tests/gpgscm/ffi.scm        |   3 +-
 tests/gpgscm/init.scm       |   2 +-
 tests/gpgscm/scheme.c       |  50 +++++++++----------
 tests/gpgscm/tests.scm      | 114 +++++++++++++++++++++++++++++++++++++-------
 tests/openpgp/all-tests.scm |  22 ++++++---
 tests/openpgp/defs.scm      |   2 +
 7 files changed, 146 insertions(+), 49 deletions(-)


hooks/post-receive
-- 
The GNU Privacy Guard
http://git.gnupg.org




More information about the Gnupg-commits mailing list