aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-03-30 22:25:47 +0200
committerLudovic Courtès <ludo@gnu.org>2014-03-30 22:32:16 +0200
commitf84f8590938e3cbcef10a51dda87f99c6c3b8b54 (patch)
tree7e2f12bb5267463e05f107d5b9efe4752fbbad58
parente903b7c1a8cc4d96653f9dd12b9b8c05a3e01bd1 (diff)
downloadguix-f84f8590938e3cbcef10a51dda87f99c6c3b8b54.tar
guix-f84f8590938e3cbcef10a51dda87f99c6c3b8b54.tar.gz
tests: Test the error output of 'substitute-binary'.
* tests/substitute-binary.scm (test-error*): Rename to... (test-quit): ... this. Add 'error-rx' parameter and honor it. ("not a number", "wrong version number", "substitute, no signature", "substitute, invalid hash", "substitute, unauthorized key"): Adjust accordingly.
-rw-r--r--tests/substitute-binary.scm40
1 files changed, 26 insertions, 14 deletions
diff --git a/tests/substitute-binary.scm b/tests/substitute-binary.scm
index 475d27c846..917a0cd55c 100644
--- a/tests/substitute-binary.scm
+++ b/tests/substitute-binary.scm
@@ -27,6 +27,7 @@
#:use-module (guix config)
#:use-module (guix base32)
#:use-module ((guix store) #:select (%store-prefix))
+ #:use-module ((guix ui) #:select (guix-warning-port))
#:use-module ((guix build utils) #:select (delete-file-recursively))
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
@@ -44,15 +45,21 @@
;;; XXX: Replace with 'test-error' from SRFI-64 as soon as it allow us to
;;; catch specific exceptions.
-(define-syntax-rule (test-error* name exp)
+(define-syntax-rule (test-quit name error-rx exp)
+ "Emit a test that passes when EXP throws to 'quit' with value 1, and when
+it writes to GUIX-WARNING-PORT a messages that matches ERROR-RX."
(test-equal name
- 1
- (catch 'quit
- (lambda ()
- exp
- #f)
- (lambda (key value)
- value))))
+ '(1 #t)
+ (let ((error-output (open-output-string)))
+ (parameterize ((guix-warning-port error-output))
+ (catch 'quit
+ (lambda ()
+ exp
+ #f)
+ (lambda (key value)
+ (list value
+ (let ((message (get-output-string error-output)))
+ (->bool (string-match error-rx message))))))))))
(define %public-key
;; This key is known to be in the ACL by default.
@@ -97,11 +104,13 @@ version identifier.."
(test-begin "substitute-binary")
-(test-error* "not a number"
+(test-quit "not a number"
+ "signature version"
(narinfo-signature->canonical-sexp
(signature-field "foo" #:version "not a number")))
-(test-error* "wrong version number"
+(test-quit "wrong version number"
+ "unsupported.*version"
(narinfo-signature->canonical-sexp
(signature-field "foo" #:version "2")))
@@ -255,14 +264,16 @@ a file for NARINFO."
(lambda ()
(guix-substitute-binary "--query"))))))))
-(test-error* "substitute, no signature"
+(test-quit "substitute, no signature"
+ "lacks a signature"
(with-narinfo %narinfo
(guix-substitute-binary "--substitute"
(string-append (%store-prefix)
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
"foo")))
-(test-error* "substitute, invalid hash"
+(test-quit "substitute, invalid hash"
+ "hash"
;; The hash in the signature differs from the hash of %NARINFO.
(with-narinfo (string-append %narinfo "Signature: "
(signature-field "different body")
@@ -272,7 +283,8 @@ a file for NARINFO."
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
"foo")))
-(test-error* "substitute, unauthorized key"
+(test-quit "substitute, unauthorized key"
+ "unauthorized"
(with-narinfo (string-append %narinfo "Signature: "
(signature-field
%narinfo
@@ -306,5 +318,5 @@ a file for NARINFO."
;;; Local Variables:
;;; eval: (put 'with-narinfo 'scheme-indent-function 1)
;;; eval: (put 'test-error-condition 'scheme-indent-function 3)
-;;; eval: (put 'test-error* 'scheme-indent-function 1)
+;;; eval: (put 'test-quit 'scheme-indent-function 2)
;;; End: