diff options
| -rw-r--r-- | guix-package.in | 65 | ||||
| -rw-r--r-- | tests/guix-package.sh | 6 |
2 files changed, 47 insertions, 24 deletions
diff --git a/guix-package.in b/guix-package.in index 5dd4724b53..217c888d2f 100644 --- a/guix-package.in +++ b/guix-package.in @@ -95,9 +95,9 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ (make-regexp (string-append "^" (regexp-quote (basename profile)) "-([0-9]+)"))) -(define (latest-profile-number profile) - "Return the identifying number of the latest generation of PROFILE. -PROFILE is the name of the symlink to the current generation." +(define (profile-numbers profile) + "Return the list of generation numbers of PROFILE, or '(0) if no +former profiles were found." (define* (scandir name #:optional (select? (const #t)) (entry<? (@ (ice-9 i18n) string-locale<?))) ;; XXX: Bug-fix version introduced in Guile v2.0.6-62-g139ce19. @@ -135,21 +135,35 @@ PROFILE is the name of the symlink to the current generation." (match (scandir (dirname profile) (cute regexp-exec (profile-regexp profile) <>)) (#f ; no profile directory - 0) + '(0)) (() ; no profiles - 0) + '(0)) ((profiles ...) ; former profiles around - (let ((numbers - (map (compose string->number - (cut match:substring <> 1) - (cut regexp-exec (profile-regexp profile) <>)) - profiles))) - (fold (lambda (number highest) - (if (> number highest) - number - highest)) - 0 - numbers))))) + (map (compose string->number + (cut match:substring <> 1) + (cute regexp-exec (profile-regexp profile) <>)) + profiles)))) + +(define (latest-profile-number profile) + "Return the identifying number of the latest generation of PROFILE. +PROFILE is the name of the symlink to the current generation." + (fold (lambda (number highest) + (if (> number highest) + number + highest)) + 0 + (profile-numbers profile))) + +(define (previous-profile-number profile number) + "Return the number of the generation before generation NUMBER of +PROFILE, or 0 if none exists. It could be NUMBER - 1, but it's not the +case when generations have been deleted (there are \"holes\")." + (fold (lambda (candidate highest) + (if (and (< candidate number) (> candidate highest)) + candidate + highest)) + 0 + (profile-numbers profile))) (define (profile-derivation store packages) "Return a derivation that builds a profile (a user environment) with @@ -192,12 +206,12 @@ all of PACKAGES, a list of name/version/output/path tuples." (define (roll-back profile) "Roll back to the previous generation of PROFILE." ;; XXX: Get the previous generation number from the manifest? - (let* ((number (profile-number profile)) - (previous-number (1- number)) + (let* ((number (profile-number profile)) + (previous-number (previous-profile-number profile number)) (previous-profile (format #f "~a/~a-~a-link" (dirname profile) profile previous-number)) - (manifest (string-append previous-profile "/manifest"))) + (manifest (string-append previous-profile "/manifest"))) (define (switch-link) ;; Atomically switch PROFILE to the previous profile. @@ -207,11 +221,14 @@ all of PACKAGES, a list of name/version/output/path tuples." (symlink previous-profile pivot) (rename-file pivot profile))) - (if (= number 0) - (leave (_ "error: `~a' is not a valid profile~%") profile) - (if (file-exists? previous-profile) - (switch-link) - (leave (_ "error: no previous profile; not rolling back~%")))))) + (cond ((zero? number) + (format (current-error-port) + (_ "error: `~a' is not a valid profile~%") + profile)) + ((or (zero? previous-number) + (not (file-exists? previous-profile))) + (leave (_ "error: no previous profile; not rolling back~%"))) + (else (switch-link))))) ;;; diff --git a/tests/guix-package.sh b/tests/guix-package.sh index fd778f4f4f..fc80939646 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -95,6 +95,12 @@ then guix-package --bootstrap -p "$profile" --roll-back -i "$boot_guile" test "`readlink_base "$profile"`" = "$profile-5-link" test -x "$profile/bin/guile" && test -x "$profile/bin/make" + + # Make a "hole" in the list of generations, and make sure we can + # roll back "over" it. + rm "$profile-4-link" + guix-package --bootstrap -p "$profile" --roll-back + test "`readlink_base "$profile"`" = "$profile-3-link" fi # Make sure the `:' syntax works. |