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.
This commit is contained in:
parent
e903b7c1a8
commit
f84f859093
|
@ -27,6 +27,7 @@
|
||||||
#:use-module (guix config)
|
#:use-module (guix config)
|
||||||
#:use-module (guix base32)
|
#:use-module (guix base32)
|
||||||
#:use-module ((guix store) #:select (%store-prefix))
|
#: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 ((guix build utils) #:select (delete-file-recursively))
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:use-module (rnrs io ports)
|
#:use-module (rnrs io ports)
|
||||||
|
@ -44,15 +45,21 @@
|
||||||
|
|
||||||
;;; XXX: Replace with 'test-error' from SRFI-64 as soon as it allow us to
|
;;; XXX: Replace with 'test-error' from SRFI-64 as soon as it allow us to
|
||||||
;;; catch specific exceptions.
|
;;; 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
|
(test-equal name
|
||||||
1
|
'(1 #t)
|
||||||
(catch 'quit
|
(let ((error-output (open-output-string)))
|
||||||
(lambda ()
|
(parameterize ((guix-warning-port error-output))
|
||||||
exp
|
(catch 'quit
|
||||||
#f)
|
(lambda ()
|
||||||
(lambda (key value)
|
exp
|
||||||
value))))
|
#f)
|
||||||
|
(lambda (key value)
|
||||||
|
(list value
|
||||||
|
(let ((message (get-output-string error-output)))
|
||||||
|
(->bool (string-match error-rx message))))))))))
|
||||||
|
|
||||||
(define %public-key
|
(define %public-key
|
||||||
;; This key is known to be in the ACL by default.
|
;; This key is known to be in the ACL by default.
|
||||||
|
@ -97,11 +104,13 @@ version identifier.."
|
||||||
|
|
||||||
(test-begin "substitute-binary")
|
(test-begin "substitute-binary")
|
||||||
|
|
||||||
(test-error* "not a number"
|
(test-quit "not a number"
|
||||||
|
"signature version"
|
||||||
(narinfo-signature->canonical-sexp
|
(narinfo-signature->canonical-sexp
|
||||||
(signature-field "foo" #:version "not a number")))
|
(signature-field "foo" #:version "not a number")))
|
||||||
|
|
||||||
(test-error* "wrong version number"
|
(test-quit "wrong version number"
|
||||||
|
"unsupported.*version"
|
||||||
(narinfo-signature->canonical-sexp
|
(narinfo-signature->canonical-sexp
|
||||||
(signature-field "foo" #:version "2")))
|
(signature-field "foo" #:version "2")))
|
||||||
|
|
||||||
|
@ -255,14 +264,16 @@ a file for NARINFO."
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(guix-substitute-binary "--query"))))))))
|
(guix-substitute-binary "--query"))))))))
|
||||||
|
|
||||||
(test-error* "substitute, no signature"
|
(test-quit "substitute, no signature"
|
||||||
|
"lacks a signature"
|
||||||
(with-narinfo %narinfo
|
(with-narinfo %narinfo
|
||||||
(guix-substitute-binary "--substitute"
|
(guix-substitute-binary "--substitute"
|
||||||
(string-append (%store-prefix)
|
(string-append (%store-prefix)
|
||||||
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
|
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
|
||||||
"foo")))
|
"foo")))
|
||||||
|
|
||||||
(test-error* "substitute, invalid hash"
|
(test-quit "substitute, invalid hash"
|
||||||
|
"hash"
|
||||||
;; The hash in the signature differs from the hash of %NARINFO.
|
;; The hash in the signature differs from the hash of %NARINFO.
|
||||||
(with-narinfo (string-append %narinfo "Signature: "
|
(with-narinfo (string-append %narinfo "Signature: "
|
||||||
(signature-field "different body")
|
(signature-field "different body")
|
||||||
|
@ -272,7 +283,8 @@ a file for NARINFO."
|
||||||
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
|
"/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo")
|
||||||
"foo")))
|
"foo")))
|
||||||
|
|
||||||
(test-error* "substitute, unauthorized key"
|
(test-quit "substitute, unauthorized key"
|
||||||
|
"unauthorized"
|
||||||
(with-narinfo (string-append %narinfo "Signature: "
|
(with-narinfo (string-append %narinfo "Signature: "
|
||||||
(signature-field
|
(signature-field
|
||||||
%narinfo
|
%narinfo
|
||||||
|
@ -306,5 +318,5 @@ a file for NARINFO."
|
||||||
;;; Local Variables:
|
;;; Local Variables:
|
||||||
;;; eval: (put 'with-narinfo 'scheme-indent-function 1)
|
;;; eval: (put 'with-narinfo 'scheme-indent-function 1)
|
||||||
;;; eval: (put 'test-error-condition 'scheme-indent-function 3)
|
;;; 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:
|
;;; End:
|
||||||
|
|
Loading…
Reference in New Issue