summaryrefslogtreecommitdiff
path: root/guix-package.in
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-12-12 00:01:17 +0100
committerLudovic Courtès <ludo@gnu.org>2012-12-12 00:01:17 +0100
commit1c67d639d5497cdae5bf7a6ececdd789e8537a01 (patch)
treedef17e40cb40bd9b18c3949aa44f3a93691eb9b9 /guix-package.in
parenta09ec3a5af3eb38b31d4eff0f323a2c47b82c114 (diff)
downloadpatches-1c67d639d5497cdae5bf7a6ececdd789e8537a01.tar
patches-1c67d639d5497cdae5bf7a6ececdd789e8537a01.tar.gz
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.
Diffstat (limited to 'guix-package.in')
-rw-r--r--guix-package.in31
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