summary refs log tree commit diff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile.am5
-rw-r--r--guix/tests.scm70
-rw-r--r--tests/builders.scm9
-rw-r--r--tests/derivations.scm12
-rw-r--r--tests/gexp.scm15
-rw-r--r--tests/monads.scm6
-rw-r--r--tests/nar.scm19
-rw-r--r--tests/packages.scm9
-rw-r--r--tests/profiles.scm10
-rw-r--r--tests/store.scm14
-rw-r--r--tests/union.scm9
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")
generated by cgit-pink 1.4.1 (git 2.36.1) at 2024-09-22 04:56:30 +0000