gnu: linux-libre@5.4: Update to 5.4.66.
[jackhill/guix/guix.git] / tests / packages.scm
index f1e7d31..cbd0503 100644 (file)
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
   #:use-module (guix monads)
   #:use-module (guix grafts)
   #:use-module ((guix gexp) #:select (local-file local-file-file))
-  #:use-module ((guix utils)
+  #:use-module (guix utils)
+  #:use-module ((guix diagnostics)
                 ;; Rename the 'location' binding to allow proper syntax
                 ;; matching when setting the 'location' field of a package.
                 #:renamer (lambda (name)
                             (cond ((eq? name 'location) 'make-location)
                                   (else name))))
-  #:use-module (guix hash)
+  #:use-module ((gcrypt hash) #:prefix gcrypt:)
   #:use-module (guix derivations)
   #:use-module (guix packages)
   #:use-module (guix grafts)
@@ -36,6 +38,7 @@
   #:use-module (guix build-system)
   #:use-module (guix build-system trivial)
   #:use-module (guix build-system gnu)
+  #:use-module (guix memoization)
   #:use-module (guix profiles)
   #:use-module (guix scripts package)
   #:use-module (gnu packages)
@@ -49,6 +52,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-64)
+  #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 regex)
 
 (test-assert "transaction-upgrade-entry, zero upgrades"
   (let* ((old (dummy-package "foo" (version "1")))
-         (tx  (mock ((gnu packages) find-newest-available-packages
-                     (const vlist-null))
-                    ((@@ (guix scripts package) transaction-upgrade-entry)
+         (tx  (mock ((gnu packages) find-best-packages-by-name
+                     (const '()))
+                    (transaction-upgrade-entry
+                     #f                           ;no store access needed
                      (manifest-entry
                        (inherit (package->manifest-entry old))
                        (item (string-append (%store-prefix) "/"
                      (manifest-transaction)))))
     (manifest-transaction-null? tx)))
 
+(test-assert "transaction-upgrade-entry, zero upgrades, equivalent package"
+  (let* ((old (dummy-package "foo" (version "1")))
+         (drv (package-derivation %store old))
+         (tx  (mock ((gnu packages) find-best-packages-by-name
+                     (const (list old)))
+                    (transaction-upgrade-entry
+                     %store
+                     (manifest-entry
+                       (inherit (package->manifest-entry old))
+                       (item (derivation->output-path drv)))
+                     (manifest-transaction)))))
+    (manifest-transaction-null? tx)))
+
+(test-assert "transaction-upgrade-entry, zero upgrades, propagated inputs"
+  ;; Properly detect equivalent packages even when they have propagated
+  ;; inputs.  See <https://bugs.gnu.org/35872>.
+  (let* ((dep (dummy-package "dep" (version "2")))
+         (old (dummy-package "foo" (version "1")
+                             (propagated-inputs `(("dep" ,dep)))))
+         (drv (package-derivation %store old))
+         (tx  (mock ((gnu packages) find-best-packages-by-name
+                     (const (list old)))
+                    (transaction-upgrade-entry
+                     %store
+                     (manifest-entry
+                       (inherit (package->manifest-entry old))
+                       (item (derivation->output-path drv))
+                       (dependencies
+                        (list (manifest-entry
+                                (inherit (package->manifest-entry dep))
+                                (item (derivation->output-path
+                                       (package-derivation %store dep)))))))
+                     (manifest-transaction)))))
+    (manifest-transaction-null? tx)))
+
 (test-assert "transaction-upgrade-entry, one upgrade"
   (let* ((old (dummy-package "foo" (version "1")))
          (new (dummy-package "foo" (version "2")))
-         (tx  (mock ((gnu packages) find-newest-available-packages
-                     (const (vhash-cons "foo" (list "2" new) vlist-null)))
-                    ((@@ (guix scripts package) transaction-upgrade-entry)
+         (tx  (mock ((gnu packages) find-best-packages-by-name
+                     (const (list new)))
+                    (transaction-upgrade-entry
+                     #f                           ;no store access needed
                      (manifest-entry
                        (inherit (package->manifest-entry old))
                        (item (string-append (%store-prefix) "/"
   (let* ((old (dummy-package "foo" (version "1")))
          (new (dummy-package "bar" (version "2")))
          (dep (deprecated-package "foo" new))
-         (tx  (mock ((gnu packages) find-newest-available-packages
-                     (const (vhash-cons "foo" (list "2" dep) vlist-null)))
-                    ((@@ (guix scripts package) transaction-upgrade-entry)
+         (tx  (mock ((gnu packages) find-best-packages-by-name
+                     (const (list dep)))
+                    (transaction-upgrade-entry
+                     #f                           ;no store access needed
                      (manifest-entry
                        (inherit (package->manifest-entry old))
                        (item (string-append (%store-prefix) "/"
                  (string=? (manifest-pattern-version pattern) "1")
                  (string=? (manifest-pattern-output pattern) "out")))))))
 
+(test-assert "transaction-upgrade-entry, grafts"
+  ;; Ensure that, when grafts are enabled, 'transaction-upgrade-entry' doesn't
+  ;; try to build stuff.
+  (with-build-handler (const 'failed!)
+    (parameterize ((%graft? #t))
+      (let* ((old (dummy-package "foo" (version "1")))
+             (bar (dummy-package "bar" (version "0")
+                                 (replacement old)))
+             (new (dummy-package "foo" (version "1")
+                                 (inputs `(("bar" ,bar)))))
+             (tx  (mock ((gnu packages) find-best-packages-by-name
+                         (const (list new)))
+                        (transaction-upgrade-entry
+                         %store
+                         (manifest-entry
+                           (inherit (package->manifest-entry old))
+                           (item (string-append (%store-prefix) "/"
+                                                (make-string 32 #\e) "-foo-1")))
+                         (manifest-transaction)))))
+        (and (match (manifest-transaction-install tx)
+               ((($ <manifest-entry> "foo" "1" "out" item))
+                (eq? item new)))
+             (null? (manifest-transaction-remove tx)))))))
+
 (test-assert "package-field-location"
   (let ()
     (define (goto port line column)
           (package-transitive-supported-systems d)
           (package-transitive-supported-systems e))))
 
+(test-assert "package-closure"
+  (let-syntax ((dummy-package/no-implicit
+                (syntax-rules ()
+                  ((_ name rest ...)
+                   (package
+                     (inherit (dummy-package name rest ...))
+                     (build-system trivial-build-system))))))
+    (let* ((a (dummy-package/no-implicit "a"))
+           (b (dummy-package/no-implicit "b"
+                (propagated-inputs `(("a" ,a)))))
+           (c (dummy-package/no-implicit "c"
+                (inputs `(("a" ,a)))))
+           (d (dummy-package/no-implicit "d"
+                (native-inputs `(("b" ,b)))))
+           (e (dummy-package/no-implicit "e"
+                (inputs `(("c" ,c) ("d" ,d))))))
+      (lset= eq?
+             (list a b c d e)
+             (package-closure (list e))
+             (package-closure (list e d))
+             (package-closure (list e c b))))))
+
 (test-equal "origin-actual-file-name"
   "foo-1.tar.gz"
   (let ((o (dummy-origin (uri "http://www.example.com/foo-1.tar.gz"))))
 (test-equal "package-transitive-supported-systems, implicit inputs"
   %supported-systems
 
+  ;; Here GNU-BUILD-SYSTEM adds implicit inputs that build only on
+  ;; %SUPPORTED-SYSTEMS.  Thus the others must be ignored.
+  (let ((p (dummy-package "foo"
+               (build-system gnu-build-system)
+               (supported-systems
+                `("does-not-exist" "foobar" ,@%supported-systems)))))
+    (parameterize ((%current-system "armhf-linux")) ; a traditionally-bootstrapped architecture
+      (package-transitive-supported-systems p))))
+
+(test-equal "package-transitive-supported-systems: reduced binary seed, implicit inputs"
+  '("x86_64-linux" "i686-linux")
+
   ;; Here GNU-BUILD-SYSTEM adds implicit inputs that build only on
   ;; %SUPPORTED-SYSTEMS.  Thus the others must be ignored.
   (let ((p (dummy-package "foo"
              (build-system gnu-build-system)
              (supported-systems
               `("does-not-exist" "foobar" ,@%supported-systems)))))
-    (package-transitive-supported-systems p)))
+    (parameterize ((%current-system "x86_64-linux"))
+      (package-transitive-supported-systems p))))
 
 (test-assert "supported-package?"
-  (let ((p (dummy-package "foo"
-             (build-system gnu-build-system)
-             (supported-systems '("x86_64-linux" "does-not-exist")))))
+  (let* ((d (dummy-package "dep"
+              (build-system trivial-build-system)
+              (supported-systems '("x86_64-linux"))))
+         (p (dummy-package "foo"
+              (build-system gnu-build-system)
+              (inputs `(("d" ,d)))
+              (supported-systems '("x86_64-linux" "armhf-linux")))))
+    (and (supported-package? p "x86_64-linux")
+         (not (supported-package? p "i686-linux"))
+         (not (supported-package? p "armhf-linux")))))
+
+(test-assert "supported-package? vs. system-dependent graph"
+  ;; The inputs of a package can depend on (%current-system).  Thus,
+  ;; 'supported-package?' must make sure that it binds (%current-system)
+  ;; appropriately before traversing the dependency graph.  In the example
+  ;; below, 'supported-package?' must thus return true for both systems.
+  (let* ((p0a (dummy-package "foo-arm"
+                (build-system trivial-build-system)
+                (supported-systems '("armhf-linux"))))
+         (p0b (dummy-package "foo-x86_64"
+                (build-system trivial-build-system)
+                (supported-systems '("x86_64-linux"))))
+         (p   (dummy-package "bar"
+                (build-system trivial-build-system)
+                (inputs
+                 (if (string=? (%current-system) "armhf-linux")
+                     `(("foo" ,p0a))
+                     `(("foo" ,p0b)))))))
     (and (supported-package? p "x86_64-linux")
-         (not (supported-package? p "does-not-exist"))
-         (not (supported-package? p "i686-linux")))))
+         (supported-package? p "armhf-linux"))))
 
 (test-skip (if (not %store) 8 0))
 
                      (search-path %load-path "guix/base32.scm")
                    get-bytevector-all)))))
 
+(test-equal "package-source-derivation, origin, sha512"
+  "hello"
+  (let* ((bash    (search-bootstrap-binary "bash" (%current-system)))
+         (builder (add-text-to-store %store "my-fixed-builder.sh"
+                                     "echo -n hello > $out" '()))
+         (method  (lambda* (url hash-algo hash #:optional name
+                                #:rest rest)
+                    (and (eq? hash-algo 'sha512)
+                         (raw-derivation name bash (list builder)
+                                         #:sources (list builder)
+                                         #:hash hash
+                                         #:hash-algo hash-algo))))
+         (source  (origin
+                    (method method)
+                    (uri "unused://")
+                    (file-name "origin-sha512")
+                    (hash (content-hash
+                           (gcrypt:bytevector-hash (string->utf8 "hello")
+                                                   (gcrypt:lookup-hash-algorithm
+                                                    'sha512))
+                           sha512))))
+         (drv    (package-source-derivation %store source))
+         (output (derivation->output-path drv)))
+    (build-derivations %store (list drv))
+    (call-with-input-file output get-string-all)))
+
+(test-equal "package-source-derivation, origin, sha3-512"
+  "hello, sha3"
+  (let* ((bash    (search-bootstrap-binary "bash" (%current-system)))
+         (builder (add-text-to-store %store "my-fixed-builder.sh"
+                                     "echo -n hello, sha3 > $out" '()))
+         (method  (lambda* (url hash-algo hash #:optional name
+                                #:rest rest)
+                    (and (eq? hash-algo 'sha3-512)
+                         (raw-derivation name bash (list builder)
+                                         #:sources (list builder)
+                                         #:hash hash
+                                         #:hash-algo hash-algo))))
+         (source  (origin
+                    (method method)
+                    (uri "unused://")
+                    (file-name "origin-sha3")
+                    (hash (content-hash
+                           (gcrypt:bytevector-hash (string->utf8 "hello, sha3")
+                                                   (gcrypt:lookup-hash-algorithm
+                                                    'sha3-512))
+                           sha3-512))))
+         (drv    (package-source-derivation %store source))
+         (output (derivation->output-path drv)))
+    (build-derivations %store (list drv))
+    (call-with-input-file output get-string-all)))
+
 (unless (network-reachable?) (test-skip 1))
 (test-equal "package-source-derivation, snippet"
   "OK"
          (string=? (derivation->output-path drv)
                    (package-output %store package "out")))))
 
-(test-assert "patch not found yields a run-time error"
-  (guard (c ((condition-has-type? c &message)
-             (and (string-contains (condition-message c)
-                                   "does-not-exist.patch")
-                  (string-contains (condition-message c)
-                                   "not found"))))
+(test-equal "patch not found yields a run-time error"
+  '("~a: patch not found\n" "does-not-exist.patch")
+  (guard (c ((formatted-message? c)
+             (cons (formatted-message-string c)
+                   (formatted-message-arguments c))))
     (let ((p (package
                (inherit (dummy-package "p"))
                (source (origin
                    (symlink %output (string-append %output "/self"))
                    #t)))))
          (d (package-derivation %store p)))
-    (guard (c ((nix-protocol-error? c) #t))
+    (guard (c ((store-protocol-error? c) #t))
       (build-derivations %store (list d))
       #f)))
 
                                                          (replacement #f))))
                     (replacement (package-derivation %store new)))))))
 
+(test-assert "package-grafts, dependency on several outputs"
+  ;; Make sure we get one graft per output; see <https://bugs.gnu.org/41796>.
+  (letrec* ((p0  (dummy-package "p0"
+                   (version "1.0")
+                   (replacement p0*)
+                   (arguments '(#:implicit-inputs? #f))
+                   (outputs '("out" "lib"))))
+            (p0* (package (inherit p0) (version "1.1")))
+            (p1  (dummy-package "p1"
+                   (arguments '(#:implicit-inputs? #f))
+                   (inputs `(("p0" ,p0)
+                             ("p0:lib" ,p0 "lib"))))))
+    (lset= equal? (pk (package-grafts %store p1))
+           (list (graft
+                   (origin (package-derivation %store p0))
+                   (origin-output "out")
+                   (replacement (package-derivation %store p0*))
+                   (replacement-output "out"))
+                 (graft
+                   (origin (package-derivation %store p0))
+                   (origin-output "lib")
+                   (replacement (package-derivation %store p0*))
+                   (replacement-output "lib"))))))
+
 (test-assert "replacement also grafted"
   ;; We build a DAG as below, where dotted arrows represent replacements and
   ;; solid arrows represent dependencies:
           (assoc-ref (bag-build-inputs bag) "libc")
           (assoc-ref (bag-build-inputs bag) "coreutils"))))
 
+(test-assert "package->bag, sensitivity to %current-target-system"
+  ;; https://bugs.gnu.org/41713
+  (let* ((lower (lambda* (name #:key system target inputs native-inputs
+                               #:allow-other-keys)
+                  (and (not target)
+                       (bag (name name) (system system) (target target)
+                            (build-inputs native-inputs)
+                            (host-inputs inputs)
+                            (build (lambda* (store name inputs
+                                                   #:key system target
+                                                   #:allow-other-keys)
+                                     (build-expression->derivation
+                                      store "foo" '(mkdir %output))))))))
+         (bs    (build-system
+                  (name 'build-system-without-cross-compilation)
+                  (description "Does not support cross compilation.")
+                  (lower lower)))
+         (dep   (dummy-package "dep" (build-system bs)))
+         (pkg   (dummy-package "example"
+                  (native-inputs `(("dep" ,dep)))))
+         (do-not-build (lambda (continue store lst . _) lst)))
+    (equal? (with-build-handler do-not-build
+              (parameterize ((%current-target-system "powerpc64le-linux-gnu")
+                             (%graft? #t))
+                (package-cross-derivation %store pkg
+                                          (%current-target-system)
+                                          #:graft? #t)))
+            (with-build-handler do-not-build
+              (package-cross-derivation %store
+                                        (package (inherit pkg))
+                                        "powerpc64le-linux-gnu"
+                                        #:graft? #t)))))
+
 (test-equal "package->bag, cross-compilation"
   `(,(%current-system) "foo86-hurd"
     (,(package-source gnu-make))
       (("dep" package)
        (eq? package dep)))))
 
+(test-assert "package->bag, sensitivity to %current-system"
+  (let* ((dep (dummy-package "dep"
+                (propagated-inputs (if (string=? (%current-system)
+                                                 "i586-gnu")
+                                       `(("libxml2" ,libxml2))
+                                       '()))))
+         (pkg (dummy-package "foo"
+                (native-inputs `(("dep" ,dep)))))
+         (bag (package->bag pkg (%current-system) "i586-gnu")))
+    (equal? (parameterize ((%current-system "x86_64-linux"))
+              (bag-transitive-inputs bag))
+            (parameterize ((%current-system "i586-gnu"))
+              (bag-transitive-inputs bag)))))
+
+(test-assert "package->bag, sensitivity to %current-target-system"
+  (let* ((dep (dummy-package "dep"
+                (propagated-inputs (if (%current-target-system)
+                                       `(("libxml2" ,libxml2))
+                                       '()))))
+         (pkg (dummy-package "foo"
+                (native-inputs `(("dep" ,dep)))))
+         (bag (package->bag pkg (%current-system) "foo86-hurd")))
+    (equal? (parameterize ((%current-target-system "foo64-gnu"))
+              (bag-transitive-inputs bag))
+            (parameterize ((%current-target-system #f))
+              (bag-transitive-inputs bag)))))
+
 (test-assert "bag->derivation"
   (parameterize ((%graft? #f))
     (let ((bag (package->bag gnu-make))
 (when (or (not (network-reachable?)) (shebang-too-long?))
   (test-skip 1))
 (test-assert "GNU Make, bootstrap"
-  ;; GNU Make is the first program built during bootstrap; we choose it
-  ;; here so that the test doesn't last for too long.
-  (let ((gnu-make (@@ (gnu packages commencement) gnu-make-boot0)))
+  ;; GNU-MAKE-FOR-TESTS can be built cheaply; we choose it here so that the
+  ;; test doesn't last for too long.
+  (let ((gnu-make gnu-make-for-tests))
     (and (package? gnu-make)
          (or (location? (package-location gnu-make))
              (not (package-location gnu-make)))
                    ((("x" dep))
                     (eq? dep findutils)))))))))
 
+(test-assert "package-input-rewriting/spec"
+  (let* ((dep     (dummy-package "chbouib"
+                    (native-inputs `(("x" ,grep)))))
+         (p0      (dummy-package "example"
+                    (inputs `(("foo" ,coreutils)
+                              ("bar" ,grep)
+                              ("baz" ,dep)))))
+         (rewrite (package-input-rewriting/spec
+                   `(("coreutils" . ,(const sed))
+                     ("grep" . ,(const findutils)))))
+         (p1      (rewrite p0))
+         (p2      (rewrite p0)))
+    (and (not (eq? p1 p0))
+         (eq? p1 p2)                              ;memoization
+         (string=? "example" (package-name p1))
+         (match (package-inputs p1)
+           ((("foo" dep1) ("bar" dep2) ("baz" dep3))
+            (and (string=? (package-full-name dep1)
+                           (package-full-name sed))
+                 (string=? (package-full-name dep2)
+                           (package-full-name findutils))
+                 (string=? (package-name dep3) "chbouib")
+                 (eq? dep3 (rewrite dep))         ;memoization
+                 (match (package-native-inputs dep3)
+                   ((("x" dep))
+                    (string=? (package-full-name dep)
+                              (package-full-name findutils))))))))))
+
+(test-assert "package-input-rewriting/spec, partial match"
+  (let* ((dep     (dummy-package "chbouib"
+                    (version "1")
+                    (native-inputs `(("x" ,grep)))))
+         (p0      (dummy-package "example"
+                    (inputs `(("foo" ,coreutils)
+                              ("bar" ,dep)))))
+         (rewrite (package-input-rewriting/spec
+                   `(("chbouib@123" . ,(const sed)) ;not matched
+                     ("grep" . ,(const findutils)))))
+         (p1      (rewrite p0)))
+    (and (not (eq? p1 p0))
+         (string=? "example" (package-name p1))
+         (match (package-inputs p1)
+           ((("foo" dep1) ("bar" dep2))
+            (and (string=? (package-full-name dep1)
+                           (package-full-name coreutils))
+                 (eq? dep2 (rewrite dep))         ;memoization
+                 (match (package-native-inputs dep2)
+                   ((("x" dep))
+                    (string=? (package-full-name dep)
+                              (package-full-name findutils))))))))))
+
+(test-equal "package-patched-vulnerabilities"
+  '(("CVE-2015-1234")
+    ("CVE-2016-1234" "CVE-2018-4567")
+    ())
+  (let ((p1 (dummy-package "pi"
+              (source (dummy-origin
+                       (patches (list "/a/b/pi-CVE-2015-1234.patch"))))))
+        (p2 (dummy-package "pi"
+              (source (dummy-origin
+                       (patches (list
+                                 "/a/b/pi-CVE-2016-1234-CVE-2018-4567.patch"))))))
+        (p3 (dummy-package "pi" (source (dummy-origin)))))
+    (map package-patched-vulnerabilities
+         (list p1 p2 p3))))
+
 (test-eq "fold-packages" hello
   (fold-packages (lambda (p r)
                    (if (string=? (package-name p) "hello")
     ((one)
      (eq? one guile-2.0))))
 
+(test-assert "fold-available-packages with/without cache"
+  (let ()
+    (define no-cache
+      (fold-available-packages (lambda* (name version result #:rest rest)
+                                 (cons (cons* name version rest)
+                                       result))
+                               '()))
+
+    (define from-cache
+      (call-with-temporary-directory
+       (lambda (cache)
+         (generate-package-cache cache)
+         (mock ((guix describe) current-profile (const cache))
+               (mock ((gnu packages) cache-is-authoritative? (const #t))
+                     (fold-available-packages (lambda* (name version result
+                                                             #:rest rest)
+                                                (cons (cons* name version rest)
+                                                      result))
+                                              '()))))))
+
+    (define (find-duplicates l)
+      (match l
+        (() '())
+        ((head . tail)
+         (if (member head tail)
+             (cons head (find-duplicates tail))
+             (find-duplicates tail)))))
+
+    (pk (find-duplicates from-cache))
+    (and (equal? (delete-duplicates from-cache) from-cache)
+         (lset= equal? no-cache from-cache))))
+
 (test-assert "find-packages-by-name"
   (match (find-packages-by-name "hello")
     (((? (cut eq? hello <>))) #t)
     (((? (cut eq? hello <>))) #t)
     (wrong (pk 'find-packages-by-name wrong #f))))
 
+(test-equal "find-packages-by-name with cache"
+  (find-packages-by-name "guile")
+  (call-with-temporary-directory
+   (lambda (cache)
+     (generate-package-cache cache)
+     (mock ((guix describe) current-profile (const cache))
+           (mock ((gnu packages) cache-is-authoritative? (const #t))
+                 (find-packages-by-name "guile"))))))
+
+(test-equal "find-packages-by-name + version, with cache"
+  (find-packages-by-name "guile" "2")
+  (call-with-temporary-directory
+   (lambda (cache)
+     (generate-package-cache cache)
+     (mock ((guix describe) current-profile (const cache))
+           (mock ((gnu packages) cache-is-authoritative? (const #t))
+                 (find-packages-by-name "guile" "2"))))))
+
 (test-assert "--search-paths with pattern"
   ;; Make sure 'guix package --search-paths' correctly reports environment
   ;; variables when file patterns are used (in particular, it must follow
     (lambda (key . args)
       key)))
 
+(test-equal "specification->package+output"
+  `((,coreutils "out") (,coreutils "debug"))
+  (list (call-with-values (lambda ()
+                            (specification->package+output "coreutils"))
+          list)
+        (call-with-values (lambda ()
+                            (specification->package+output "coreutils:debug"))
+          list)))
+
+(test-equal "specification->package+output invalid output"
+  'error
+  (catch 'quit
+    (lambda ()
+      (specification->package+output "coreutils:does-not-exist"))
+    (lambda _
+      'error)))
+
+(test-equal "specification->package+output no default output"
+  `(,coreutils #f)
+  (call-with-values
+    (lambda ()
+      (specification->package+output "coreutils" #f))
+    list))
+
+(test-equal "specification->package+output invalid output, no default"
+  'error
+  (catch 'quit
+    (lambda ()
+      (specification->package+output "coreutils:does-not-exist" #f))
+    (lambda _
+      'error)))
+
+(test-equal "find-package-locations"
+  (map (lambda (package)
+         (cons (package-version package)
+               (package-location package)))
+       (find-packages-by-name "guile"))
+  (find-package-locations "guile"))
+
+(test-equal "find-package-locations with cache"
+  (map (lambda (package)
+         (cons (package-version package)
+               (package-location package)))
+       (find-packages-by-name "guile"))
+  (call-with-temporary-directory
+   (lambda (cache)
+     (generate-package-cache cache)
+     (mock ((guix describe) current-profile (const cache))
+           (mock ((gnu packages) cache-is-authoritative? (const #t))
+                 (find-package-locations "guile"))))))
+
+(test-equal "specification->location"
+  (package-location (specification->package "guile@2"))
+  (specification->location "guile@2"))
+
 (test-end "packages")
 
 ;;; Local Variables:
 ;;; eval: (put 'dummy-package 'scheme-indent-function 1)
+;;; eval: (put 'dummy-package/no-implicit 'scheme-indent-function 1)
 ;;; End: