guix/tests.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix tests)
  20   #:use-module (guix store)
  21   #:use-module (guix derivations)
  22   #:use-module (guix packages)
  23   #:use-module (gnu packages bootstrap)
  24   #:use-module (srfi srfi-34)
  25   #:use-module (rnrs bytevectors)
  26   #:export (open-connection-for-tests
  27             random-text
  28             random-bytevector))
  29
  30 ;;; Commentary:
  31 ;;;
  32 ;;; This module provide shared infrastructure for the test suite.  For
  33 ;;; internal use only.
  34 ;;;
  35 ;;; Code:
  36
  37 (define (open-connection-for-tests)
  38   "Open a connection to the build daemon for tests purposes and return it."
  39   (guard (c ((nix-error? c)
  40              (format (current-error-port)
  41                      "warning: build daemon error: ~s~%" c)
  42              #f))
  43     (let ((store (open-connection)))
  44       ;; Make sure we build everything by ourselves.
  45       (set-build-options store #:use-substitutes? #f)
  46
  47       ;; Use the bootstrap Guile when running tests, so we don't end up
  48       ;; building everything in the temporary test store.
  49       (%guile-for-build (package-derivation store %bootstrap-guile))
  50
  51       store)))
  52
  53 (define %seed
  54   (seed->random-state (logxor (getpid) (car (gettimeofday)))))
  55
  56 (define (random-text)
  57   "Return the hexadecimal representation of a random number."
  58   (number->string (random (expt 2 256) %seed) 16))
  59
  60 (define (random-bytevector n)
  61   "Return a random bytevector of N bytes."
  62   (let ((bv (make-bytevector n)))
  63     (let loop ((i 0))
  64       (if (< i n)
  65           (begin
  66             (bytevector-u8-set! bv i (random 256 %seed))
  67             (loop (1+ i)))
  68           bv))))
  69
  70 ;;; tests.scm ends here