diff --git a/tests/gpgme/all-tests.scm b/tests/gpgme/all-tests.scm
index f72f8af97..1746c4ee1 100644
--- a/tests/gpgme/all-tests.scm
+++ b/tests/gpgme/all-tests.scm
@@ -1,86 +1,89 @@
 ;; Copyright (C) 2016 g10 Code GmbH
 ;;
 ;; This file is part of GnuPG.
 ;;
 ;; GnuPG is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 3 of the License, or
 ;; (at your option) any later version.
 ;;
 ;; GnuPG is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;;
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program; if not, see <http://www.gnu.org/licenses/>.
 
 (export all-tests
  ;; Parse GPGME's makefiles to find all tests.
 
  (load (in-srcdir "tests" "gpgme" "gpgme-defs.scm"))
  (load (with-path "makefile.scm"))
 
  (define (expander filename port key)
    ;;(interactive-repl (current-environment))
    (cond
     ((string=? key "tests_unix")
      (if *win32*
 	 (parse-makefile port key)   ;; Use win32 definition.
 	 (begin
 	   (parse-makefile port key) ;; Skip win32 definition.
 	   (parse-makefile port key))))
     (else
      (parse-makefile port key))))
 
  (define (parse filename key)
    (parse-makefile-expand filename expander key))
 
  (define setup-c
    (make-environment-cache
     (test::scm
+     #f
      #f
      (path-join "tests" "gpgme" "setup.scm" "tests" "gpg")
      (in-srcdir "tests" "gpgme" "setup.scm")
      "--" "tests" "gpg")))
  (define setup-py
    (make-environment-cache
     (test::scm
+     #f
      #f
      (path-join "tests" "gpgme" "setup.scm" "lang" "python" "tests")
      (in-srcdir "tests" "gpgme" "setup.scm")
      "--" "lang" "python" "tests")))
 
  (define (compiled? name)
    (not (or (string-suffix? name ".py")
 	    (string-suffix? name ".test"))))
  (define :path car)
  (define :key cadr)
  (define :setup caddr)
 
  (if (have-gpgme?)
      (apply append
 	    (map (lambda (cmpnts)
 		   (define (find-test name)
 		     (apply path-join
 			    `(,(if (compiled? name)
 				   gpgme-builddir
 				   gpgme-srcdir) ,@(:path cmpnts) ,(qualify name))))
 		   (let ((makefile (apply path-join `(,gpgme-srcdir ,@(:path cmpnts)
 								    "Makefile.am"))))
 		     (map (lambda (name)
 			    (apply test::scm
 				   `(,(:setup cmpnts)
+                                     #f
 				     ,(apply path-join
 					     `("tests" "gpgme" ,@(:path cmpnts) ,name))
 				     ,(in-srcdir "tests" "gpgme" "wrap.scm")
 				     --executable
 				     ,(find-test name)
 				     -- ,@(:path cmpnts))))
 			  (parse makefile (:key cmpnts)))))
 		 `((("tests" "gpg") "c_tests" ,setup-c)
 		   ,@(if (run-python-tests?)
 			 `((("lang" "python" "tests") "py_tests" ,setup-py))
 			 '())
 		   (("lang" "qt" "tests") "TESTS" ,setup-c))))
      '()))
diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm
index 37c1d64c6..059d6a7e7 100644
--- a/tests/gpgscm/tests.scm
+++ b/tests/gpgscm/tests.scm
@@ -1,888 +1,893 @@
 ;; Common definitions for writing tests.
 ;;
 ;; Copyright (C) 2016 g10 Code GmbH
 ;;
 ;; This file is part of GnuPG.
 ;;
 ;; GnuPG is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 3 of the License, or
 ;; (at your option) any later version.
 ;;
 ;; GnuPG is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;;
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program; if not, see <http://www.gnu.org/licenses/>.
 
 ;; Reporting.
 (define (echo . msg)
   (for-each (lambda (x) (display x) (display " ")) msg)
   (newline))
 
 (define (info . msg)
   (apply echo msg)
   (flush-stdio))
 
 (define (log . msg)
   (if (> (*verbose*) 0)
       (apply info msg)))
 
 (define (fail . msg)
   (apply info msg)
   (exit 1))
 
 (define (skip . msg)
   (apply info msg)
   (exit 77))
 
 (define (make-counter)
   (let ((c 0))
     (lambda ()
       (let ((r c))
 	(set! c (+ 1 c))
 	r))))
 
 (define *progress-nesting* 0)
 
 (define (call-with-progress msg what)
   (set! *progress-nesting* (+ 1 *progress-nesting*))
   (if (= 1 *progress-nesting*)
       (begin
 	(info msg)
 	(display "    > ")
 	(flush-stdio)
 	(what (lambda (item)
 	      (display item)
 	      (display " ")
 	      (flush-stdio)))
 	(info "< "))
       (begin
 	(what (lambda (item) (display ".") (flush-stdio)))
 	(display " ")
 	(flush-stdio)))
   (set! *progress-nesting* (- *progress-nesting* 1)))
 
 (define (for-each-p msg proc lst . lsts)
   (apply for-each-p' `(,msg ,proc ,(lambda (x . xs) x) ,lst ,@lsts)))
 
 (define (for-each-p' msg proc fmt lst . lsts)
   (call-with-progress
    msg
    (lambda (progress)
      (apply for-each
 	    `(,(lambda args
 		 (progress (apply fmt args))
 		 (apply proc args))
 	      ,lst ,@lsts)))))
 
 ;; Process management.
 (define CLOSED_FD -1)
 (define (call-with-fds what infd outfd errfd)
   (wait-process (stringify what) (spawn-process-fd what infd outfd errfd) #t))
 (define (call what)
   (call-with-fds what
 		 CLOSED_FD
 		 (if (< (*verbose*) 0) STDOUT_FILENO CLOSED_FD)
 		 (if (< (*verbose*) 0) STDERR_FILENO CLOSED_FD)))
 
 ;; Accessor functions for the results of 'spawn-process'.
 (define :stdin car)
 (define :stdout cadr)
 (define :stderr caddr)
 (define :pid cadddr)
 
 (define (call-with-io what in)
   (let ((h (spawn-process what 0)))
     (es-write (:stdin h) in)
     (es-fclose (:stdin h))
     (let* ((out (es-read-all (:stdout h)))
 	   (err (es-read-all (:stderr h)))
 	   (result (wait-process (car what) (:pid h) #t)))
       (es-fclose (:stdout h))
       (es-fclose (:stderr h))
       (if (> (*verbose*) 2)
 	  (info "Child" (:pid h) "returned:"
 		`((command ,(stringify what))
 		  (status ,result)
 		  (stdout ,out)
 		  (stderr ,err))))
       (list result out err))))
 
 ;; Accessor function for the results of 'call-with-io'.  ':stdout' and
 ;; ':stderr' can also be used.
 (define :retcode car)
 
 (define (call-check what)
   (let ((result (call-with-io what "")))
     (if (= 0 (:retcode result))
 	(:stdout result)
 	(throw (string-append (stringify what) " failed")
 	       (:stderr result)))))
 
 (define (call-popen command input-string)
   (let ((result (call-with-io command input-string)))
     (if (= 0 (:retcode result))
 	(:stdout result)
 	(throw (:stderr result)))))
 
 ;;
 ;; estream helpers.
 ;;
 
 (define (es-read-all stream)
   (let loop
       ((acc ""))
     (if (es-feof stream)
 	acc
 	(loop (string-append acc (es-read stream 4096))))))
 
 ;;
 ;; File management.
 ;;
 (define (file-exists? name)
   (call-with-input-file name (lambda (port) #t)))
 
 (define (file=? a b)
   (file-equal a b #t))
 
 (define (text-file=? a b)
   (file-equal a b #f))
 
 (define (file-copy from to)
   (catch '() (unlink to))
   (letfd ((source (open from (logior O_RDONLY O_BINARY)))
 	  (sink (open to (logior O_WRONLY O_CREAT O_BINARY) #o600)))
     (splice source sink)))
 
 (define (text-file-copy from to)
   (catch '() (unlink to))
   (letfd ((source (open from O_RDONLY))
 	  (sink (open to (logior O_WRONLY O_CREAT) #o600)))
     (splice source sink)))
 
 (define (path-join . components)
   (let loop ((acc #f) (rest (filter (lambda (s)
 				      (not (string=? "" s))) components)))
     (if (null? rest)
 	acc
 	(loop (if (string? acc)
 		  (string-append acc "/" (car rest))
 		  (car rest))
 	      (cdr rest)))))
 (assert (string=? (path-join "foo" "bar" "baz") "foo/bar/baz"))
 (assert (string=? (path-join "" "bar" "baz") "bar/baz"))
 
 ;; Is PATH an absolute path?
 (define (absolute-path? path)
   (or (char=? #\/ (string-ref path 0))
       (and *win32* (char=? #\\ (string-ref path 0)))
       (and *win32*
 	   (char-alphabetic? (string-ref path 0))
 	   (char=? #\: (string-ref path 1))
 	   (or (char=? #\/ (string-ref path 2))
 	       (char=? #\\ (string-ref path 2))))))
 
 ;; Make PATH absolute.
 (define (canonical-path path)
   (if (absolute-path? path) path (path-join (getcwd) path)))
 
 (define (in-srcdir . names)
   (canonical-path (apply path-join (cons (getenv "abs_top_srcdir") names))))
 
 ;; Split a list of paths.
 (define (pathsep-split s)
   (string-split s *pathsep*))
 
 ;; Join a list of paths.
 (define (pathsep-join paths)
   (foldr (lambda (a b) (string-append a (string *pathsep*) b))
 	 (car paths)
 	 (cdr paths)))
 
 ;; Try to find NAME in PATHS.  Returns the full path name on success,
 ;; or raises an error.
 (define (path-expand name paths)
   (let loop ((path paths))
     (if (null? path)
 	(throw "Could not find" name "in" paths)
 	(let* ((qualified-name (path-join (car path) name))
 	       (file-exists (call-with-input-file qualified-name
 			      (lambda (x) #t))))
 	  (if file-exists
 	      qualified-name
 	      (loop (cdr path)))))))
 
 ;; Expand NAME using the gpgscm load path.  Use like this:
 ;;   (load (with-path "library.scm"))
 (define (with-path name)
   (catch name
 	 (path-expand name (pathsep-split (getenv "GPGSCM_PATH")))))
 
 (define (basename path)
   (let ((i (string-index path #\/)))
     (if (equal? i #f)
 	path
 	(basename (substring path (+ 1 i) (string-length path))))))
 
 (define (basename-suffix path suffix)
   (basename
    (if (string-suffix? path suffix)
        (substring path 0 (- (string-length path) (string-length suffix)))
        path)))
 
 (define (dirname path)
   (let ((i (string-rindex path #\/)))
     (if i (substring path 0 i) ".")))
 (assert (string=? "foo/bar" (dirname "foo/bar/baz")))
 
 ;; Helper for (pipe).
 (define :read-end car)
 (define :write-end cadr)
 
 ;; let-like macro that manages file descriptors.
 ;;
 ;; (letfd <bindings> <body>)
 ;;
 ;; Bind all variables given in <bindings> and initialize each of them
 ;; to the given initial value, and close them after evaluating <body>.
 (define-macro (letfd bindings . body)
   (let bind ((bindings' bindings))
     (if (null? bindings')
 	`(begin ,@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 () ,@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
 ;; "XXXXXX".  If no arguments are given, a suitable location and
 ;; generic name is used.  Returns an absolute path.
 (define (mkdtemp . components)
   (canonical-path (_mkdtemp (if (null? components)
 				(path-join
 				 (get-temp-path)
 				 (string-append "gpgscm-" (get-isotime) "-"
 						(basename-suffix *scriptname* ".scm")
 						"-XXXXXX"))
 				(apply path-join components)))))
 
 ;; Make a temporary directory and remove it at interpreter shutdown.
 ;; Note that there are macros that limit the lifetime of temporary
 ;; directories and files to a lexical scope.  Use those if possible.
 ;; Otherwise this works like mkdtemp.
 (define (mkdtemp-autoremove . components)
   (let ((dir (apply mkdtemp components)))
     (atexit (lambda () (unlink-recursively dir)))
     dir))
 
 (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
 					,@expressions)))))
 
 (define (make-temporary-file . args)
   (canonical-path (path-join
 		   (mkdtemp)
 		   (if (null? args) "a" (car args)))))
 
 (define (remove-temporary-file filename)
   (catch '()
     (unlink filename))
   (let ((dirname (substring filename 0 (string-rindex filename #\/))))
     (catch (echo "removing temporary directory" dirname "failed")
       (rmdir dirname))))
 
 ;; let-like macro that manages temporary files.
 ;;
 ;; (lettmp <bindings> <body>)
 ;;
 ;; Bind all variables given in <bindings>, initialize each of them to
 ;; a string representing an unique path in the filesystem, and delete
 ;; them after evaluating <body>.
 (define-macro (lettmp bindings . body)
   (let bind ((bindings' bindings))
     (if (null? bindings')
 	`(begin ,@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)
 	  (transformer source sink)))
 
 (define (check-identity source transformer)
   (lettmp (sink)
 	  (transformer source sink)
 	  (if (not (file=? source sink))
 	      (fail "mismatch"))))
 
 ;;
 ;; Monadic pipe support.
 ;;
 
 (define pipeM
   (package
    (define (new procs source sink producer)
      (package
       (define (dump)
 	(write (list procs source sink producer))
 	(newline))
       (define (add-proc command pid)
 	(new (cons (list command pid) procs) source sink producer))
       (define (commands)
 	(map car procs))
       (define (pids)
 	(map cadr procs))
       (define (set-source source')
 	(new procs source' sink producer))
       (define (set-sink sink')
 	(new procs source sink' producer))
       (define (set-producer producer')
 	(if producer
 	    (throw "producer already set"))
 	(new procs source sink producer'))))))
 
 
 (define (pipe:do . commands)
   (let loop ((M (pipeM::new '() CLOSED_FD CLOSED_FD #f)) (cmds commands))
     (if (null? cmds)
 	(begin
 	  (if M::producer (M::producer))
 	  (if (not (null? M::procs))
 	      (let* ((retcodes (wait-processes (map stringify (M::commands))
 					       (M::pids) #t))
 		     (results (map (lambda (p r) (append p (list r)))
 				   M::procs retcodes))
 		     (failed (filter (lambda (x) (not (= 0 (caddr x))))
 				     results)))
 		(if (not (null? failed))
 		    (throw failed))))) ; xxx nicer reporting
 	(if (and (= 2 (length cmds)) (number? (cadr cmds)))
 	    ;; hack: if it's an fd, use it as sink
 	    (let ((M' ((car cmds) (M::set-sink (cadr cmds)))))
 	      (if (> M::source 2) (close M::source))
 	      (if (> (cadr cmds) 2) (close (cadr cmds)))
 	      (loop M' '()))
 	    (let ((M' ((car cmds) M)))
 	      (if (> M::source 2) (close M::source))
 	      (loop M' (cdr cmds)))))))
 
 (define (pipe:open pathname flags)
   (lambda (M)
     (M::set-source (open pathname flags))))
 
 (define (pipe:defer producer)
   (lambda (M)
     (let* ((p (outbound-pipe))
 	   (M' (M::set-source (:read-end p))))
       (M'::set-producer (lambda ()
 			  (producer (:write-end p))
 			  (close (:write-end p)))))))
 (define (pipe:echo data)
  (pipe:defer (lambda (sink) (display data (fdopen sink "wb")))))
 
 (define (pipe:spawn command)
   (lambda (M)
     (define (do-spawn M new-source)
       (let ((pid (spawn-process-fd command M::source M::sink
 				   (if (> (*verbose*) 0)
 				       STDERR_FILENO CLOSED_FD)))
 	    (M' (M::set-source new-source)))
 	(M'::add-proc command pid)))
     (if (= CLOSED_FD M::sink)
 	(let* ((p (pipe))
 	       (M' (do-spawn (M::set-sink (:write-end p)) (:read-end p))))
 	  (close (:write-end p))
 	  (M'::set-sink CLOSED_FD))
 	(do-spawn M CLOSED_FD))))
 
 (define (pipe:splice sink)
   (lambda (M)
     (splice M::source sink)
     (M::set-source CLOSED_FD)))
 
 (define (pipe:write-to pathname flags mode)
   (open pathname flags mode))
 
 ;;
 ;; Monadic transformer support.
 ;;
 
 (define (tr:do . commands)
   (let loop ((tmpfiles '()) (source  #f) (cmds commands))
     (if (null? cmds)
 	(for-each remove-temporary-file tmpfiles)
 	(let* ((v ((car cmds) tmpfiles source))
 	       (tmpfiles' (car v))
 	       (sink (cadr v))
 	       (error (caddr v)))
 	  (if error
 	      (begin
 		(for-each remove-temporary-file tmpfiles')
 		(apply throw error)))
 	  (loop tmpfiles' sink (cdr cmds))))))
 
 (define (tr:open pathname)
   (lambda (tmpfiles source)
     (list tmpfiles pathname #f)))
 
 (define (tr:spawn input command)
   (lambda (tmpfiles source)
     (if (and (member '**in** command) (not source))
 	(fail (string-append (stringify cmd) " needs an input")))
     (let* ((t (make-temporary-file))
 	   (cmd (map (lambda (x)
 		       (cond
 			((equal? '**in** x) source)
 			((equal? '**out** x) t)
 			(else x))) command)))
       (catch (list (cons t tmpfiles) t *error*)
 	     (call-popen cmd input)
 	     (if (and (member '**out** command) (not (file-exists? t)))
 		 (fail (string-append (stringify cmd)
 				       " did not produce '" t "'.")))
 	     (list (cons t tmpfiles) t #f)))))
 
 (define (tr:write-to pathname)
   (lambda (tmpfiles source)
     (rename source pathname)
     (list tmpfiles pathname #f)))
 
 (define (tr:pipe-do . commands)
   (lambda (tmpfiles source)
     (let ((t (make-temporary-file)))
       (apply pipe:do
         `(,@(if source `(,(pipe:open source (logior O_RDONLY O_BINARY))) '())
 	  ,@commands
 	  ,(pipe:write-to t (logior O_WRONLY O_BINARY O_CREAT) #o600)))
       (list (cons t tmpfiles) t #f))))
 
 (define (tr:assert-identity reference)
   (lambda (tmpfiles source)
     (if (not (file=? source reference))
 	(fail "mismatch"))
     (list tmpfiles source #f)))
 
 (define (tr:assert-weak-identity reference)
   (lambda (tmpfiles source)
     (if (not (text-file=? source reference))
 	(fail "mismatch"))
     (list tmpfiles source #f)))
 
 (define (tr:call-with-content function . args)
   (lambda (tmpfiles source)
     (catch (list tmpfiles source *error*)
 	   (apply function `(,(call-with-input-file source read-all) ,@args)))
     (list tmpfiles source #f)))
 
 ;;
 ;; Developing and debugging tests.
 ;;
 
 ;; Spawn an os shell.
 (define (interactive-shell)
   (call-with-fds `(,(getenv "SHELL") -i) 0 1 2))
 
 ;;
 ;; 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 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)
 	(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))
 		    (any #f))
 		(for-each
 		 (lambda (test 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 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))
       (define (report)
 	(define (print-tests tests message)
 	  (unless (null? tests)
 		  (apply echo (cons message
 				    (map (lambda (t) t::name) tests)))))
 
 	(let ((failed (filter-tests 'FAIL))
 	      (xfailed (filter-tests 'XFAIL))
 	      (xpassed (filter-tests 'XPASS))
 	      (skipped (filter-tests 'SKIP)))
           (echo "===================")
 	  (echo (length procs) "tests run,"
 		(length (filter-tests 'PASS)) "succeeded,"
 		(length failed) "failed,"
 		(length xfailed) "failed expectedly,"
 		(length xpassed) "succeeded unexpectedly,"
 		(length skipped) "skipped.")
 	  (print-tests failed "Failed tests:")
 	  (print-tests xfailed "Expectedly failed tests:")
 	  (print-tests xpassed "Unexpectedly passed tests:")
 	  (print-tests skipped "Skipped tests:")
           (echo "===================")
 	  (+ (length failed) (length xpassed))))
 
       (define (xml)
 	(xx::document
 	 (xx::tag 'testsuites
 		  `((xmlns:xsi "http://www.w3.org/2001/XMLSchema-instance")
 		    ("xsi:noNamespaceSchemaLocation"
 		     "https://windyroad.com.au/dl/Open%20Source/JUnit.xsd"))
 		  (map (lambda (t) (t::xml)) procs))))))))
 
 (define (verbosity n)
   (if (= 0 n) '() (cons '--verbose (verbosity (- n 1)))))
 
 (define (locate-test path)
   (if (absolute-path? path) path (in-srcdir path)))
 
 ;; A single test.
 (define test
  (begin
 
   ;; Private definitions.
 
   (define (isotime->junit t)
     "[0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}"
     "20170418T145809"
     (string-append (substring t 0 4)
 		   "-"
 		   (substring t 4 6)
 		   "-"
 		   (substring t 6 11)
 		   ":"
 		   (substring t 11 13)
 		   ":"
 		   (substring t 13 15)))
 
   ;; If a tests name ends with a bang (!), it is expected to fail.
   (define (expect-failure? name)
     (string-suffix? name "!"))
   ;; Strips the bang (if any).
   (define (test-name name)
     (if (expect-failure? name)
 	(substring name 0 (- (string-length name) 1))
 	name))
 
   (package
-   (define (scm setup name path . args)
+   (define (scm setup variant name path . args)
      ;; Start the process.
      (define (spawn-scm args' in out err)
        (spawn-process-fd `(,*argv0* ,@(verbosity (*verbose*))
 				    ,(locate-test (test-name path))
 				    ,@(if setup (force setup) '())
 				    ,@args' ,@args) in out err))
-     (new name #f spawn-scm #f #f CLOSED_FD (expect-failure? name)))
+     (new variant name #f spawn-scm #f #f CLOSED_FD (expect-failure? name)))
 
    (define (binary setup name path . args)
      ;; Start the process.
      (define (spawn-binary args' in out err)
        (spawn-process-fd `(,(test-name path)
 			   ,@(if setup (force setup) '()) ,@args' ,@args)
 			 in out err))
-     (new name #f spawn-binary #f #f CLOSED_FD (expect-failure? name)))
+     (new #f name #f spawn-binary #f #f CLOSED_FD (expect-failure? name)))
 
-   (define (new name directory spawn pid retcode logfd expect-failure)
+   (define (new variant name directory spawn pid retcode logfd expect-failure)
      (package
 
       ;; XXX: OO glue.
       (define self (current-environment))
       (define (:set! key value)
 	(eval `(set! ,key ,value) (current-environment))
 	(current-environment))
 
       ;; The log is written here.
       (define log-file-name #f)
 
       ;; Record time stamps.
       (define timestamp #f)
       (define start-time 0)
       (define end-time 0)
 
       (define (set-start-time!)
 	(set! timestamp (isotime->junit (get-isotime)))
 	(set! start-time (get-time)))
       (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 (path-join
 			       (getenv "objdir")
-			       (string-append name ".log"))))
+			       (if variant
+				   (string-append name "." variant ".log")
+				   (string-append name ".log")))))
 	(catch '() (unlink log-file-name))
 	(open log-file-name (logior O_RDWR O_BINARY O_CREAT) #o600))
 
       (define (run-sync . args)
 	(set-start-time!)
 	(letfd ((log (open-log-file)))
 	  (with-working-directory directory
 	    (let* ((p (inbound-pipe))
 		   (pid' (spawn args 0 (:write-end p) (:write-end p))))
 	      (close (:write-end p))
 	      (splice (:read-end p) STDERR_FILENO log)
 	      (close (:read-end p))
 	      (set! pid pid')
 	      (set! retcode (wait-process name pid' #t)))))
 	(report)
 	(current-environment))
       (define (run-sync-quiet . args)
 	(set-start-time!)
 	(with-working-directory directory
 	  (set! pid (spawn args CLOSED_FD CLOSED_FD CLOSED_FD)))
 	(set! retcode (wait-process name pid #t))
 	(set-end-time!)
 	(current-environment))
       (define (run-async . args)
 	(set-start-time!)
 	(let ((log (open-log-file)))
 	  (with-working-directory directory
 	    (set! pid (spawn args CLOSED_FD log log)))
 	  (set! logfd log))
 	(current-environment))
       (define (status)
 	(let* ((t' (assoc retcode '((0 PASS) (77 SKIP) (99 ERROR))))
 	       (t (if (not t') 'FAIL (cadr t'))))
 	  (if expect-failure
 	      (case t ((PASS) 'XPASS) ((FAIL) 'XFAIL) (else t))
 	      t)))
       (define (status-string)
 	(cadr (assoc (status) '((PASS "PASS")
 			       (SKIP "SKIP")
 			       (ERROR "ERROR")
 			       (FAIL "FAIL")
 			       (XPASS "XPASS")
 			       (XFAIL "XFAIL")))))
       (define (report)
 	(unless (= logfd CLOSED_FD)
 		(seek logfd 0 SEEK_SET)
 		(splice logfd STDERR_FILENO)
 		(close logfd))
-	(echo (string-append (status-string) ":") name))
+	(echo (string-append (status-string) ":")
+	      (if variant
+		  (string-append "<" variant ">" name)
+		  name)))
 
       (define (xml)
 	(xx::tag
 	 'testsuite
 	 `((name ,name)
 	   (time ,(- end-time start-time))
 	   (package ,(dirname name))
 	   (id 0)
 	   (timestamp ,timestamp)
 	   (hostname "unknown")
 	   (tests 1)
 	   (failures ,(if (eq? FAIL (status)) 1 0))
 	   (errors ,(if (eq? ERROR (status)) 1 0)))
 	 (list
 	  (xx::tag 'properties)
 	  (xx::tag 'testcase
 		   `((name ,(basename name))
 		     (classname ,(string-translate (dirname name) "/" "."))
 		     (time ,(- end-time start-time)))
 		   `(,@(case (status)
 			 ((PASS XFAIL) '())
 			 ((SKIP) (list (xx::tag 'skipped)))
 			 ((ERROR) (list
 				   (xx::tag 'error '((message "Unknown error.")))))
 			 (else
 			  (list (xx::tag 'failure '((message "Unknown error."))))))))
 	  (xx::tag 'system-out '()
 		   (list (xx::textnode (read-all (open-input-file log-file-name)))))
 	  (xx::tag 'system-err '() (list (xx::textnode "")))))))))))
 
 ;; Run the setup target to create an environment, then run all given
 ;; tests in parallel.
 (define (run-tests-parallel tests n)
   (let loop ((pool (test-pool::new n)) (tests' tests))
     (if (null? tests')
 	(let ((results (pool::wait)))
 	  ((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)
 		(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 1)) (tests' tests))
     (if (null? tests')
 	(let ((results (pool::wait)))
 	  ((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-sync))
 		(cdr tests'))))))
 
 ;; Run tests either in sequence or in parallel, depending on the
 ;; number of tests and the command line flags.
 (define (run-tests 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)
   (load (apply in-srcdir `(,@path "all-tests.scm")))
   all-tests)
 
 ;; Helper to create environment caches from test functions.  SETUP
 ;; must be a test implementing the producer side cache protocol.
 ;; Returns a promise containing the arguments that must be passed to a
 ;; test implementing the consumer side of the cache protocol.
 (define (make-environment-cache setup)
   (delay (with-temporary-working-directory
 	  (let ((tarball (make-temporary-file "environment-cache")))
 	    (atexit (lambda () (remove-temporary-file tarball)))
 	    (setup::run-sync '--create-tarball tarball)
 	    (if (not (equal? 'PASS (setup::status)))
 		(fail "Setup failed."))
 	    `(--unpack-tarball ,tarball)))))
 
 ;; Command line flag handling.  Returns the elements following KEY in
 ;; ARGUMENTS up to the next argument, or #f if KEY is not in
 ;; ARGUMENTS.  If 'KEY=XYZ' is encountered, then the singleton list
 ;; containing 'XYZ' is returned.
 (define (flag key arguments)
   (cond
    ((null? arguments)
     #f)
    ((string=? key (car arguments))
     (let loop ((acc '())
 	       (args (cdr arguments)))
       (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
     (flag key (cdr arguments)))))
 (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")))
 (assert (equal? (flag "--" '("--" "xxx" "yyy" "--" "zzz")) '("xxx" "yyy")))
diff --git a/tests/gpgsm/all-tests.scm b/tests/gpgsm/all-tests.scm
index 1baa92468..80599b7cb 100644
--- a/tests/gpgsm/all-tests.scm
+++ b/tests/gpgsm/all-tests.scm
@@ -1,43 +1,45 @@
 ;; Copyright (C) 2017 g10 Code GmbH
 ;;
 ;; This file is part of GnuPG.
 ;;
 ;; GnuPG is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 3 of the License, or
 ;; (at your option) any later version.
 ;;
 ;; GnuPG is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;;
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program; if not, see <http://www.gnu.org/licenses/>.
 
 (export all-tests
  ;; Parse the Makefile.am to find all tests.
 
  (load (with-path "makefile.scm"))
 
  (define (expander filename port key)
    (parse-makefile port key))
 
  (define (parse filename key)
    (parse-makefile-expand filename expander key))
 
  (define setup
    (make-environment-cache
     (test::scm
+     #f
      #f
      (path-join "tests" "gpgsm" "setup.scm")
      (in-srcdir "tests" "gpgsm" "setup.scm")
      "--" "tests" "gpg")))
 
  (map (lambda (name)
 	(test::scm setup
+                   #f
 		   (path-join "tests" "gpgsm" name)
 		   (in-srcdir "tests" "gpgsm" name)))
       (parse-makefile-expand (in-srcdir "tests" "gpgsm" "Makefile.am")
 			     (lambda (filename port key) (parse-makefile port key))
 			     "XTESTS")))
diff --git a/tests/gpgsm/run-tests.scm b/tests/gpgsm/run-tests.scm
index 6b460b165..014520eec 100644
--- a/tests/gpgsm/run-tests.scm
+++ b/tests/gpgsm/run-tests.scm
@@ -1,39 +1,41 @@
 ;; Test-suite runner.
 ;;
 ;; Copyright (C) 2016 g10 Code GmbH
 ;;
 ;; This file is part of GnuPG.
 ;;
 ;; GnuPG is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 3 of the License, or
 ;; (at your option) any later version.
 ;;
 ;; GnuPG is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;;
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program; if not, see <http://www.gnu.org/licenses/>.
 
 (if (string=? "" (getenv "abs_top_srcdir"))
     (begin
       (echo "Environment variable 'abs_top_srcdir' not set.  Please point it to"
 	    "tests/gpgsm.")
       (exit 2)))
 
 (define tests (filter (lambda (arg) (not (string-prefix? arg "--"))) *args*))
 
 (define setup
   (make-environment-cache (test::scm
+			   #f
 			   #f
 			   (path-join "tests" "gpgsm" "setup.scm")
 			   (in-srcdir "tests" "gpgsm" "setup.scm"))))
 
 (run-tests (if (null? tests)
 	       (load-tests "tests" "gpgsm")
 	       (map (lambda (name)
 		      (test::scm setup
+			         #f
 				 (path-join "tests" "gpgsm" name)
 				 (in-srcdir "tests" "gpgsm" name))) tests)))
diff --git a/tests/migrations/all-tests.scm b/tests/migrations/all-tests.scm
index 421f69679..ba95f5c50 100644
--- a/tests/migrations/all-tests.scm
+++ b/tests/migrations/all-tests.scm
@@ -1,35 +1,36 @@
 ;; Copyright (C) 2017 g10 Code GmbH
 ;;
 ;; This file is part of GnuPG.
 ;;
 ;; GnuPG is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 3 of the License, or
 ;; (at your option) any later version.
 ;;
 ;; GnuPG is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;;
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program; if not, see <http://www.gnu.org/licenses/>.
 
 (export all-tests
  ;; Parse the Makefile.am to find all tests.
 
  (load (with-path "makefile.scm"))
 
  (define (expander filename port key)
    (parse-makefile port key))
 
  (define (parse filename key)
    (parse-makefile-expand filename expander key))
 
  (map (lambda (name)
 	(test::scm #f
+		   #f
 		   (path-join "tests" "migrations" name)
 		   (in-srcdir "tests" "migrations" name)))
       (parse-makefile-expand (in-srcdir "tests" "migrations" "Makefile.am")
 			     (lambda (filename port key) (parse-makefile port key))
 			     "XTESTS")))
diff --git a/tests/migrations/run-tests.scm b/tests/migrations/run-tests.scm
index f44334c7d..d4db14f56 100644
--- a/tests/migrations/run-tests.scm
+++ b/tests/migrations/run-tests.scm
@@ -1,27 +1,28 @@
 ;; Test-suite runner.
 ;;
 ;; Copyright (C) 2016 g10 Code GmbH
 ;;
 ;; This file is part of GnuPG.
 ;;
 ;; GnuPG is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 3 of the License, or
 ;; (at your option) any later version.
 ;;
 ;; GnuPG is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;;
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program; if not, see <http://www.gnu.org/licenses/>.
 
 (define tests (filter (lambda (arg) (not (string-prefix? arg "--"))) *args*))
 
 (run-tests (if (null? tests)
 	       (load-tests "tests" "migrations")
 	       (map (lambda (name)
 		      (test::scm #f
+			         #f
 				 (path-join "tests" "migrations" name)
 				 (in-srcdir "tests" "migrations" name))) tests)))
diff --git a/tests/openpgp/all-tests.scm b/tests/openpgp/all-tests.scm
index d687fe49b..7d36d8ddb 100644
--- a/tests/openpgp/all-tests.scm
+++ b/tests/openpgp/all-tests.scm
@@ -1,78 +1,81 @@
 ;; Copyright (C) 2017 g10 Code GmbH
 ;;
 ;; This file is part of GnuPG.
 ;;
 ;; GnuPG is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 3 of the License, or
 ;; (at your option) any later version.
 ;;
 ;; GnuPG is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;;
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program; if not, see <http://www.gnu.org/licenses/>.
 
 (export all-tests
  ;; Parse the Makefile.am to find all tests.
 
  (load (with-path "makefile.scm"))
 
  (define (expander filename port key)
    (parse-makefile port key))
 
  (define (parse filename key)
    (parse-makefile-expand filename expander key))
 
  (define setup
    (make-environment-cache
     (test::scm
+     #f
      #f
      (path-join "tests" "openpgp" "setup.scm")
      (in-srcdir "tests" "openpgp" "setup.scm"))))
 
  (define (qualify path variant)
    (string-append "<" variant ">" path))
 
  (define (setup* variant)
    (make-environment-cache
     (test::scm
      #f
-     (qualify (path-join "tests" "openpgp" "setup.scm") variant)
+     variant
+     (path-join "tests" "openpgp" "setup.scm")
      (in-srcdir "tests" "openpgp" "setup.scm")
      (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")
 			  (lambda (filename port key) (parse-makefile port key))
 			  "XTESTS"))
 
  (define tests
    (map (lambda (name)
 	  (test::scm setup
+                     #f
 		     (path-join "tests" "openpgp" name)
 		     (in-srcdir "tests" "openpgp" name))) all-tests))
 
  (when *run-all-tests*
        (set! tests
 	     (append
 	      tests
 	      (map (lambda (name)
 		     (test::scm setup-use-keyring
-				(qualify (path-join "tests" "openpgp" name)
-					 "use-keyring")
+				"use-keyring"
+				(path-join "tests" "openpgp" name)
 				(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")
+				"extended-key-format"
+				(path-join "tests" "openpgp" name)
 				(in-srcdir "tests" "openpgp" name)
 				"--extended-key-format")) all-tests))))
 
  tests)
diff --git a/tests/openpgp/run-tests.scm b/tests/openpgp/run-tests.scm
index d4914bda7..264331089 100644
--- a/tests/openpgp/run-tests.scm
+++ b/tests/openpgp/run-tests.scm
@@ -1,42 +1,44 @@
 ;; Test-suite runner.
 ;;
 ;; Copyright (C) 2016 g10 Code GmbH
 ;;
 ;; This file is part of GnuPG.
 ;;
 ;; GnuPG is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 3 of the License, or
 ;; (at your option) any later version.
 ;;
 ;; GnuPG is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 ;;
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program; if not, see <http://www.gnu.org/licenses/>.
 
 (if (string=? "" (getenv "abs_top_srcdir"))
     (begin
       (echo "Environment variable 'abs_top_srcdir' not set.  Please point it to"
 	    "tests/openpgp.")
       (exit 2)))
 
 ;; Set objdir so that the tests can locate built programs.
 (setenv "objdir" (getcwd) #f)
 
 (define setup
   (make-environment-cache (test::scm
+			   #f
 			   #f
 			   (path-join "tests" "openpgp" "setup.scm")
 			   (in-srcdir "tests" "openpgp" "setup.scm"))))
 
 (define tests (filter (lambda (arg) (not (string-prefix? arg "--"))) *args*))
 
 (run-tests (if (null? tests)
 	       (load-tests "tests" "openpgp")
 	       (map (lambda (name)
 		      (test::scm setup
+			         #f
 				 (path-join "tests" "openpgp" name)
 				 (in-srcdir "tests" "openpgp" name))) tests)))