X-Git-Url: https://git.hcoop.net/jackhill/guix/guix.git/blobdiff_plain/a9edb211e733b8b34e67ec3b4450567e9376986f..c26fd5648c2a24dbd71f4c0851f8b5eced75e0f1:/tests/union.scm

diff --git a/tests/union.scm b/tests/union.scm
index cccf397181..a8387edf42 100644
--- a/tests/union.scm
+++ b/tests/union.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -94,8 +95,9 @@
                          `(,name ,(package-derivation %store package))))
 
                        ;; Purposefully leave duplicate entries.
-                       (append %bootstrap-inputs
-                               (take %bootstrap-inputs 3))))
+                       (filter (compose package? cadr)
+                               (append %bootstrap-inputs-for-tests
+                                       (take %bootstrap-inputs-for-tests 3)))))
          (builder `(begin
                      (use-modules (guix build union))
                      (union-build (assoc-ref %outputs "out")
@@ -124,4 +126,82 @@
                 ;; new 'bin' sub-directory in the profile.
                 (eq? 'directory (stat:type (lstat "bin"))))))))
 
+(test-assert "union-build collision first & last"
+  (let* ((guile   (package-derivation %store %bootstrap-guile))
+         (fake    (build-expression->derivation
+                   %store "fake-guile"
+                   '(begin
+                      (use-modules (guix build utils))
+                      (let ((out (assoc-ref %outputs "out")))
+                        (mkdir-p (string-append out "/bin"))
+                        (call-with-output-file (string-append out "/bin/guile")
+                          (const #t))))
+                   #:modules '((guix build utils))))
+         (builder (lambda (policy)
+                    `(begin
+                       (use-modules (guix build union)
+                                    (srfi srfi-1))
+                       (union-build (assoc-ref %outputs "out")
+                                    (map cdr %build-inputs)
+                                    #:resolve-collision ,policy))))
+         (drv1
+          (build-expression->derivation %store "union-first"
+                                        (builder 'first)
+                                        #:inputs `(("guile" ,guile)
+                                                   ("fake" ,fake))
+                                        #:modules '((guix build union))))
+         (drv2
+          (build-expression->derivation %store "union-last"
+                                        (builder 'last)
+                                        #:inputs `(("guile" ,guile)
+                                                   ("fake" ,fake))
+                                        #:modules '((guix build union)))))
+    (and (build-derivations %store (list drv1 drv2))
+         (with-directory-excursion (derivation->output-path drv1)
+           (string=? (readlink "bin/guile")
+                     (string-append (derivation->output-path guile)
+                                    "/bin/guile")))
+         (with-directory-excursion (derivation->output-path drv2)
+           (string=? (readlink "bin/guile")
+                     (string-append (derivation->output-path fake)
+                                    "/bin/guile"))))))
+
+(test-assert "union-build #:create-all-directories? #t"
+  (let* ((build  `(begin
+                    (use-modules (guix build union))
+                    (union-build (assoc-ref %outputs "out")
+                                 (map cdr %build-inputs)
+                                 #:create-all-directories? #t)))
+         (input  (package-derivation %store %bootstrap-guile))
+         (drv    (build-expression->derivation %store "union-test-all-dirs"
+                                               build
+                                               #:modules '((guix build union))
+                                               #:inputs `(("g" ,input)))))
+    (and (build-derivations %store (list drv))
+         (with-directory-excursion (derivation->output-path drv)
+           ;; Even though there's only one input to the union,
+           ;; #:create-all-directories? #t must have created bin/ rather than
+           ;; making it a symlink to Guile's bin/.
+           (and (file-exists? "bin/guile")
+                (file-is-directory? "bin")
+                (eq? 'symlink (stat:type (lstat "bin/guile"))))))))
+
+(letrec-syntax ((test-relative-file-name
+                 (syntax-rules (=>)
+                   ((_ (reference file => expected) rest ...)
+                    (begin
+                      (test-equal (string-append "relative-file-name "
+                                                 reference " " file)
+                        expected
+                        (relative-file-name reference file))
+                      (test-relative-file-name rest ...)))
+                   ((_)
+                    #t))))
+  (test-relative-file-name
+   ("/a/b" "/a/c/d"     => "../c/d")
+   ("/a/b" "/a/b"       => "")
+   ("/a/b" "/a"         => "..")
+   ("/a/b" "/a/b/c/d"   => "c/d")
+   ("/a/b/c" "/a/d/e/f" => "../../d/e/f")))
+
 (test-end)