summary refs log tree commit diff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-09-23 00:35:17 +0200
committerLudovic Courtès <ludo@gnu.org>2013-09-23 00:35:17 +0200
commit5608847c6f4131e8f30321fdf25289efd73f8689 (patch)
tree5a5910165d29455b249fd4d6612078ff5cf6ced5 /tests
parent0c456db45bf03df61cdb71db7742a44f4328fb3d (diff)
parentf59e9eaac87b4365c646a475d44b431e43949649 (diff)
downloadguix-5608847c6f4131e8f30321fdf25289efd73f8689.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'tests')
-rw-r--r--tests/builders.scm8
-rw-r--r--tests/derivations.scm218
-rw-r--r--tests/guix-package.sh6
-rw-r--r--tests/guix-register.sh74
-rw-r--r--tests/packages.scm38
-rw-r--r--tests/store.scm36
-rw-r--r--tests/ui.scm85
-rw-r--r--tests/union.scm2
8 files changed, 307 insertions, 160 deletions
diff --git a/tests/builders.scm b/tests/builders.scm
index 1e6b62ee6a..0ed5d74a22 100644
--- a/tests/builders.scm
+++ b/tests/builders.scm
@@ -70,10 +70,10 @@
                      "ftp://ftp.gnu.org/gnu/hello/hello-2.8.tar.gz"))
          (hash     (nix-base32-string->bytevector
                     "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6"))
-         (drv-path (url-fetch %store url 'sha256 hash
+         (drv      (url-fetch %store url 'sha256 hash
                               #:guile %bootstrap-guile))
-         (out-path (derivation-path->output-path drv-path)))
-    (and (build-derivations %store (list drv-path))
+         (out-path (derivation->output-path drv)))
+    (and (build-derivations %store (list drv))
          (file-exists? out-path)
          (valid-path? %store out-path))))
 
@@ -93,7 +93,7 @@
                               #:implicit-inputs? #f
                               #:guile %bootstrap-guile
                               #:search-paths %bootstrap-search-paths))
-         (out      (derivation-path->output-path build)))
+         (out      (derivation->output-path build)))
     (and (build-derivations %store (list (pk 'hello-drv build)))
          (valid-path? %store out)
          (file-exists? (string-append out "/bin/hello")))))
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 9092e3acd6..4756fb9cba 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -110,29 +110,26 @@
   (let* ((builder  (add-text-to-store %store "my-builder.sh"
                                       "echo hello, world\n"
                                       '()))
-         (drv-path (derivation %store "foo"
+         (drv      (derivation %store "foo"
                                %bash `("-e" ,builder)
                                #:env-vars '(("HOME" . "/homeless")))))
-    (and (store-path? drv-path)
-         (valid-path? %store drv-path))))
+    (and (store-path? (derivation-file-name drv))
+         (valid-path? %store (derivation-file-name drv)))))
 
 (test-assert "build derivation with 1 source"
-  (let*-values (((builder)
-                 (add-text-to-store %store "my-builder.sh"
-                                    "echo hello, world > \"$out\"\n"
-                                    '()))
-                ((drv-path drv)
-                 (derivation %store "foo"
-                             %bash `(,builder)
-                             #:env-vars '(("HOME" . "/homeless")
-                                          ("zzz"  . "Z!")
-                                          ("AAA"  . "A!"))
-                             #:inputs `((,builder))))
-                ((succeeded?)
-                 (build-derivations %store (list drv-path))))
+  (let* ((builder (add-text-to-store %store "my-builder.sh"
+                                     "echo hello, world > \"$out\"\n"
+                                     '()))
+         (drv     (derivation %store "foo"
+                              %bash `(,builder)
+                              #:env-vars '(("HOME" . "/homeless")
+                                           ("zzz"  . "Z!")
+                                           ("AAA"  . "A!"))
+                              #:inputs `((,builder))))
+         (succeeded?
+          (build-derivations %store (list drv))))
     (and succeeded?
-         (let ((path (derivation-output-path
-                      (assoc-ref (derivation-outputs drv) "out"))))
+         (let ((path (derivation->output-path drv)))
            (and (valid-path? %store path)
                 (string=? (call-with-input-file path read-line)
                           "hello, world"))))))
@@ -145,7 +142,7 @@
          (input      (search-path %load-path "ice-9/boot-9.scm"))
          (input*     (add-to-store %store (basename input)
                                    #t "sha256" input))
-         (drv-path   (derivation %store "derivation-with-input-file"
+         (drv        (derivation %store "derivation-with-input-file"
                                  %bash `(,builder)
 
                                  ;; Cheat to pass the actual file name to the
@@ -154,22 +151,22 @@
 
                                  #:inputs `((,builder)
                                             (,input))))) ; ← local file name
-    (and (build-derivations %store (list drv-path))
+    (and (build-derivations %store (list drv))
          ;; Note: we can't compare the files because the above trick alters
          ;; the contents.
-         (valid-path? %store (derivation-path->output-path drv-path)))))
+         (valid-path? %store (derivation->output-path drv)))))
 
 (test-assert "fixed-output derivation"
   (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
                                         "echo -n hello > $out" '()))
          (hash       (sha256 (string->utf8 "hello")))
-         (drv-path   (derivation %store "fixed"
+         (drv        (derivation %store "fixed"
                                  %bash `(,builder)
                                  #:inputs `((,builder)) ; optional
                                  #:hash hash #:hash-algo 'sha256))
-         (succeeded? (build-derivations %store (list drv-path))))
+         (succeeded? (build-derivations %store (list drv))))
     (and succeeded?
-         (let ((p (derivation-path->output-path drv-path)))
+         (let ((p (derivation->output-path drv)))
            (and (equal? (string->utf8 "hello")
                         (call-with-input-file p get-bytevector-all))
                 (bytevector? (query-path-hash %store p)))))))
@@ -180,17 +177,16 @@
          (builder2   (add-text-to-store %store "fixed-builder2.sh"
                                         "echo hey; echo -n hello > $out" '()))
          (hash       (sha256 (string->utf8 "hello")))
-         (drv-path1  (derivation %store "fixed"
+         (drv1       (derivation %store "fixed"
                                  %bash `(,builder1)
                                  #:hash hash #:hash-algo 'sha256))
-         (drv-path2  (derivation %store "fixed"
+         (drv2       (derivation %store "fixed"
                                  %bash `(,builder2)
                                  #:hash hash #:hash-algo 'sha256))
-         (succeeded? (build-derivations %store
-                                        (list drv-path1 drv-path2))))
+         (succeeded? (build-derivations %store (list drv1 drv2))))
     (and succeeded?
-         (equal? (derivation-path->output-path drv-path1)
-                 (derivation-path->output-path drv-path2)))))
+         (equal? (derivation->output-path drv1)
+                 (derivation->output-path drv2)))))
 
 (test-assert "derivation with a fixed-output input"
   ;; A derivation D using a fixed-output derivation F doesn't has the same
@@ -207,7 +203,7 @@
          (fixed2     (derivation %store "fixed"
                                  %bash `(,builder2)
                                  #:hash hash #:hash-algo 'sha256))
-         (fixed-out  (derivation-path->output-path fixed1))
+         (fixed-out  (derivation->output-path fixed1))
          (builder3   (add-text-to-store
                       %store "final-builder.sh"
                       ;; Use Bash hackery to avoid Coreutils.
@@ -223,26 +219,26 @@
          (succeeded? (build-derivations %store
                                         (list final1 final2))))
     (and succeeded?
-         (equal? (derivation-path->output-path final1)
-                 (derivation-path->output-path final2)))))
+         (equal? (derivation->output-path final1)
+                 (derivation->output-path final2)))))
 
 (test-assert "multiple-output derivation"
   (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
                                         "echo one > $out ; echo two > $second"
                                         '()))
-         (drv-path   (derivation %store "fixed"
+         (drv        (derivation %store "fixed"
                                  %bash `(,builder)
                                  #:env-vars '(("HOME" . "/homeless")
                                               ("zzz"  . "Z!")
                                               ("AAA"  . "A!"))
                                  #:inputs `((,builder))
                                  #:outputs '("out" "second")))
-         (succeeded? (build-derivations %store (list drv-path))))
+         (succeeded? (build-derivations %store (list drv))))
     (and succeeded?
-         (let ((one (derivation-path->output-path drv-path "out"))
-               (two (derivation-path->output-path drv-path "second")))
+         (let ((one (derivation->output-path drv "out"))
+               (two (derivation->output-path drv "second")))
            (and (lset= equal?
-                       (derivation-path->output-paths drv-path)
+                       (derivation->output-paths drv)
                        `(("out" . ,one) ("second" . ,two)))
                 (eq? 'one (call-with-input-file one read))
                 (eq? 'two (call-with-input-file two read)))))))
@@ -253,14 +249,14 @@
   (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
                                         "echo one > $out ; echo two > $AAA"
                                         '()))
-         (drv-path   (derivation %store "fixed"
+         (drv        (derivation %store "fixed"
                                  %bash `(,builder)
                                  #:inputs `((,builder))
                                  #:outputs '("out" "AAA")))
-         (succeeded? (build-derivations %store (list drv-path))))
+         (succeeded? (build-derivations %store (list drv))))
     (and succeeded?
-         (let ((one (derivation-path->output-path drv-path "out"))
-               (two (derivation-path->output-path drv-path "AAA")))
+         (let ((one (derivation->output-path drv "out"))
+               (two (derivation->output-path drv "AAA")))
            (and (eq? 'one (call-with-input-file one read))
                 (eq? 'two (call-with-input-file two read)))))))
 
@@ -282,17 +278,17 @@
          (udrv       (derivation %store "multiple-output-user"
                                  %bash `(,builder2)
                                  #:env-vars `(("one"
-                                               . ,(derivation-path->output-path
+                                               . ,(derivation->output-path
                                                    mdrv "out"))
                                               ("two"
-                                               . ,(derivation-path->output-path
+                                               . ,(derivation->output-path
                                                    mdrv "two")))
                                  #:inputs `((,builder2)
                                             ;; two occurrences of MDRV:
                                             (,mdrv)
                                             (,mdrv "two")))))
     (and (build-derivations %store (list (pk 'udrv udrv)))
-         (let ((p (derivation-path->output-path udrv)))
+         (let ((p (derivation->output-path udrv)))
            (and (valid-path? %store p)
                 (equal? '(one two) (call-with-input-file p read)))))))
 
@@ -317,7 +313,7 @@
                                 ("input1" . ,input1)
                                 ("input2" . ,input2))
                               #:inputs `((,%bash) (,builder))))
-         (out     (derivation-path->output-path drv)))
+         (out     (derivation->output-path drv)))
     (define (deps path . deps)
       (let ((count (length deps)))
         (string-append path "\n\n" (number->string count) "\n"
@@ -360,31 +356,30 @@
           (add-text-to-store %store "build-with-coreutils.sh"
                              "echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good"
                              '()))
-         (drv-path
+         (drv
           (derivation %store "foo"
                       %bash `(,builder)
                       #:env-vars `(("PATH" .
                                     ,(string-append
-                                      (derivation-path->output-path %coreutils)
+                                      (derivation->output-path %coreutils)
                                       "/bin")))
                       #:inputs `((,builder)
                                  (,%coreutils))))
          (succeeded?
-          (build-derivations %store (list drv-path))))
+          (build-derivations %store (list drv))))
     (and succeeded?
-         (let ((p (derivation-path->output-path drv-path)))
+         (let ((p (derivation->output-path drv)))
            (and (valid-path? %store p)
                 (file-exists? (string-append p "/good")))))))
 
 (test-skip (if (%guile-for-build) 0 8))
 
 (test-assert "build-expression->derivation and derivation-prerequisites"
-  (let-values (((drv-path drv)
-                (build-expression->derivation %store "fail" (%current-system)
-                                              #f '())))
+  (let ((drv (build-expression->derivation %store "fail" (%current-system)
+                                           #f '())))
     (any (match-lambda
           (($ <derivation-input> path)
-           (string=? path (%guile-for-build))))
+           (string=? path (derivation-file-name (%guile-for-build)))))
          (derivation-prerequisites drv))))
 
 (test-assert "build-expression->derivation without inputs"
@@ -393,11 +388,11 @@
                         (call-with-output-file (string-append %output "/test")
                           (lambda (p)
                             (display '(hello guix) p)))))
-         (drv-path   (build-expression->derivation %store "goo" (%current-system)
+         (drv       (build-expression->derivation %store "goo" (%current-system)
                                                    builder '()))
-         (succeeded? (build-derivations %store (list drv-path))))
+         (succeeded? (build-derivations %store (list drv))))
     (and succeeded?
-         (let ((p (derivation-path->output-path drv-path)))
+         (let ((p (derivation->output-path drv)))
            (equal? '(hello guix)
                    (call-with-input-file (string-append p "/test") read))))))
 
@@ -406,43 +401,35 @@
                        (set-build-options s #:max-silent-time 1)
                        s))
          (builder    '(sleep 100))
-         (drv-path   (build-expression->derivation %store "silent"
+         (drv        (build-expression->derivation %store "silent"
                                                    (%current-system)
                                                    builder '()))
-         (out-path   (derivation-path->output-path drv-path)))
+         (out-path   (derivation->output-path drv)))
     (guard (c ((nix-protocol-error? c)
                (and (string-contains (nix-protocol-error-message c)
                                      "failed")
                     (not (valid-path? store out-path)))))
-      (build-derivations %store (list drv-path)))))
+      (build-derivations %store (list drv)))))
 
 (test-assert "build-expression->derivation and derivation-prerequisites-to-build"
-  (let-values (((drv-path drv)
-                (build-expression->derivation %store "fail" (%current-system)
-                                              #f '())))
+  (let ((drv (build-expression->derivation %store "fail" (%current-system)
+                                           #f '())))
     ;; The only direct dependency is (%guile-for-build) and it's already
     ;; built.
     (null? (derivation-prerequisites-to-build %store drv))))
 
 (test-assert "derivation-prerequisites-to-build when outputs already present"
-  (let*-values (((builder)
-                 '(begin (mkdir %output) #t))
-                ((input-drv-path input-drv)
-                 (build-expression->derivation %store "input"
-                                               (%current-system)
-                                               builder '()))
-                ((input-path)
-                 (derivation-output-path
-                  (assoc-ref (derivation-outputs input-drv)
-                             "out")))
-                ((drv-path drv)
-                 (build-expression->derivation %store "something"
-                                               (%current-system)
-                                               builder
-                                               `(("i" ,input-drv-path))))
-                ((output)
-                 (derivation-output-path
-                  (assoc-ref (derivation-outputs drv) "out"))))
+  (let* ((builder    '(begin (mkdir %output) #t))
+         (input-drv  (build-expression->derivation %store "input"
+                                                   (%current-system)
+                                                   builder '()))
+         (input-path (derivation-output-path
+                      (assoc-ref (derivation-outputs input-drv)
+                                 "out")))
+         (drv        (build-expression->derivation %store "something"
+                                                   (%current-system) builder
+                                                   `(("i" ,input-drv))))
+         (output     (derivation->output-path drv)))
     ;; Make sure these things are not already built.
     (when (valid-path? %store input-path)
       (delete-paths %store (list input-path)))
@@ -451,10 +438,10 @@
 
     (and (equal? (map derivation-input-path
                       (derivation-prerequisites-to-build %store drv))
-                 (list input-drv-path))
+                 (list (derivation-file-name input-drv)))
 
          ;; Build DRV and delete its input.
-         (build-derivations %store (list drv-path))
+         (build-derivations %store (list drv))
          (delete-paths %store (list input-path))
          (not (valid-path? %store input-path))
 
@@ -464,17 +451,12 @@
 
 (test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1))
 (test-assert "derivation-prerequisites-to-build and substitutes"
-  (let*-values (((store)
-                 (open-connection))
-                ((drv-path drv)
-                 (build-expression->derivation store "prereq-subst"
+  (let* ((store  (open-connection))
+         (drv    (build-expression->derivation store "prereq-subst"
                                                (%current-system)
                                                (random 1000) '()))
-                ((output)
-                 (derivation-output-path
-                  (assoc-ref (derivation-outputs drv) "out")))
-                ((dir)
-                 (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
+         (output (derivation->output-path drv))
+         (dir    (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
                         (compose uri-path string->uri))))
     ;; Create fake substituter data, to be read by `substitute-binary'.
     (call-with-output-file (string-append dir "/nix-cache-info")
@@ -494,7 +476,8 @@ Deriver: ~a~%"
                 output                              ; StorePath
                 (string-append dir "/example.nar")  ; URL
                 (%current-system)                   ; System
-                (basename drv-path))))              ; Deriver
+                (basename
+                 (derivation-file-name drv)))))     ; Deriver
 
     (let-values (((build download)
                   (derivation-prerequisites-to-build store drv))
@@ -511,16 +494,16 @@ Deriver: ~a~%"
   (let* ((builder  '(begin
                       (mkdir %output)
                       #f))                        ; fail!
-         (drv-path (build-expression->derivation %store "fail" (%current-system)
+         (drv      (build-expression->derivation %store "fail" (%current-system)
                                                  builder '()))
-         (out-path (derivation-path->output-path drv-path)))
+         (out-path (derivation->output-path drv)))
     (guard (c ((nix-protocol-error? c)
                ;; Note that the output path may exist at this point, but it
                ;; is invalid.
                (and (string-match "build .* failed"
                                   (nix-protocol-error-message c))
                     (not (valid-path? %store out-path)))))
-      (build-derivations %store (list drv-path))
+      (build-derivations %store (list drv))
       #f)))
 
 (test-assert "build-expression->derivation with two outputs"
@@ -531,15 +514,15 @@ Deriver: ~a~%"
                         (call-with-output-file (assoc-ref %outputs "second")
                           (lambda (p)
                             (display '(world) p)))))
-         (drv-path   (build-expression->derivation %store "double"
+         (drv        (build-expression->derivation %store "double"
                                                    (%current-system)
                                                    builder '()
                                                    #:outputs '("out"
                                                                "second")))
-         (succeeded? (build-derivations %store (list drv-path))))
+         (succeeded? (build-derivations %store (list drv))))
     (and succeeded?
-         (let ((one (derivation-path->output-path drv-path))
-               (two (derivation-path->output-path drv-path "second")))
+         (let ((one (derivation->output-path drv))
+               (two (derivation->output-path drv "second")))
            (and (equal? '(hello) (call-with-input-file one read))
                 (equal? '(world) (call-with-input-file two read)))))))
 
@@ -552,12 +535,12 @@ Deriver: ~a~%"
                             (dup2 (port->fdes p) 1)
                             (execl (string-append cu "/bin/uname")
                                    "uname" "-a")))))
-         (drv-path   (build-expression->derivation %store "uname" (%current-system)
+         (drv        (build-expression->derivation %store "uname" (%current-system)
                                                    builder
                                                    `(("cu" ,%coreutils))))
-         (succeeded? (build-derivations %store (list drv-path))))
+         (succeeded? (build-derivations %store (list drv))))
     (and succeeded?
-         (let ((p (derivation-path->output-path drv-path)))
+         (let ((p (derivation->output-path drv)))
            (string-contains (call-with-input-file p read-line) "GNU")))))
 
 (test-assert "imported-files"
@@ -566,9 +549,9 @@ Deriver: ~a~%"
                                               "guix/derivations.scm"))
                      ("p/q"   . ,(search-path %load-path "guix.scm"))
                      ("p/z"   . ,(search-path %load-path "guix/store.scm"))))
-         (drv-path (imported-files %store files)))
-    (and (build-derivations %store (list drv-path))
-         (let ((dir (derivation-path->output-path drv-path)))
+         (drv      (imported-files %store files)))
+    (and (build-derivations %store (list drv))
+         (let ((dir (derivation->output-path drv)))
            (every (match-lambda
                    ((path . source)
                     (equal? (call-with-input-file (string-append dir "/" path)
@@ -583,14 +566,13 @@ Deriver: ~a~%"
                       (let ((out (assoc-ref %outputs "out")))
                         (mkdir-p (string-append out "/guile/guix/nix"))
                         #t)))
-         (drv-path (build-expression->derivation %store
-                                                 "test-with-modules"
+         (drv      (build-expression->derivation %store "test-with-modules"
                                                  (%current-system)
                                                  builder '()
                                                  #:modules
                                                  '((guix build utils)))))
-    (and (build-derivations %store (list drv-path))
-         (let* ((p (derivation-path->output-path drv-path))
+    (and (build-derivations %store (list drv))
+         (let* ((p (derivation->output-path drv))
                 (s (stat (string-append p "/guile/guix/nix"))))
            (eq? (stat:type s) 'directory)))))
 
@@ -614,9 +596,10 @@ Deriver: ~a~%"
                                                    #:hash-algo 'sha256))
          (succeeded? (build-derivations %store (list input1 input2))))
     (and succeeded?
-         (not (string=? input1 input2))
-         (string=? (derivation-path->output-path input1)
-                   (derivation-path->output-path input2)))))
+         (not (string=? (derivation-file-name input1)
+                        (derivation-file-name input2)))
+         (string=? (derivation->output-path input1)
+                   (derivation->output-path input2)))))
 
 (test-assert "build-expression->derivation with a fixed-output input"
   (let* ((builder1   '(call-with-output-file %output
@@ -648,8 +631,11 @@ Deriver: ~a~%"
                                                   (%current-system)
                                                   builder3
                                                   `(("input" ,input2)))))
-    (and (string=? (derivation-path->output-path final1)
-                   (derivation-path->output-path final2))
+    (and (string=? (derivation->output-path final1)
+                   (derivation->output-path final2))
+         (string=? (derivation->output-path final1)
+                   (derivation-path->output-path
+                    (derivation-file-name final1)))
          (build-derivations %store (list final1 final2)))))
 
 (test-assert "build-expression->derivation with #:references-graphs"
@@ -661,7 +647,7 @@ Deriver: ~a~%"
                                                 builder '()
                                                 #:references-graphs
                                                 `(("input" . ,input))))
-         (out     (derivation-path->output-path drv)))
+         (out     (derivation->output-path drv)))
     (define (deps path . deps)
       (let ((count (length deps)))
         (string-append path "\n\n" (number->string count) "\n"
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index ee186ead83..b09a9c0173 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -55,7 +55,7 @@ test "`guix package --search-paths -p "$profile" | wc -l`" = 0
 if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null
 then
     boot_make="(@@ (gnu packages base) gnu-make-boot0)"
-    boot_make_drv="`guix build -e "$boot_make" | tail -1`"
+    boot_make_drv="`guix build -e "$boot_make" | grep -v -e -debug`"
     guix package --bootstrap -p "$profile" -i "$boot_make_drv"
     test -L "$profile-2-link"
     test -f "$profile/bin/make" && test -f "$profile/bin/guile"
@@ -81,6 +81,10 @@ then
         "name: hello"
     test "`guix package -s "n0t4r341p4ck4g3"`" = ""
 
+    # List generations.
+    test "`guix package -p "$profile" -l | cut -f1 | grep guile | head -n1`" \
+        = "  guile-bootstrap"
+
     # Remove a package.
     guix package --bootstrap -p "$profile" -r "guile-bootstrap"
     test -L "$profile-3-link"
diff --git a/tests/guix-register.sh b/tests/guix-register.sh
new file mode 100644
index 0000000000..b76a1af54f
--- /dev/null
+++ b/tests/guix-register.sh
@@ -0,0 +1,74 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+#
+# This file is part of GNU Guix.
+#
+# GNU Guix is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# GNU Guix is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+#
+# Test the 'guix-register' command-line utility.
+#
+
+guix-register --version
+
+new_store="t-register-$$"
+closure="t-register-closure-$$"
+rm -rf "$new_store"
+
+exit_hook=":"
+trap "chmod -R +w $new_store ; rm -rf $new_store $closure ; \$exit_hook" EXIT
+
+mkdir -p "$new_store/$storedir"
+new_store_dir="`cd "$new_store/$storedir" ; pwd`"
+new_store="`cd "$new_store" ; pwd`"
+
+to_copy="`guix build guile-bootstrap`"
+cp -r "$to_copy" "$new_store_dir"
+copied="$new_store_dir/`basename $to_copy`"
+
+# Create a file representing a closure with zero references, and with an empty
+# "deriver" field.
+cat >> "$closure" <<EOF
+$copied
+
+0
+EOF
+
+# Register it.
+guix-register -p "$new_store" < "$closure"
+
+# Doing it a second time shouldn't hurt.
+guix-register -p "$new_store" "$closure"
+
+# Now make sure this is recognized as valid.
+
+NIX_IGNORE_SYMLINK_STORE=1
+NIX_STORE_DIR="$new_store_dir"
+NIX_LOCALSTATE_DIR="$new_store$localstatedir"
+NIX_LOG_DIR="$new_store$localstatedir/log/nix"
+NIX_DB_DIR="$new_store$localstatedir/nix/db"
+
+export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR NIX_LOCALSTATE_DIR	\
+  NIX_LOG_DIR NIX_DB_DIR
+
+guix-daemon --disable-chroot &
+subdaemon_pid=$!
+exit_hook="kill $subdaemon_pid"
+
+# At this point the copy in $new_store must be valid, and unreferenced.
+guile -c "
+   (use-modules (guix store))
+   (define s (open-connection))
+   (exit (and (valid-path? s \"$copied\")
+              (equal? (list \"$copied\") (dead-paths s))))"
diff --git a/tests/packages.scm b/tests/packages.scm
index 8619011f59..706739fb70 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -121,17 +121,16 @@
                                              (package-source package))))
     (string=? file source)))
 
-(test-assert "return values"
-  (let-values (((drv-path drv)
-                (package-derivation %store (dummy-package "p"))))
-    (and (derivation-path? drv-path)
-         (derivation? drv))))
+(test-assert "return value"
+  (let ((drv (package-derivation %store (dummy-package "p"))))
+    (and (derivation? drv)
+         (file-exists? (derivation-file-name drv)))))
 
 (test-assert "package-output"
   (let* ((package  (dummy-package "p"))
-         (drv-path (package-derivation %store package)))
-    (and (derivation-path? drv-path)
-         (string=? (derivation-path->output-path drv-path)
+         (drv      (package-derivation %store package)))
+    (and (derivation? drv)
+         (string=? (derivation->output-path drv)
                    (package-output %store package "out")))))
 
 (test-assert "trivial"
@@ -148,7 +147,7 @@
                        (display '(hello guix) p))))))))
          (d (package-derivation %store p)))
     (and (build-derivations %store (list d))
-         (let ((p (pk 'drv d (derivation-path->output-path d))))
+         (let ((p (pk 'drv d (derivation->output-path d))))
            (equal? '(hello guix)
                    (call-with-input-file (string-append p "/test") read))))))
 
@@ -164,7 +163,7 @@
               (inputs `(("input" ,i)))))
          (d (package-derivation %store p)))
     (and (build-derivations %store (list d))
-         (let ((p (pk 'drv d (derivation-path->output-path d))))
+         (let ((p (pk 'drv d (derivation->output-path d))))
            (equal? (call-with-input-file p get-bytevector-all)
                    (call-with-input-file i get-bytevector-all))))))
 
@@ -183,7 +182,7 @@
                                                           (%current-system)))))))
          (d (package-derivation %store p)))
     (and (build-derivations %store (list d))
-         (let ((p (pk 'drv d (derivation-path->output-path d))))
+         (let ((p (pk 'drv d (derivation->output-path d))))
            (eq? 'hello (call-with-input-file p read))))))
 
 (test-assert "search paths"
@@ -222,20 +221,17 @@
            (equal? x (collect (package-derivation %store c)))))))
 
 (test-assert "package-cross-derivation"
-  (let-values (((drv-path drv)
-                (package-cross-derivation %store (dummy-package "p")
-                                          "mips64el-linux-gnu")))
-    (and (derivation-path? drv-path)
-         (derivation? drv))))
+  (let ((drv (package-cross-derivation %store (dummy-package "p")
+                                       "mips64el-linux-gnu")))
+    (and (derivation? drv)
+         (file-exists? (derivation-file-name drv)))))
 
 (test-assert "package-cross-derivation, trivial-build-system"
   (let ((p (package (inherit (dummy-package "p"))
              (build-system trivial-build-system)
              (arguments '(#:builder (exit 1))))))
-    (let-values (((drv-path drv)
-                  (package-cross-derivation %store p "mips64el-linux-gnu")))
-      (and (derivation-path? drv-path)
-           (derivation? drv)))))
+    (let ((drv (package-cross-derivation %store p "mips64el-linux-gnu")))
+      (derivation? drv))))
 
 (test-assert "package-cross-derivation, no cross builder"
   (let* ((b (build-system (inherit trivial-build-system)
@@ -257,7 +253,7 @@
          (or (location? (package-location gnu-make))
              (not (package-location gnu-make)))
          (let* ((drv (package-derivation %store gnu-make))
-                (out (derivation-path->output-path drv)))
+                (out (derivation->output-path drv)))
            (and (build-derivations %store (list drv))
                 (file-exists? (string-append out "/bin/make")))))))
 
diff --git a/tests/store.scm b/tests/store.scm
index 9625a6b308..b5e0cb0eab 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -68,8 +68,7 @@
 (test-skip (if %store 0 10))
 
 (test-assert "dead-paths"
-  (let ((p (add-text-to-store %store "random-text"
-                              (random-text) '())))
+  (let ((p (add-text-to-store %store "random-text" (random-text))))
     (member p (dead-paths %store))))
 
 ;; FIXME: Find a test for `live-paths'.
@@ -83,7 +82,7 @@
 ;;          (d1 (derivation %store "link"
 ;;                          "/bin/sh" `("-e" ,b)
 ;;                          #:inputs `((,b) (,p1))))
-;;          (p2 (derivation-path->output-path d1)))
+;;          (p2 (derivation->output-path d1)))
 ;;     (and (add-temp-root %store p2)
 ;;          (build-derivations %store (list d1))
 ;;          (valid-path? %store p1)
@@ -99,7 +98,7 @@
 
 (test-assert "references"
   (let* ((t1 (add-text-to-store %store "random1"
-                                (random-text) '()))
+                                (random-text)))
          (t2 (add-text-to-store %store "random2"
                                 (random-text) (list t1))))
     (and (equal? (list t1) (references %store t2))
@@ -134,21 +133,21 @@
                         s `("-e" ,b)
                         #:env-vars `(("foo" . ,(random-text)))
                         #:inputs `((,b) (,s))))
-         (o (derivation-path->output-path d)))
+         (o (derivation->output-path d)))
     (and (build-derivations %store (list d))
-         (equal? (query-derivation-outputs %store d)
+         (equal? (query-derivation-outputs %store (derivation-file-name d))
                  (list o))
          (equal? (valid-derivers %store o)
-                 (list d)))))
+                 (list (derivation-file-name d))))))
 
 (test-assert "no substitutes"
   (let* ((s  (open-connection))
          (d1 (package-derivation s %bootstrap-guile (%current-system)))
          (d2 (package-derivation s %bootstrap-glibc (%current-system)))
-         (o  (map derivation-path->output-path (list d1 d2))))
+         (o  (map derivation->output-path (list d1 d2))))
     (set-build-options s #:use-substitutes? #f)
-    (and (not (has-substitutes? s d1))
-         (not (has-substitutes? s d2))
+    (and (not (has-substitutes? s (derivation-file-name d1)))
+         (not (has-substitutes? s (derivation-file-name d2)))
          (null? (substitutable-paths s o))
          (null? (substitutable-path-info s o)))))
 
@@ -157,7 +156,7 @@
 (test-assert "substitute query"
   (let* ((s   (open-connection))
          (d   (package-derivation s %bootstrap-guile (%current-system)))
-         (o   (derivation-path->output-path d))
+         (o   (derivation->output-path d))
          (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
                      (compose uri-path string->uri))))
     ;; Create fake substituter data, to be read by `substitute-binary'.
@@ -178,7 +177,8 @@ Deriver: ~a~%"
                 o                                   ; StorePath
                 (string-append dir "/example.nar")  ; URL
                 (%current-system)                   ; System
-                (basename d))))                     ; Deriver
+                (basename
+                 (derivation-file-name d)))))       ; Deriver
 
     ;; Remove entry from the local cache.
     (false-if-exception
@@ -192,7 +192,7 @@ Deriver: ~a~%"
          (equal? (list o) (substitutable-paths s (list o)))
          (match (pk 'spi (substitutable-path-info s (list o)))
            (((? substitutable? s))
-            (and (equal? (substitutable-deriver s) d)
+            (and (string=? (substitutable-deriver s) (derivation-file-name d))
                  (null? (substitutable-references s))
                  (equal? (substitutable-nar-size s) 1234)))))))
 
@@ -208,7 +208,7 @@ Deriver: ~a~%"
                '()
                #:guile-for-build
                (package-derivation s %bootstrap-guile (%current-system))))
-         (o   (derivation-path->output-path d))
+         (o   (derivation->output-path d))
          (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
                      (compose uri-path string->uri))))
     ;; Create fake substituter data, to be read by `substitute-binary'.
@@ -239,7 +239,8 @@ Deriver: ~a~%"
                   (compose bytevector->nix-base32-string sha256
                            get-bytevector-all))
                 (%current-system)                   ; System
-                (basename d))))                     ; Deriver
+                (basename
+                 (derivation-file-name d)))))       ; Deriver
 
     ;; Make sure we use `substitute-binary'.
     (set-build-options s #:use-substitutes? #t)
@@ -258,7 +259,7 @@ Deriver: ~a~%"
                '()
                #:guile-for-build
                (package-derivation s %bootstrap-guile (%current-system))))
-         (o   (derivation-path->output-path d))
+         (o   (derivation->output-path d))
          (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
                      (compose uri-path string->uri))))
     ;; Create fake substituter data, to be read by `substitute-binary'.
@@ -280,7 +281,8 @@ Deriver: ~a~%"
                 o                                   ; StorePath
                 "does-not-exist.nar"                ; relative URL
                 (%current-system)                   ; System
-                (basename d))))                     ; Deriver
+                (basename
+                 (derivation-file-name d)))))       ; Deriver
 
     ;; Make sure we use `substitute-binary'.
     (set-build-options s #:use-substitutes? #t)
diff --git a/tests/ui.scm b/tests/ui.scm
index 0b6f3c5815..3d5c3e7969 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -20,6 +20,7 @@
 (define-module (test-ui)
   #:use-module (guix ui)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-64))
 
 ;; Test the (guix ui) module.
@@ -64,6 +65,90 @@ interface, and powerful string processing.")
                    10)
    #\newline))
 
+(test-equal "integer"
+  '(1)
+  (string->generations "1"))
+
+(test-equal "comma-separated integers"
+  '(3 7 1 4 6)
+  (string->generations "3,7,1,4,6"))
+
+(test-equal "closed range"
+  '(4 5 6 7 8 9 10 11 12)
+  (string->generations "4..12"))
+
+(test-equal "closed range, equal endpoints"
+  '(3)
+  (string->generations "3..3"))
+
+(test-equal "indefinite end range"
+  '(>= 7)
+  (string->generations "7.."))
+
+(test-equal "indefinite start range"
+  '(<= 42)
+  (string->generations "..42"))
+
+(test-equal "integer, char"
+  #f
+  (string->generations "a"))
+
+(test-equal "comma-separated integers, consecutive comma"
+  #f
+  (string->generations "1,,2"))
+
+(test-equal "comma-separated integers, trailing comma"
+  #f
+  (string->generations "1,2,"))
+
+(test-equal "comma-separated integers, chars"
+  #f
+  (string->generations "a,b"))
+
+(test-equal "closed range, start > end"
+  #f
+  (string->generations "9..2"))
+
+(test-equal "closed range, chars"
+  #f
+  (string->generations "a..b"))
+
+(test-equal "indefinite end range, char"
+  #f
+  (string->generations "a.."))
+
+(test-equal "indefinite start range, char"
+  #f
+  (string->generations "..a"))
+
+(test-equal "duration, 1 day"
+  (make-time time-duration 0 (* 3600 24))
+  (string->duration "1d"))
+
+(test-equal "duration, 1 week"
+  (make-time time-duration 0 (* 3600 24 7))
+  (string->duration "1w"))
+
+(test-equal "duration, 1 month"
+  (make-time time-duration 0 (* 3600 24 30))
+  (string->duration "1m"))
+
+(test-equal "duration, 1 week == 7 days"
+  (string->duration "1w")
+  (string->duration "7d"))
+
+(test-equal "duration, 1 month == 30 days"
+  (string->duration "1m")
+  (string->duration "30d"))
+
+(test-equal "duration, integer"
+  #f
+  (string->duration "1"))
+
+(test-equal "duration, char"
+  #f
+  (string->duration "d"))
+
 (test-end "ui")
 
 
diff --git a/tests/union.scm b/tests/union.scm
index 6287cffc38..cb110c3b1e 100644
--- a/tests/union.scm
+++ b/tests/union.scm
@@ -108,7 +108,7 @@
                                         builder inputs
                                         #:modules '((guix build union)))))
     (and (build-derivations %store (list (pk 'drv drv)))
-         (with-directory-excursion (derivation-path->output-path drv)
+         (with-directory-excursion (derivation->output-path drv)
            (and (file-exists? "bin/touch")
                 (file-exists? "bin/gcc")
                 (file-exists? "bin/ld")