02/05: guix package: Add '--allow-collisions'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit fc95dc4c34bf88ebd8c21752bf6d54b5cf752d1a
Author: Ludovic Courtès <address@hidden>
Date:   Sat Mar 31 23:14:56 2018 +0200

    guix package: Add '--allow-collisions'.
    
    Fixes <https://bugs.gnu.org/30830>.
    Suggested by Ricardo Wurmus <address@hidden>.
    
    * guix/scripts/package.scm (build-and-use-profile): Add
     #:allow-collisions? and pass it to 'profile-derivation'.
    (show-help, %options): Add '--allow-collisions'.
    (manifest-action, process-actions): Pass #:allow-collisions? to
    'build-and-use-profile'.
    * tests/guix-package.sh: Add collision test.
    * doc/guix.texi (Invoking guix package): Document '--allow-collisions'.
---
 doc/guix.texi            | 10 ++++++++++
 guix/scripts/package.scm | 17 +++++++++++++++--
 tests/guix-package.sh    |  8 ++++++++
 3 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 25c08b9..4eac281 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2039,6 +2039,16 @@ variable, even though, taken individually, neither 
@file{foo} nor
 @itemx -p @var{profile}
 Use @var{profile} instead of the user's default profile.
 
address@hidden collisions, in a profile
address@hidden colliding packages in profiles
address@hidden profile collisions
address@hidden --allow-collisions
+Allow colliding packages in the new profile.  Use at your own risk!
+
+By default, @command{guix package} reports as an error @dfn{collisions}
+in the profile.  Collisions happen when two or more different versions
+or variants of a given package end up in the profile.
+
 @item --verbose
 Produce verbose output.  In particular, emit the build log of the
 environment on the standard error port.
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index d8b80ef..4f519e6 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -194,15 +194,18 @@ denote ranges as interpreted by 'matching-generations'."
 
 (define* (build-and-use-profile store profile manifest
                                 #:key
+                                allow-collisions?
                                 bootstrap? use-substitutes?
                                 dry-run?)
   "Build a new generation of PROFILE, a file name, using the packages
-specified in MANIFEST, a manifest object."
+specified in MANIFEST, a manifest object.  When ALLOW-COLLISIONS? is true,
+do not treat collisions in MANIFEST as an error."
   (when (equal? profile %current-profile)
     (ensure-default-profile))
 
   (let* ((prof-drv (run-with-store store
                      (profile-derivation manifest
+                                         #:allow-collisions? allow-collisions?
                                          #:hooks (if bootstrap?
                                                      '()
                                                      %default-profile-hooks)
@@ -408,6 +411,8 @@ Install, remove, or upgrade packages in a single 
transaction.\n"))
   -p, --profile=PROFILE  use PROFILE instead of the user's default profile"))
   (newline)
   (display (G_ "
+      --allow-collisions do not treat collisions in the profile as an error"))
+  (display (G_ "
       --bootstrap        use the bootstrap Guile to build the profile"))
   (display (G_ "
       --verbose          produce verbose output"))
@@ -544,6 +549,10 @@ kind of search path~%")
                  (lambda (opt name arg result arg-handler)
                    (values (alist-cons 'verbose? #t result)
                            #f)))
+         (option '("allow-collisions") #f #f
+                 (lambda (opt name arg result arg-handler)
+                   (values (alist-cons 'allow-collisions? #t result)
+                           #f)))
          (option '(#\s "search") #t #f
                  (lambda (opt name arg result arg-handler)
                    (values (cons `(query search ,(or arg ""))
@@ -831,13 +840,15 @@ processed, #f otherwise."
   (let* ((user-module  (make-user-module '((guix profiles) (gnu))))
          (manifest     (load* file user-module))
          (bootstrap?   (assoc-ref opts 'bootstrap?))
-         (substitutes? (assoc-ref opts 'substitutes?)))
+         (substitutes? (assoc-ref opts 'substitutes?))
+         (allow-collisions? (assoc-ref opts 'allow-collisions?)))
     (if dry-run?
         (format #t (G_ "would install new manifest from '~a' with ~d 
entries~%")
                 file (length (manifest-entries manifest)))
         (format #t (G_ "installing new manifest from '~a' with ~d entries~%")
                 file (length (manifest-entries manifest))))
     (build-and-use-profile store profile manifest
+                           #:allow-collisions? allow-collisions?
                            #:bootstrap? bootstrap?
                            #:use-substitutes? substitutes?
                            #:dry-run? dry-run?)))
@@ -856,6 +867,7 @@ processed, #f otherwise."
   (define dry-run? (assoc-ref opts 'dry-run?))
   (define bootstrap? (assoc-ref opts 'bootstrap?))
   (define substitutes? (assoc-ref opts 'substitutes?))
+  (define allow-collisions? (assoc-ref opts 'allow-collisions?))
   (define profile  (or (assoc-ref opts 'profile) %current-profile))
   (define transform (options->transformation opts))
 
@@ -894,6 +906,7 @@ processed, #f otherwise."
       (show-manifest-transaction store manifest step3
                                  #:dry-run? dry-run?)
       (build-and-use-profile store profile new
+                             #:allow-collisions? allow-collisions?
                              #:bootstrap? bootstrap?
                              #:use-substitutes? substitutes?
                              #:dry-run? dry-run?))))
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 760a2e4..aa5eaa6 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -60,6 +60,14 @@ test -L "$profile" && test -L "$profile-1-link"
 ! test -f "$profile-2-link"
 test -f "$profile/bin/guile"
 
+# Collisions are properly flagged (in this case, 'python-wrapper' propagates
+# address@hidden, which conflicts with address@hidden)
+if guix package --bootstrap -n -p "$profile" -i address@hidden python-wrapper
+then false; else true; fi
+
+guix package --bootstrap -n -p "$profile" -i address@hidden python-wrapper \
+     --allow-collisions
+
 # No search path env. var. here.
 guix package -p "$profile" --search-paths
 guix package -p "$profile" --search-paths | grep '^export PATH='