;;; 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.
;;;
`(,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")
;; new 'bin' sub-directory in the profile.
(eq? 'directory (stat:type (lstat "bin"))))))))
-(test-end)
+(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"))))))
-\f
-(exit (= (test-runner-fail-count (test-runner-current)) 0))
+(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)