mirror of
git://git.gnupg.org/gnupg.git
synced 2025-01-21 14:47:03 +01:00
gpgscm: Improve test framework.
* tests/gpgscm/lib.scm (echo): Move... * tests/gpgscm/tests.scm (echo): ... here. (info, error, skip): And use echo here. (file-exists?): New function. (tr:spawn): Check that source exists and if the sink has been created. (tr:call-with-content): Hand in optional arguments. Signed-off-by: Justus Winter <justus@g10code.com>
This commit is contained in:
parent
5fbbc4b334
commit
65081c31e7
@ -120,10 +120,6 @@
|
||||
(assert (string-contains? "Hallo" "llo"))
|
||||
(assert (not (string-contains? "Hallo" "olla")))
|
||||
|
||||
(define (echo . msg)
|
||||
(for-each (lambda (x) (display x) (display " ")) msg)
|
||||
(newline))
|
||||
|
||||
;; Read a word from port P.
|
||||
(define (read-word . p)
|
||||
(list->string
|
||||
|
@ -30,17 +30,20 @@
|
||||
(get-output-string p)))
|
||||
|
||||
;; Reporting.
|
||||
(define (info msg)
|
||||
(display msg)
|
||||
(newline)
|
||||
(define (echo . msg)
|
||||
(for-each (lambda (x) (display x) (display " ")) msg)
|
||||
(newline))
|
||||
|
||||
(define (info . msg)
|
||||
(apply echo msg)
|
||||
(flush-stdio))
|
||||
|
||||
(define (error msg)
|
||||
(info msg)
|
||||
(define (error . msg)
|
||||
(apply info msg)
|
||||
(exit 1))
|
||||
|
||||
(define (skip msg)
|
||||
(info msg)
|
||||
(define (skip . msg)
|
||||
(apply info msg)
|
||||
(exit 77))
|
||||
|
||||
(define (make-counter)
|
||||
@ -136,6 +139,9 @@
|
||||
;;
|
||||
;; File management.
|
||||
;;
|
||||
(define (file-exists? name)
|
||||
(call-with-input-file name (lambda (port) #t)))
|
||||
|
||||
(define (file=? a b)
|
||||
(file-equal a b #t))
|
||||
|
||||
@ -361,6 +367,8 @@
|
||||
|
||||
(define (tr:spawn input command)
|
||||
(lambda (tmpfiles source)
|
||||
(if (and (member '**in** command) (not source))
|
||||
(error (string-append (stringify cmd) " needs an input")))
|
||||
(let* ((t (make-temporary-file))
|
||||
(cmd (map (lambda (x)
|
||||
(cond
|
||||
@ -368,6 +376,8 @@
|
||||
((equal? '**out** x) t)
|
||||
(else x))) command)))
|
||||
(call-popen cmd input)
|
||||
(if (and (member '**out** command) (not (file-exists? t)))
|
||||
(error (string-append (stringify cmd) " did not produce '" t "'.")))
|
||||
(list (cons t tmpfiles) t))))
|
||||
|
||||
(define (tr:write-to pathname)
|
||||
@ -396,7 +406,7 @@
|
||||
(error "mismatch"))
|
||||
(list tmpfiles source)))
|
||||
|
||||
(define (tr:call-with-content function)
|
||||
(define (tr:call-with-content function . args)
|
||||
(lambda (tmpfiles source)
|
||||
(function (call-with-input-file source read-all))
|
||||
(apply function `(,(call-with-input-file source read-all) ,@args))
|
||||
(list tmpfiles source)))
|
||||
|
Loading…
x
Reference in New Issue
Block a user