security-and-privacy/gnupg
security-and-privacy/gnupg
1
0
Fork 0
mirror of git://git.gnupg.org/gnupg.git synced 2024-12-22 10:19:57 +01:00
Code Activity

gpgscm: Make the verbose setting more useful.

Browse Source 
* tests/gpgscm/ffi.c (do_get_verbose): New function.
(do_set_verbose): Likewise.
(ffi_init): Turn *verbose* into a function, add *set-verbose!*.
* tests/gpgscm/tests.scm (call): Adapt accordingly.
(call-with-io): Dump output if *verbose* is high.
(pipe-do): Adapt accordingly.
* tests/openpgp/defs.scm: Set verbosity according to environment.
* tests/openpgp/run-tests.scm (test): Adapt accordingly.

Signed-off-by: Justus Winter <justus@g10code.com>
This commit is contained in:
Justus Winter 2016-07-26 15:53:50 +02:00
parent b3610badf6
commit f17aecbcd9
4 changed files with 39 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
tests/gpgscm/ffi.c
View File

@ -1051,6 +1051,30 @@ do_glob (scheme *sc, pointer args)
FFI_RETURN_POINTER (sc, result);
}
static pointer
do_get_verbose (scheme *sc, pointer args)
{
FFI_PROLOG ();
FFI_ARGS_DONE_OR_RETURN (sc, args);
FFI_RETURN_INT (sc, verbose);
}
static pointer
do_set_verbose (scheme *sc, pointer args)
{
FFI_PROLOG ();
int new_verbosity, old;
FFI_ARG_OR_RETURN (sc, int, new_verbosity, number, args);
FFI_ARGS_DONE_OR_RETURN (sc, args);
old = verbose;
verbose = new_verbosity;
FFI_RETURN_INT (sc, old);
}
gpg_error_t
ffi_list2argv (scheme *sc, pointer list, char ***argv, size_t *len)
@ -1260,7 +1284,8 @@ ffi_init (scheme *sc, const char *argv0, int argc, const char **argv)
ffi_define_function (sc, prompt);
/* Configuration. */
ffi_define (sc, "*verbose*", sc->vptr->mk_integer (sc, verbose));
ffi_define_function_name (sc, "*verbose*", get_verbose);
ffi_define_function_name (sc, "*set-verbose!*", set_verbose);
ffi_define (sc, "*argv0*", sc->vptr->mk_string (sc, argv0));
for (i = argc - 1; i >= 0; i--)

11
tests/gpgscm/tests.scm
View File

@ -92,8 +92,8 @@
(define (call what)
(call-with-fds what
CLOSED_FD
(if (< *verbose* 0) STDOUT_FILENO CLOSED_FD)
(if (< *verbose* 0) STDERR_FILENO 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)
@ -110,6 +110,11 @@
(result (wait-process (car what) (:pid h) #t)))
(es-fclose (:stdout h))
(es-fclose (:stderr h))
(if (> (*verbose*) 2)
(begin
(echo (stringify what) "returned:" result)
(echo (stringify what) "wrote to stdout:" out)
(echo (stringify what) "wrote to stderr:" err)))
(list result out err))))
;; Accessor function for the results of 'call-with-io'. ':stdout' and
@ -360,7 +365,7 @@
(lambda (M)
(define (do-spawn M new-source)
(let ((pid (spawn-process-fd command M::source M::sink
(if (> *verbose* 0)
(if (> (*verbose*) 0)
STDERR_FILENO CLOSED_FD)))
(M' (M::set-source new-source)))
(M'::add-proc command pid)))

4
tests/openpgp/defs.scm
View File

@ -132,3 +132,7 @@
(list (string->number (cadr p)) (caddr p))))
(string-split
(call-popen `(,@GPG --with-colons ,@args) input) #\newline)))
(let ((verbose (string->number (getenv "verbose"))))
(if (number? verbose)
(*set-verbose!* verbose)))

2
tests/openpgp/run-tests.scm
View File

@ -72,7 +72,7 @@
(define test
(package
(define (scm name . args)
(new name #f `(,*argv0* ,@(verbosity *verbose*) ,@args
(new name #f `(,*argv0* ,@(verbosity (*verbose*)) ,@args
,(in-srcdir name)) #f #f))
(define (new name directory command pid retcode)
(package