diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-04-08 15:47:11 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2018-04-08 17:41:08 +0200 |
| commit | e40aa54e98aa6329e6196fd29e7e4e34ce3a063c (patch) | |
| tree | 5870bf79fd29d882c371c0dfcb11626a617584e4 /tests/union.scm | |
| parent | 1b92d65a40a2cf6028bfc0efb7d7d007d76d008a (diff) | |
| download | gnu-guix-e40aa54e98aa6329e6196fd29e7e4e34ce3a063c.tar gnu-guix-e40aa54e98aa6329e6196fd29e7e4e34ce3a063c.tar.gz | |
union: Allow callers to choose the collision resolution policy.
* guix/build/union.scm (warn-about-collision): New procedure.
(union-build): Add #:resolve-collision.
[resolve-collisions]: Call it.
* tests/union.scm ("union-build collision first & last"): New test.
Diffstat (limited to 'tests/union.scm')
| -rw-r--r-- | tests/union.scm | 42 |
1 files changed, 41 insertions, 1 deletions
diff --git a/tests/union.scm b/tests/union.scm index b63edc757b..aa95cae001 100644 --- a/tests/union.scm +++ b/tests/union.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -124,6 +124,46 @@ ;; 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)) |