guix-package: Gracefully handle multiple installs of the same path.

* guix-package.in (guix-package)[process-actions]: Compute PACKAGES such
  that packages listed in INSTALL* are first removed from the remainder
  of the list.  When PROF is equal to the previous profile's store path,
  do nothing.  Reported by Andreas Enge <andreas@enge.fr>.
* tests/guix-package.sh: Test the behavior of installing the same store
  path twice.  When removing a package, omit its version number.

1 files changed, 21 insertions, 10 deletions

diff --git a/guix-package.in b/guix-package.in
index dab58719c3..7bc32f851b 100644
--- a/guix-package.in
+++ b/guix-package.in
@@ -359,10 +359,15 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
                                   (_ #f))
                                  opts))
            (packages (append install*
-                             (fold alist-delete
-                                   (manifest-packages
-                                    (profile-manifest profile))
-                                   remove))))
+                             (fold (lambda (package result)
+                                     (match package
+                                       ((name _ ...)
+                                        (alist-delete name result))))
+                                   (fold alist-delete
+                                         (manifest-packages
+                                          (profile-manifest profile))
+                                         remove)
+                                   install*))))
 
       (show-what-to-build drv dry-run?)
 
@@ -370,16 +375,22 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
           (and (build-derivations %store drv)
                (let* ((prof-drv (profile-derivation %store packages))
                       (prof     (derivation-path->output-path prof-drv))
+                      (old-drv  (profile-derivation
+                                 %store (manifest-packages
+                                         (profile-manifest profile))))
+                      (old-prof (derivation-path->output-path old-drv))
                       (number   (latest-profile-number profile))
                       (name     (format #f "~a/~a-~a-link"
                                         (dirname profile)
                                         (basename profile) (+ 1 number))))
-                 (and (build-derivations %store (list prof-drv))
-                      (begin
-                        (symlink prof name)
-                        (when (file-exists? profile)
-                          (delete-file profile))
-                        (symlink name profile))))))))
+                 (if (string=? old-prof prof)
+                     (format (current-error-port) (_ "nothing to be done~%"))
+                     (and (build-derivations %store (list prof-drv))
+                          (begin
+                            (symlink prof name)
+                            (when (file-exists? profile)
+                              (delete-file profile))
+                            (symlink name profile)))))))))
 
   (define (process-query opts)
     ;; Process any query specified by OPTS.  Return #t when a query was