gnu/tests/package-management.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2020 Oleg Pykhalov <go.wigust@gmail.com>
   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 (gnu tests package-management)
  20   #:use-module (gnu packages base)
  21   #:use-module (gnu packages package-management)
  22   #:use-module (gnu services)
  23   #:use-module (gnu services networking)
  24   #:use-module (gnu services nix)
  25   #:use-module (gnu system)
  26   #:use-module (gnu system vm)
  27   #:use-module (gnu tests)
  28   #:use-module (guix gexp)
  29   #:use-module (guix packages)
  30   #:export (%test-nix))
  31
  32 ;;; Commentary:
  33 ;;;
  34 ;;; This module provides a test definition for the nix-daemon
  35 ;;;
  36 ;;; Code:
  37
  38 (define* (run-nix-test name test-os)
  39   "Run tests in TEST-OS, which has nix-daemon running."
  40   (define os
  41     (marionette-operating-system
  42      test-os
  43      #:imported-modules '((gnu services herd))))
  44
  45   (define vm
  46     (virtual-machine
  47      (operating-system os)
  48      (port-forwardings '((8080 . 80)))
  49      (memory-size 1024)))
  50
  51   (define test
  52     (with-imported-modules '((gnu build marionette))
  53       #~(begin
  54           (use-modules (srfi srfi-11)
  55                        (srfi srfi-64)
  56                        (gnu build marionette)
  57                        (web client)
  58                        (web response))
  59
  60           (define marionette
  61             (make-marionette (list #$vm)))
  62
  63           (mkdir #$output)
  64           (chdir #$output)
  65
  66           (test-begin #$name)
  67
  68           ;; XXX: Shepherd reads the config file *before* binding its control
  69           ;; socket, so /var/run/shepherd/socket might not exist yet when the
  70           ;; 'marionette' service is started.
  71           (test-assert "shepherd socket ready"
  72             (marionette-eval
  73              `(begin
  74                 (use-modules (gnu services herd))
  75                 (let loop ((i 10))
  76                   (cond ((file-exists? (%shepherd-socket-file))
  77                          #t)
  78                         ((> i 0)
  79                          (sleep 1)
  80                          (loop (- i 1)))
  81                         (else
  82                          'failure))))
  83              marionette))
  84
  85           (test-assert "Nix daemon running"
  86             (marionette-eval
  87              '(begin
  88                 ;; Wait for nix-daemon to be up and running.
  89                 (start-service 'nix-daemon)
  90                 (with-output-to-file "guix-test.nix"
  91                   (lambda ()
  92                     (display "\
  93 with import <nix/config.nix>;
  94
  95 derivation {
  96   system = builtins.currentSystem;
  97   name = \"guix-test\";
  98   builder = shell;
  99   args = [\"-c\" \"mkdir $out\\necho FOO > $out/foo\"];
 100   PATH = coreutils;
 101 }
 102 ")))
 103                 (zero? (system* (string-append #$nix "/bin/nix-build")
 104                                 "--substituters" "" "--debug" "--no-out-link"
 105                                 "guix-test.nix")))
 106              marionette))
 107
 108           (test-end)
 109
 110           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 111
 112   (gexp->derivation (string-append name "-test") test))
 113
 114 (define %nix-os
 115   ;; Return operating system under test.
 116   (let ((base-os
 117          (simple-operating-system
 118           (service nix-service-type)
 119           (service dhcp-client-service-type))))
 120     (operating-system
 121       (inherit base-os)
 122       (packages (cons nix (operating-system-packages base-os))))))
 123
 124 (define %test-nix
 125   (system-test
 126    (name "nix")
 127    (description "Connect to a running nix-daemon")
 128    (value (run-nix-test name %nix-os))))
 129
 130 ;;; package-management.scm ends here