mirror of
git://git.gnupg.org/gnupg.git
synced 2024-12-22 10:19:57 +01:00
a55393cb5f
* tests/gpgscm/tests.scm (log): New function. * tests/openpgp/run-tests.scm (run-tests-parallel): Do not run the startup and teardown scripts. (run-tests-sequential): Likewise. * tests/openpgp/setup.scm: Move all functions... * tests/openpgp/defs.scm: ... here and make them less verbose. (setup-environment): New function. (setup-legacy-environment): Likewise. (start-agent): Make less verbose, run 'stop-agent' at interpreter exit. (stop-agent): Make less verbose. * tests/openpgp/finish.scm: Drop file. * tests/openpgp/Makefile.am (EXTRA_DIST): Drop removed file. * tests/openpgp/4gb-packet.scm: Use 'setup-environment' or 'setup-legacy-environment' as appropriate. * tests/openpgp/armdetach.scm: Likewise. * tests/openpgp/armdetachm.scm: Likewise. * tests/openpgp/armencrypt.scm: Likewise. * tests/openpgp/armencryptp.scm: Likewise. * tests/openpgp/armor.scm: Likewise. * tests/openpgp/armsignencrypt.scm: Likewise. * tests/openpgp/armsigs.scm: Likewise. * tests/openpgp/clearsig.scm: Likewise. * tests/openpgp/conventional-mdc.scm: Likewise. * tests/openpgp/conventional.scm: Likewise. * tests/openpgp/decrypt-dsa.scm: Likewise. * tests/openpgp/decrypt.scm: Likewise. * tests/openpgp/default-key.scm: Likewise. * tests/openpgp/detach.scm: Likewise. * tests/openpgp/detachm.scm: Likewise. * tests/openpgp/ecc.scm: Likewise. * tests/openpgp/encrypt-dsa.scm: Likewise. * tests/openpgp/encrypt.scm: Likewise. * tests/openpgp/encryptp.scm: Likewise. * tests/openpgp/export.scm: Likewise. * tests/openpgp/finish.scm: Likewise. * tests/openpgp/genkey1024.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/issue2417.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/quick-key-manipulation.scm: Likewise. * tests/openpgp/seat.scm: Likewise. * tests/openpgp/shell.scm: Likewise. * tests/openpgp/signencrypt-dsa.scm: Likewise. * tests/openpgp/signencrypt.scm: Likewise. * tests/openpgp/sigs-dsa.scm: Likewise. * tests/openpgp/sigs.scm: Likewise. * tests/openpgp/ssh.scm: Likewise. * tests/openpgp/tofu.scm: Likewise. * tests/openpgp/use-exact-key.scm: Likewise. * tests/openpgp/verify.scm: Likewise. * tests/openpgp/version.scm: Likewise. * tests/openpgp/issue2346.scm: Likewise and simplify. -- The previous Bourne Shell-based test suite created the environment before running all tests, and tore it down after executing them. When we created the Scheme-based test suite, we kept this design at first, but introduced a way to run each test in its own environment to prevent tests from interfering with each other. Nevertheless, every test started out with the same environment. Move the creation of the test environment into each test. This gives us finer control over the environment each test is run in. It also makes it possible to run each test by simply executing it using gpgscm without the use of the runner. Furthermore, it has the neat side-effect of speeding up the test suite if run in parallel. Signed-off-by: Justus Winter <justus@g10code.com>
84 lines
2.5 KiB
Scheme
Executable File
84 lines
2.5 KiB
Scheme
Executable File
#!/usr/bin/env gpgscm
|
|
|
|
;; Copyright (C) 2016 g10 Code GmbH
|
|
;;
|
|
;; This file is part of GnuPG.
|
|
;;
|
|
;; GnuPG is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
;;
|
|
;; GnuPG is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program; if not, see <http://www.gnu.org/licenses/>.
|
|
|
|
(load (with-path "defs.scm"))
|
|
(setup-environment)
|
|
|
|
;; XXX because of --always-trust, the trustdb is not created.
|
|
;; Therefore, we redefine GPG without --always-trust.
|
|
(define GPG `(,(tool 'gpg) --no-permission-warning))
|
|
|
|
(define (exact id)
|
|
(string-append "=" id))
|
|
|
|
(define (count-uids-of-secret-key id)
|
|
(length (filter (lambda (x) (and (string=? "uid" (car x))
|
|
(string=? "u" (cadr x))))
|
|
(gpg-with-colons
|
|
`(--with-fingerprint
|
|
--list-secret-keys ,(exact id))))))
|
|
|
|
(define alpha "Alpha <alpha@invalid.example.net>")
|
|
(define bravo "Bravo <bravo@invalid.example.net>")
|
|
|
|
(define (key-data key)
|
|
(filter (lambda (x) (or (string=? (car x) "pub")
|
|
(string=? (car x) "sub")))
|
|
(gpg-with-colons `(-k ,key))))
|
|
|
|
(setenv "PINENTRY_USER_DATA" "test" #t)
|
|
|
|
(info "Checking quick key generation...")
|
|
(call-check `(,@GPG --quick-gen-key ,alpha))
|
|
|
|
(call-check `(,@GPG --check-trustdb)) ; XXX why?
|
|
|
|
(assert (= 1 (count-uids-of-secret-key alpha)))
|
|
|
|
(info "Checking that we can add a user ID...")
|
|
|
|
;; Make sure the key capabilities don't change when we add a user id.
|
|
;; (See bug #2697.)
|
|
(let ((pre (key-data (exact alpha)))
|
|
(result (call-check `(,@GPG --quick-adduid ,(exact alpha) ,bravo)))
|
|
(post (key-data (exact alpha))))
|
|
(if (not (equal? pre post))
|
|
(begin
|
|
(display "Key capabilities changed when adding a user id:")
|
|
(newline)
|
|
(display " Pre: ")
|
|
(display pre)
|
|
(newline)
|
|
(display " Post: ")
|
|
(display post)
|
|
(newline)
|
|
(exit 1))))
|
|
|
|
(call-check `(,@GPG --check-trustdb)) ; XXX why?
|
|
|
|
(assert (= 2 (count-uids-of-secret-key alpha)))
|
|
(assert (= 2 (count-uids-of-secret-key bravo)))
|
|
|
|
(info "Checking that we can revoke a user ID...")
|
|
(call-check `(,@GPG --quick-revuid ,(exact bravo) ,alpha))
|
|
|
|
(call-check `(,@GPG --check-trustdb)) ; XXX why?
|
|
|
|
(assert (= 1 (count-uids-of-secret-key bravo)))
|