ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Factorize test suite support in (guix tests).

Browse source 
* 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).
This commit is contained in:
Ludovic Courtès 2014-08-23 19:18:01 +02:00
parent 90a063f4ca
commit c1bc358f29
11 changed files with 97 additions and 81 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
Makefile.am
View file

@ -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

70
guix/tests.scm Normal file
View file

@ -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

9
tests/builders.scm
View file

@ -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 @@ (define-module (test-builders)
#: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 @@ (define-module (test-builders)
;; 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.

12
tests/derivations.scm
View file

@ -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 @@ (define-module (test-derivations)
#: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))))

15
tests/gexp.scm
View file

@ -22,6 +22,7 @@ (define-module (test-gexp)
#: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 @@ (define-module (test-gexp)
;; 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 @@ (define (match-input thing)
(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

6
tests/monads.scm
View file

@ -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 @@ (define-module (test-monads)
;; 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))

19
tests/nar.scm
View file

@ -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 @@ (define (file=? a b)
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 @@ (define %test-dir
(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)))

9
tests/packages.scm
View file

@ -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 @@ (define-module (test-packages)
;; 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")

10
tests/profiles.scm
View file

@ -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 @@ (define-module (test-profiles)
;; 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.

14
tests/store.scm
View file

@ -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 @@ (define-module (test-store)
;; 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")

9
tests/union.scm
View file

@ -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 @@ (define-module (test-union)
;; 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")