[Pkg-gnupg-commit] [gnupg2] 30/160: gpgscm: Improve test framework.
Daniel Kahn Gillmor
dkg at fifthhorseman.net
Fri Jul 15 09:36:33 UTC 2016
This is an automated email from the git hooks/post-receive script.
dkg pushed a commit to branch upstream
in repository gnupg2.
commit 65081c31e7536d8fb5effcc2c9aeeffc120c9a69
Author: Justus Winter <justus at g10code.com>
Date: Tue Jun 21 12:21:10 2016 +0200
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 at g10code.com>
---
tests/gpgscm/lib.scm | 4 ----
tests/gpgscm/tests.scm | 28 +++++++++++++++++++---------
2 files changed, 19 insertions(+), 13 deletions(-)
diff --git a/tests/gpgscm/lib.scm b/tests/gpgscm/lib.scm
index 48f53ea..e23977a 100644
--- a/tests/gpgscm/lib.scm
+++ b/tests/gpgscm/lib.scm
@@ -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
diff --git a/tests/gpgscm/tests.scm b/tests/gpgscm/tests.scm
index 7e20c34..6d70dca 100644
--- a/tests/gpgscm/tests.scm
+++ b/tests/gpgscm/tests.scm
@@ -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) , at args))
(list tmpfiles source)))
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-gnupg/gnupg2.git
More information about the Pkg-gnupg-commit
mailing list