tests: Rename 'error' to 'fail'.

* tests/gpgscm/tests.scm (error): Rename to 'fail'.  'error' is a
primitive function (an opcode) of the TinySCHEME vm, and 'error' is
also defined by R6RS.  Better avoid redefining that.  Fix all call
sites.
* tests/openpgp/4gb-packet.scm: Adapt.
* tests/openpgp/decrypt-multifile.scm: Likewise.
* tests/openpgp/ecc.scm: Likewise.
* tests/openpgp/export.scm: Likewise.
* tests/openpgp/gpgtar.scm: Likewise.
* tests/openpgp/gpgv-forged-keyring.scm: Likewise.
* tests/openpgp/import.scm: Likewise.
* tests/openpgp/issue2015.scm: Likewise.
* tests/openpgp/issue2346.scm: Likewise.
* tests/openpgp/issue2419.scm: Likewise.
* tests/openpgp/key-selection.scm: Likewise.
* tests/openpgp/mds.scm: Likewise.
* tests/openpgp/multisig.scm: Likewise.
* tests/openpgp/setup.scm: Likewise.
* tests/openpgp/signencrypt.scm: Likewise.
* tests/openpgp/ssh-import.scm: Likewise.
* tests/openpgp/tofu.scm: Likewise.
* tests/openpgp/verify.scm: Likewise.

Signed-off-by: Justus Winter <justus@g10code.com>
This commit is contained in:
Justus Winter 2016-12-06 15:21:30 +01:00
parent 89ac071eb4
commit 5b5d881f47
19 changed files with 38 additions and 38 deletions

View File

@ -42,7 +42,7 @@
(if (> (*verbose*) 0) (if (> (*verbose*) 0)
(apply info msg))) (apply info msg)))
(define (error . msg) (define (fail . msg)
(apply info msg) (apply info msg)
(exit 1)) (exit 1))
@ -325,7 +325,7 @@
(lettmp (sink) (lettmp (sink)
(transformer source sink) (transformer source sink)
(if (not (file=? source sink)) (if (not (file=? source sink))
(error "mismatch")))) (fail "mismatch"))))
;; ;;
;; Monadic pipe support. ;; Monadic pipe support.
@ -440,7 +440,7 @@
(define (tr:spawn input command) (define (tr:spawn input command)
(lambda (tmpfiles source) (lambda (tmpfiles source)
(if (and (member '**in** command) (not source)) (if (and (member '**in** command) (not source))
(error (string-append (stringify cmd) " needs an input"))) (fail (string-append (stringify cmd) " needs an input")))
(let* ((t (make-temporary-file)) (let* ((t (make-temporary-file))
(cmd (map (lambda (x) (cmd (map (lambda (x)
(cond (cond
@ -450,7 +450,7 @@
(catch (list (cons t tmpfiles) t *error*) (catch (list (cons t tmpfiles) t *error*)
(call-popen cmd input) (call-popen cmd input)
(if (and (member '**out** command) (not (file-exists? t))) (if (and (member '**out** command) (not (file-exists? t)))
(error (string-append (stringify cmd) (fail (string-append (stringify cmd)
" did not produce '" t "'."))) " did not produce '" t "'.")))
(list (cons t tmpfiles) t #f))))) (list (cons t tmpfiles) t #f)))))
@ -471,13 +471,13 @@
(define (tr:assert-identity reference) (define (tr:assert-identity reference)
(lambda (tmpfiles source) (lambda (tmpfiles source)
(if (not (file=? source reference)) (if (not (file=? source reference))
(error "mismatch")) (fail "mismatch"))
(list tmpfiles source #f))) (list tmpfiles source #f)))
(define (tr:assert-weak-identity reference) (define (tr:assert-weak-identity reference)
(lambda (tmpfiles source) (lambda (tmpfiles source)
(if (not (text-file=? source reference)) (if (not (text-file=? source reference))
(error "mismatch")) (fail "mismatch"))
(list tmpfiles source #f))) (list tmpfiles source #f)))
(define (tr:call-with-content function . args) (define (tr:call-with-content function . args)

View File

@ -25,4 +25,4 @@
(if (= 0 (call `(,@GPG --list-packets ,(in-srcdir "4gb-packet.asc")))) (if (= 0 (call `(,@GPG --list-packets ,(in-srcdir "4gb-packet.asc"))))
(info "Can parse 4GB packets.") (info "Can parse 4GB packets.")
(error "Failed to parse 4GB packet.")) (fail "Failed to parse 4GB packet."))

View File

@ -43,5 +43,5 @@
"Verifying files:" "Verifying files:"
(lambda (name) (lambda (name)
(unless (file=? (path-join my-wd name) name) (unless (file=? (path-join my-wd name) name)
(error "decrypted file differs"))) (fail "decrypted file differs")))
plain-files)) plain-files))

View File

@ -103,7 +103,7 @@ Ic1RdzgeCfosMF+l/zVRchcLKzenEQA=
x (lambda (p) (display (eval test (current-environment)) p))) x (lambda (p) (display (eval test (current-environment)) p)))
(call-check `(,(tool 'gpg) --verify ,x)) (call-check `(,(tool 'gpg) --verify ,x))
(call-check `(,(tool 'gpg) --output ,y ,x)) (call-check `(,(tool 'gpg) --output ,y ,x))
(unless (file=? y z) (error "mismatch")))) (unless (file=? y z) (fail "mismatch"))))
'(msg_opaque_signed_256 msg_opaque_signed_384 msg_opaque_signed_521))) '(msg_opaque_signed_256 msg_opaque_signed_384 msg_opaque_signed_521)))
;; ;;
@ -182,7 +182,7 @@ Rg==
(call-with-output-file (call-with-output-file
x (lambda (p) (display (eval test (current-environment)) p))) x (lambda (p) (display (eval test (current-environment)) p)))
(call-check `(,@GPG --yes --output ,y ,x)) (call-check `(,@GPG --yes --output ,y ,x))
(unless (file=? y z) (error "mismatch")))) (unless (file=? y z) (fail "mismatch"))))
'(msg_encrypted_256 msg_encrypted_384 msg_encrypted_521))) '(msg_encrypted_256 msg_encrypted_384 msg_encrypted_521)))
;; ;;

View File

@ -22,7 +22,7 @@
(define (check-for predicate lines message) (define (check-for predicate lines message)
(unless (any predicate lines) (unless (any predicate lines)
(error message))) (fail message)))
(define (check-exported-key dump keyid) (define (check-exported-key dump keyid)
(check-for (lambda (l) (check-for (lambda (l)
@ -68,7 +68,7 @@
(lambda (port) (lambda (port)
(unless (unless
(eof-object? (peek-char port)) (eof-object? (peek-char port))
(error (string-append (fail (string-append
"Expected all passphrases to be consumed, but found: " "Expected all passphrases to be consumed, but found: "
(read-all port))))))) (read-all port)))))))

View File

@ -43,7 +43,7 @@
(tr:call-with-content (tr:call-with-content
(lambda (c) (lambda (c)
(unless (all (lambda (f) (string-contains? c f)) testfiles) (unless (all (lambda (f) (string-contains? c f)) testfiles)
(error "some file(s) are missing from archive"))))) (fail "some file(s) are missing from archive")))))
(with-temporary-working-directory (with-temporary-working-directory
(call-check `(,(tool 'gpgtar) --gpg ,(tool 'gpg) --gpg-args ,gpgargs (call-check `(,(tool 'gpgtar) --gpg ,(tool 'gpg) --gpg-args ,gpgargs
@ -53,7 +53,7 @@
(for-each (for-each
(lambda (f) (unless (call-with-input-file f (lambda (x) #t)) (lambda (f) (unless (call-with-input-file f (lambda (x) #t))
(error (string-append "missing file: " f)))) (fail (string-append "missing file: " f))))
testfiles)))) testfiles))))
(info "Checking gpgtar without encryption") (info "Checking gpgtar without encryption")

View File

@ -64,5 +64,5 @@ N1Glbw1OJfP1q+QFPMPKoCsTYmZpuugq2b5gV/eH0Abvk2pG4Fo/YTDPHhec7Jk=
(pipe:do (pipe:do
(pipe:echo (eval armored-file (current-environment))) (pipe:echo (eval armored-file (current-environment)))
(pipe:spawn `(,@GPGV --keyring ,(in-srcdir "forged-keyring.gpg")))) (pipe:spawn `(,@GPGV --keyring ,(in-srcdir "forged-keyring.gpg"))))
(error "verification succeeded but should not"))) (fail "verification succeeded but should not")))
'(msg_signed_asc)) '(msg_signed_asc))

View File

@ -58,4 +58,4 @@
(string-contains? line ":4096:1:DDA252EBB8EBE1AF:"))) (string-contains? line ":4096:1:DDA252EBB8EBE1AF:")))
(string-split-newlines c)))) (string-split-newlines c))))
(unless (= 2 (length keys)) (unless (= 2 (length keys))
(error "Importing keys with long id collision failed")))))) (fail "Importing keys with long id collision failed"))))))

View File

@ -28,4 +28,4 @@
"GET_PASSPHRASE --no-ask some_id X X X"))) "GET_PASSPHRASE --no-ask some_id X X X")))
(unless (string=? (string-rtrim char-whitespace? response) (unless (string=? (string-rtrim char-whitespace? response)
"OK 736F6D655F70617373706872617365") "OK 736F6D655F70617373706872617365")
(error "Could not retrieve passphrase from cache:" response))) (fail "Could not retrieve passphrase from cache:" response)))

View File

@ -25,4 +25,4 @@
(info "Checking import statistics (issue2346)...") (info "Checking import statistics (issue2346)...")
(let ((status (call-popen `(,@GPG --status-fd=1 --import ,key) ""))) (let ((status (call-popen `(,@GPG --status-fd=1 --import ,key) "")))
(unless (string-contains? status "IMPORT_RES 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0") (unless (string-contains? status "IMPORT_RES 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0")
(error "Unexpected number of keys imported" status))) (fail "Unexpected number of keys imported" status)))

View File

@ -26,4 +26,4 @@
(dearmor (in-srcdir "samplemsgs/issue2419.asc") onebyte) (dearmor (in-srcdir "samplemsgs/issue2419.asc") onebyte)
(catch (assert (string-contains? (car *error*) "invalid packet")) (catch (assert (string-contains? (car *error*) "invalid packet"))
(call-popen `(,@GPG --list-packets ,onebyte) "") (call-popen `(,@GPG --list-packets ,onebyte) "")
(error "Expected an error but got none"))) (fail "Expected an error but got none")))

View File

@ -76,7 +76,7 @@
(display (call-popen `(,@gpg --locate-key ,mailbox) "")) (display (call-popen `(,@gpg --locate-key ,mailbox) ""))
(echo "This is the key we expected:") (echo "This is the key we expected:")
(display (call-popen `(,@gpg --list-keys ,expected) "")) (display (call-popen `(,@gpg --list-keys ,expected) ""))
(error "Expected" expected "but got" fpr))) (fail "Expected" expected "but got" fpr)))
(delete-keys set)) (delete-keys set))
(lambda (set) (lambda (set)
(length set)) (length set))

View File

@ -49,7 +49,7 @@
(define (test-hash hash ref) (define (test-hash hash ref)
(unless (eq? #f ref) (unless (eq? #f ref)
(if (not (string=? (:value hash) (:value ref))) (if (not (string=? (:value hash) (:value ref)))
(error "failed")))) (fail "failed"))))
;; Test whether the hashes computed over S match the REFERENCE set. ;; Test whether the hashes computed over S match the REFERENCE set.
(define (test-hashes msg s reference) (define (test-hashes msg s reference)

View File

@ -164,6 +164,6 @@ cnksIEkgY2FuJ3QgZG8gdGhhdAo=
(pipe:write-to file (logior O_WRONLY O_CREAT O_BINARY) #o600)) (pipe:write-to file (logior O_WRONLY O_CREAT O_BINARY) #o600))
(if (= 0 (call `(,@GPG --verify ,file))) (if (= 0 (call `(,@GPG --verify ,file)))
(error "Bad signature verified ok")))) (fail "Bad signature verified ok"))))
'(sig-1ls1ls-valid sig-ls-valid sig-1lsls-invalid '(sig-1ls1ls-valid sig-ls-valid sig-1lsls-invalid
sig-lsls-invalid sig-lss-invalid sig-slsl-invalid)) sig-lsls-invalid sig-lss-invalid sig-slsl-invalid))

View File

@ -20,7 +20,7 @@
(load (with-path "defs.scm")) (load (with-path "defs.scm"))
(unless (member "--create-tarball" *args*) (unless (member "--create-tarball" *args*)
(error "Usage: setup.scm --create-tarball <file>")) (fail "Usage: setup.scm --create-tarball <file>"))
(with-temporary-working-directory (with-temporary-working-directory
(setenv "GNUPGHOME" (getcwd) #t) (setenv "GNUPGHOME" (getcwd) #t)

View File

@ -37,4 +37,4 @@
usrpass1) usrpass1)
(if (not (string=? "4336AE2A528FAE091E73E59E325B588FEE795F9B" (if (not (string=? "4336AE2A528FAE091E73E59E325B588FEE795F9B"
(cadar (gpg-hash-string `(--print-md SHA1 ,tmp) "")))) (cadar (gpg-hash-string `(--print-md SHA1 ,tmp) ""))))
(error "bug537-test.data.asc: mismatch (bug 537)"))) (fail "bug537-test.data.asc: mismatch (bug 537)")))

View File

@ -22,7 +22,7 @@
(define GNUPGHOME (getenv "GNUPGHOME")) (define GNUPGHOME (getenv "GNUPGHOME"))
(if (string=? "" GNUPGHOME) (if (string=? "" GNUPGHOME)
(error "GNUPGHOME not set")) (fail "GNUPGHOME not set"))
(setenv "SSH_AUTH_SOCK" (setenv "SSH_AUTH_SOCK"
(call-check `(,(tool 'gpgconf) --null --list-dirs agent-ssh-socket)) (call-check `(,(tool 'gpgconf) --null --list-dirs agent-ssh-socket))
@ -51,7 +51,7 @@
(pipe:open file (logior O_RDONLY O_BINARY)) (pipe:open file (logior O_RDONLY O_BINARY))
(pipe:spawn `(,SSH-ADD -))) (pipe:spawn `(,SSH-ADD -)))
(unless (string-contains? (call-popen `(,SSH-ADD -l "-E" md5) "") hash) (unless (string-contains? (call-popen `(,SSH-ADD -l "-E" md5) "") hash)
(error "key not added")))) (fail "key not added"))))
car keys) car keys)
(info "Checking for issue2316...") (info "Checking for issue2316...")
@ -64,4 +64,4 @@
(unless (unless
(string-contains? (call-popen `(,SSH-ADD -l "-E" md5) "") (string-contains? (call-popen `(,SSH-ADD -l "-E" md5) "")
"c9:85:b5:55:00:84:a9:82:5a:df:d6:62:1b:5a:28:22") "c9:85:b5:55:00:84:a9:82:5a:df:d6:62:1b:5a:28:22")
(error "known private key not (re-)added to sshcontrol")) (fail "known private key not (re-)added to sshcontrol"))

View File

@ -25,7 +25,7 @@
--faked-system-time=1480943782)) --faked-system-time=1480943782))
(define GNUPGHOME (getenv "GNUPGHOME")) (define GNUPGHOME (getenv "GNUPGHOME"))
(if (string=? "" GNUPGHOME) (if (string=? "" GNUPGHOME)
(error "GNUPGHOME not set")) (fail "GNUPGHOME not set"))
(catch (skip "Tofu not supported") (catch (skip "Tofu not supported")
(call-check `(,@GPG --trust-model=tofu --list-config))) (call-check `(,@GPG --trust-model=tofu --list-config)))
@ -37,7 +37,7 @@
(call-check `(,@GPG --import (call-check `(,@GPG --import
,(in-srcdir "tofu/conflicting/" ,(in-srcdir "tofu/conflicting/"
(string-append keyid ".gpg")))) (string-append keyid ".gpg"))))
(catch (error "Missing key" keyid) (catch (fail "Missing key" keyid)
(call-check `(,@GPG --list-keys ,keyid)))) (call-check `(,@GPG --list-keys ,keyid))))
KEYS) KEYS)
@ -52,7 +52,7 @@
,@args ,@args
--list-keys ,keyid))) 5))) --list-keys ,keyid))) 5)))
(unless (member policy '("auto" "good" "unknown" "bad" "ask")) (unless (member policy '("auto" "good" "unknown" "bad" "ask"))
(error "Bad policy:" policy)) (fail "Bad policy:" policy))
policy)) policy))
;; Check that KEYID's tofu policy matches EXPECTED-POLICY. Any ;; Check that KEYID's tofu policy matches EXPECTED-POLICY. Any
@ -62,7 +62,7 @@
(define (checkpolicy keyid expected-policy . args) (define (checkpolicy keyid expected-policy . args)
(let ((policy (apply getpolicy `(,keyid ,@args)))) (let ((policy (apply getpolicy `(,keyid ,@args))))
(unless (string=? policy expected-policy) (unless (string=? policy expected-policy)
(error keyid ": Expected policy to be" expected-policy (fail keyid ": Expected policy to be" expected-policy
"but got" policy)))) "but got" policy))))
;; Get the trust level for KEYID. Any remaining arguments are simply ;; Get the trust level for KEYID. Any remaining arguments are simply
@ -77,7 +77,7 @@
--list-keys ,keyid))) 1))) --list-keys ,keyid))) 1)))
(unless (and (= 1 (string-length trust)) (unless (and (= 1 (string-length trust))
(member (string-ref trust 0) (string->list "oidreqnmfuws-"))) (member (string-ref trust 0) (string->list "oidreqnmfuws-")))
(error "Bad trust value:" trust)) (fail "Bad trust value:" trust))
trust)) trust))
;; Check that KEYID's trust level matches EXPECTED-TRUST. Any ;; Check that KEYID's trust level matches EXPECTED-TRUST. Any
@ -87,7 +87,7 @@
(define (checktrust keyid expected-trust . args) (define (checktrust keyid expected-trust . args)
(let ((trust (apply gettrust `(,keyid ,@args)))) (let ((trust (apply gettrust `(,keyid ,@args))))
(unless (string=? trust expected-trust) (unless (string=? trust expected-trust)
(error keyid ": Expected trust to be" expected-trust (fail keyid ": Expected trust to be" expected-trust
"but got" trust)))) "but got" trust))))
;; Set key KEYID's policy to POLICY. Any remaining arguments are ;; Set key KEYID's policy to POLICY. Any remaining arguments are
@ -177,10 +177,10 @@
(sigs (string->number (list-ref tfs 3))) (sigs (string->number (list-ref tfs 3)))
(encs (string->number (list-ref tfs 4)))) (encs (string->number (list-ref tfs 4))))
(unless (= sigs expected-sigs) (unless (= sigs expected-sigs)
(error keyid ": # signatures (" sigs ") does not match expected" (fail keyid ": # signatures (" sigs ") does not match expected"
"# signatures (" expected-sigs ").\n")) "# signatures (" expected-sigs ").\n"))
(unless (= encs expected-encs) (unless (= encs expected-encs)
(error keyid ": # encryptions (" encs ") does not match expected" (fail keyid ": # encryptions (" encs ") does not match expected"
"# encryptions (" expected-encs ").\n")) "# encryptions (" expected-encs ").\n"))
)) ))

View File

@ -33,7 +33,7 @@
(display (make-string 64 (integer->char (string->number char))) (display (make-string 64 (integer->char (string->number char)))
port))) port)))
(if (= 0 (call `(,@GPG --verify ,x data-500))) (if (= 0 (call `(,@GPG --verify ,x data-500)))
(error "no error code from verify")))) (fail "no error code from verify"))))
'("#x2d" "#xca")) '("#x2d" "#xca"))
;; A plain signed message created using ;; A plain signed message created using
@ -324,7 +324,7 @@ GisM
(pipe:defer (lambda (sink) (pipe:defer (lambda (sink)
(display armored-file (fdopen sink "w")))) (display armored-file (fdopen sink "w"))))
(pipe:spawn `(,@GPG --verify))) (pipe:spawn `(,@GPG --verify)))
(error "verification succeeded but should not"))) (fail "verification succeeded but should not")))
'(msg_olsols_asc_multiple msg_clsclss_asc_multiple)) '(msg_olsols_asc_multiple msg_clsclss_asc_multiple))
(for-each-p (for-each-p
@ -334,7 +334,7 @@ GisM
(pipe:do (pipe:do
(pipe:echo (eval armored-file (current-environment))) (pipe:echo (eval armored-file (current-environment)))
(pipe:spawn `(,@GPG --verify))) (pipe:spawn `(,@GPG --verify)))
(error "verification succeeded but should not"))) (fail "verification succeeded but should not")))
'(bad_ls_asc bad_fols_asc bad_olsf_asc bad_ools_asc)) '(bad_ls_asc bad_fols_asc bad_olsf_asc bad_ools_asc))