* guix/tests.scm: New file. * Makefile.am (noinst_DATA): New variable. (GOBJECTS): Add guix/tests.go. * tests/builders.scm (%store): Use 'open-connection-for-tests' from (guix tests). * tests/derivations.scm: Likewise. * tests/monads.scm: Likewise. * tests/packages.scm: Likewise. * tests/profiles.scm: Likewise. * tests/union.scm: Likewise. * tests/gexp.scm: Likewise. (guile-for-build): Remove. Use (%guile-for-build) instead. * tests/nar.scm (make-random-bytevector, %seed, random-text): Remove. (populate-file): Change 'make-random-bytevector' to 'random-bytevector'. Use (guix tests). * tests/store.scm (%seed, random-text): Remove. Use (guix tests).gn-latest-20200428
@@ -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 | |||
@@ -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 |
@@ -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. | |||
@@ -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)))) | |||
@@ -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 | |||
@@ -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)) | |||
@@ -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))) | |||
@@ -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") | |||
@@ -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. | |||
@@ -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") | |||
@@ -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") | |||