From c8c88afaa14f760ec71ffb2ef0d712b7e42cc71f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 29 Oct 2012 22:39:46 +0100 Subject: Add (guix build union). * guix/build/union.scm, tests/union.scm: New files. * Makefile.am (MODULES): Add `guix/build/union.scm'. (TESTS): Add `tests/union.scm'. --- tests/union.scm | 103 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 103 insertions(+) create mode 100644 tests/union.scm (limited to 'tests/union.scm') diff --git a/tests/union.scm b/tests/union.scm new file mode 100644 index 0000000000..f8a58d5952 --- /dev/null +++ b/tests/union.scm @@ -0,0 +1,103 @@ +;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- +;;; Copyright (C) 2012 Ludovic Courtès +;;; +;;; This file is part of Guix. +;;; +;;; 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. +;;; +;;; 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 Guix. If not, see . + + +(define-module (test-union) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix derivations) + #:use-module (guix packages) + #:use-module (guix build union) + #:use-module ((guix build utils) + #:select (with-directory-excursion directory-exists?)) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) + +;; Exercise the (guix build union) module. + +(define %store + (false-if-exception (open-connection))) + +(define %bootstrap-guile + (@@ (distro packages base) %bootstrap-guile)) + +(when %store + ;; By default, use %BOOTSTRAP-GUILE for the current system. + (let ((drv (package-derivation %store %bootstrap-guile))) + (%guile-for-build drv))) + + +(test-begin "union") + +(test-equal "tree-union, empty" + '() + (tree-union '())) + +(test-equal "tree-union, leaves only" + '(a b c d) + (tree-union '(a b c d))) + +(test-equal "tree-union, simple" + '((bin ls touch make awk gawk)) + (tree-union '((bin ls touch) + (bin make) + (bin awk gawk)))) + +(test-equal "tree-union, several levels" + '((share (doc (make README) (coreutils README))) + (bin ls touch make)) + (tree-union '((bin ls touch) + (share (doc (coreutils README))) + (bin make) + (share (doc (make README)))))) + +(test-skip (if %store 0 1)) + +(test-assert "union-build" + (let* ((inputs (map (match-lambda + ((name package) + `(,name ,(package-derivation %store package)))) + (@@ (distro packages base) %bootstrap-inputs))) + (builder `(begin + (use-modules (guix build union)) + (union-build (assoc-ref %outputs "out") + (map cdr %build-inputs)))) + (drv + (build-expression->derivation %store "union-test" + (%current-system) + builder inputs + #:modules '((guix build union))))) + (and (build-derivations %store (list (pk 'drv drv))) + (with-directory-excursion (derivation-path->output-path drv) + (and (file-exists? "bin/touch") + (file-exists? "bin/gcc") + (file-exists? "bin/ld") + (file-exists? "lib/libc.so") + (directory-exists? "lib/gcc") + (file-exists? "include/unistd.h")))))) + +(test-end) + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) + +;;; Local Variables: +;;; eval: (put 'test-assert 'scheme-indent-function 1) +;;; eval: (put 'test-equal 'scheme-indent-function 1) +;;; eval: (put 'call-with-input-string 'scheme-indent-function 1) +;;; End: -- cgit v1.2.3