diff options
| -rw-r--r-- | Makefile.am | 5 | ||||
| -rw-r--r-- | guix/tests.scm | 70 | ||||
| -rw-r--r-- | tests/builders.scm | 9 | ||||
| -rw-r--r-- | tests/derivations.scm | 12 | ||||
| -rw-r--r-- | tests/gexp.scm | 15 | ||||
| -rw-r--r-- | tests/monads.scm | 6 | ||||
| -rw-r--r-- | tests/nar.scm | 19 | ||||
| -rw-r--r-- | tests/packages.scm | 9 | ||||
| -rw-r--r-- | tests/profiles.scm | 10 | ||||
| -rw-r--r-- | tests/store.scm | 14 | ||||
| -rw-r--r-- | tests/union.scm | 9 |
11 files changed, 97 insertions, 81 deletions
diff --git a/Makefile.am b/Makefile.am index 17a676ac54..fff5958355 100644 --- a/Makefile.am +++ b/Makefile.am @@ -99,6 +99,9 @@ MODULES += \ endif BUILD_DAEMON_OFFLOAD +# Internal module with test suite support. +noinst_DATA = guix/tests.scm + # Because of the autoload hack in (guix build download), we must build it # first to avoid errors on systems where (gnutls) is unavailable. guix/scripts/download.go: guix/build/download.go @@ -113,7 +116,7 @@ KCONFIGS = \ EXAMPLES = \ gnu/system/os-config.tmpl -GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go +GOBJECTS = $(MODULES:%.scm=%.go) guix/config.go guix/tests.go nobase_dist_guilemodule_DATA = $(MODULES) $(KCONFIGS) $(EXAMPLES) nobase_nodist_guilemodule_DATA = $(GOBJECTS) guix/config.scm diff --git a/guix/tests.scm b/guix/tests.scm new file mode 100644 index 0000000000..4f7b0c8171 --- /dev/null +++ b/guix/tests.scm @@ -0,0 +1,70 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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. +;;; +;;; GNU Guix 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix tests) + #:use-module (guix store) + #:use-module (guix derivations) + #:use-module (guix packages) + #:use-module (gnu packages bootstrap) + #:use-module (srfi srfi-34) + #:use-module (rnrs bytevectors) + #:export (open-connection-for-tests + random-text + random-bytevector)) + +;;; Commentary: +;;; +;;; This module provide shared infrastructure for the test suite. For +;;; internal use only. +;;; +;;; Code: + +(define (open-connection-for-tests) + "Open a connection to the build daemon for tests purposes and return it." + (guard (c ((nix-error? c) + (format (current-error-port) + "warning: build daemon error: ~s~%" c) + #f)) + (let ((store (open-connection))) + ;; Make sure we build everything by ourselves. + (set-build-options store #:use-substitutes? #f) + + ;; Use the bootstrap Guile when running tests, so we don't end up + ;; building everything in the temporary test store. + (%guile-for-build (package-derivation store %bootstrap-guile)) + + store))) + +(define %seed + (seed->random-state (logxor (getpid) (car (gettimeofday))))) + +(define (random-text) + "Return the hexadecimal representation of a random number." + (number->string (random (expt 2 256) %seed) 16)) + +(define (random-bytevector n) + "Return a random bytevector of N bytes." + (let ((bv (make-bytevector n))) + (let loop ((i 0)) + (if (< i n) + (begin + (bytevector-u8-set! bv i (random 256 %seed)) + (loop (1+ i))) + bv)))) + +;;; tests.scm ends here diff --git a/tests/builders.scm b/tests/builders.scm index 0ed5d74a22..54cdeb6d7b 100644 --- a/tests/builders.scm +++ b/tests/builders.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +25,7 @@ #:use-module (guix utils) #:use-module (guix base32) #:use-module (guix derivations) + #:use-module (guix tests) #:use-module ((guix packages) #:select (package-derivation package-native-search-paths)) #:use-module (gnu packages bootstrap) @@ -35,11 +36,7 @@ ;; Test the higher-level builders. (define %store - (false-if-exception (open-connection))) - -(when %store - ;; Make sure we build everything by ourselves. - (set-build-options %store #:use-substitutes? #f)) + (open-connection-for-tests)) (define %bootstrap-inputs ;; Use the bootstrap inputs so it doesn't take ages to run these tests. diff --git a/tests/derivations.scm b/tests/derivations.scm index 87609108d6..19bcebcb21 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -16,13 +16,13 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. - (define-module (test-derivations) #:use-module (guix derivations) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix hash) #:use-module (guix base32) + #:use-module (guix tests) #:use-module ((guix packages) #:select (package-derivation base32)) #:use-module ((guix build utils) #:select (executable-file?)) #:use-module ((gnu packages) #:select (search-bootstrap-binary)) @@ -42,15 +42,7 @@ #:use-module (ice-9 match)) (define %store - (false-if-exception (open-connection))) - -(when %store - ;; Make sure we build everything by ourselves. - (set-build-options %store #:use-substitutes? #f) - - ;; By default, use %BOOTSTRAP-GUILE for the current system. - (let ((drv (package-derivation %store %bootstrap-guile))) - (%guile-for-build drv))) + (open-connection-for-tests)) (define (bootstrap-binary name) (let ((bin (search-bootstrap-binary name (%current-system)))) diff --git a/tests/gexp.scm b/tests/gexp.scm index 694bd409bc..bf52401c66 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -22,6 +22,7 @@ #:use-module (guix gexp) #:use-module (guix derivations) #:use-module (guix packages) + #:use-module (guix tests) #:use-module (gnu packages) #:use-module (gnu packages base) #:use-module (gnu packages bootstrap) @@ -35,28 +36,22 @@ ;; Test the (guix gexp) module. (define %store - (open-connection)) + (open-connection-for-tests)) ;; For white-box testing. (define gexp-inputs (@@ (guix gexp) gexp-inputs)) (define gexp-native-inputs (@@ (guix gexp) gexp-native-inputs)) (define gexp->sexp (@@ (guix gexp) gexp->sexp)) -(define guile-for-build - (package-derivation %store %bootstrap-guile)) - -;; Make it the default. -(%guile-for-build guile-for-build) - (define* (gexp->sexp* exp #:optional target) (run-with-store %store (gexp->sexp exp #:target target) - #:guile-for-build guile-for-build)) + #:guile-for-build (%guile-for-build))) (define-syntax-rule (test-assertm name exp) (test-assert name (run-with-store %store exp - #:guile-for-build guile-for-build))) + #:guile-for-build (%guile-for-build)))) (test-begin "gexp") @@ -330,7 +325,7 @@ (derivation-file-name xdrv))))) (define shebang - (string-append "#!" (derivation->output-path guile-for-build) + (string-append "#!" (derivation->output-path (%guile-for-build)) "/bin/guile --no-auto-compile")) ;; If we're going to hit the silly shebang limit (128 chars on Linux-based diff --git a/tests/monads.scm b/tests/monads.scm index b814b0f7c5..b31cabdb54 100644 --- a/tests/monads.scm +++ b/tests/monads.scm @@ -17,6 +17,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (test-monads) + #:use-module (guix tests) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix derivations) @@ -34,10 +35,7 @@ ;; Test the (guix store) module. (define %store - (open-connection)) - -;; Make sure we build everything by ourselves. -(set-build-options %store #:use-substitutes? #f) + (open-connection-for-tests)) (define %monads (list %identity-monad %store-monad)) diff --git a/tests/nar.scm b/tests/nar.scm index 16a7845342..3188599bf1 100644 --- a/tests/nar.scm +++ b/tests/nar.scm @@ -17,6 +17,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (test-nar) + #:use-module (guix tests) #:use-module (guix nar) #:use-module (guix store) #:use-module ((guix hash) @@ -134,19 +135,10 @@ input lstat)) -(define (make-random-bytevector n) - (let ((bv (make-bytevector n))) - (let loop ((i 0)) - (if (< i n) - (begin - (bytevector-u8-set! bv i (random 256)) - (loop (1+ i))) - bv)))) - (define (populate-file file size) (call-with-output-file file (lambda (p) - (put-bytevector p (make-random-bytevector size))))) + (put-bytevector p (random-bytevector size))))) (define (rm-rf dir) (file-system-fold (const #t) ; enter? @@ -166,13 +158,6 @@ (string-append (dirname (search-path %load-path "pre-inst-env")) "/test-nar-" (number->string (getpid)))) -;; XXX: Factorize. -(define %seed - (seed->random-state (logxor (getpid) (car (gettimeofday))))) - -(define (random-text) - (number->string (random (expt 2 256) %seed) 16)) - (define-syntax-rule (let/ec k exp...) ;; This one appeared in Guile 2.0.9, so provide a copy here. (let ((tag (make-prompt-tag))) diff --git a/tests/packages.scm b/tests/packages.scm index 6ac215be4c..2a67f108ad 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -16,8 +16,8 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. - (define-module (test-packages) + #:use-module (guix tests) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix hash) @@ -39,11 +39,8 @@ ;; Test the high-level packaging layer. (define %store - (false-if-exception (open-connection))) + (open-connection-for-tests)) -(when %store - ;; Make sure we build everything by ourselves. - (set-build-options %store #:use-substitutes? #f)) (test-begin "packages") diff --git a/tests/profiles.scm b/tests/profiles.scm index 8f14bf0d6f..047c5ba49b 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -18,6 +18,7 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (test-profiles) + #:use-module (guix tests) #:use-module (guix profiles) #:use-module (guix store) #:use-module (guix monads) @@ -30,14 +31,7 @@ ;; Test the (guix profiles) module. (define %store - (open-connection)) - -(define guile-for-build - (package-derivation %store %bootstrap-guile)) - -;; Make it the default. -(%guile-for-build guile-for-build) - + (open-connection-for-tests)) ;; Example manifest entries. diff --git a/tests/store.scm b/tests/store.scm index b0f609f818..ba15524be4 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -16,8 +16,8 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. - (define-module (test-store) + #:use-module (guix tests) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix hash) @@ -40,17 +40,7 @@ ;; Test the (guix store) module. (define %store - (false-if-exception (open-connection))) - -(when %store - ;; Make sure we build everything by ourselves. - (set-build-options %store #:use-substitutes? #f)) - -(define %seed - (seed->random-state (logxor (getpid) (car (gettimeofday))))) - -(define (random-text) - (number->string (random (expt 2 256) %seed) 16)) + (open-connection-for-tests)) (test-begin "store") diff --git a/tests/union.scm b/tests/union.scm index 74c51cbed9..7e55670b86 100644 --- a/tests/union.scm +++ b/tests/union.scm @@ -16,8 +16,8 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. - (define-module (test-union) + #:use-module (guix tests) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix derivations) @@ -34,12 +34,7 @@ ;; Exercise the (guix build union) module. (define %store - (false-if-exception (open-connection))) - -(when %store - ;; By default, use %BOOTSTRAP-GUILE for the current system. - (let ((drv (package-derivation %store %bootstrap-guile))) - (%guile-for-build drv))) + (open-connection-for-tests)) (test-begin "union") |