ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 22:08:16 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

tests: Test the error output of 'substitute-binary'.

Browse source 
* 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:
Ludovic Courtès 2014-03-30 22:25:47 +02:00
parent e903b7c1a8
commit f84f859093
1 changed files with 26 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
tests/substitute-binary.scm
View file

@ -27,6 +27,7 @@ (define-module (test-substitute-binary)
#: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 @@ (define assert-valid-signature
;;; 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)
(let ((error-output (open-output-string)))
(parameterize ((guix-warning-port error-output))
(catch 'quit (catch 'quit
(lambda () (lambda ()
exp exp
#f) #f)
(lambda (key value) (lambda (key value)
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 @@ (define* (signature-field bv-or-str
(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 @@ (define-syntax-rule (with-narinfo narinfo body ...)
(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 @@ (define-syntax-rule (with-narinfo narinfo body ...)
"/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 @@ (define-syntax-rule (with-narinfo narinfo body ...)
;;; 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: