all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* bug#42794: make check fails test "tests/packages.scm fold-available-packages with/without cache"
@ 2020-08-10 10:07 jbranso--- via Bug reports for GNU Guix
  2020-08-10 12:41 ` Mathieu Othacehe
  0 siblings, 1 reply; 2+ messages in thread
From: jbranso--- via Bug reports for GNU Guix @ 2020-08-10 10:07 UTC (permalink / raw)
  To: 42794


[-- Attachment #1.1: Type: text/plain, Size: 1345 bytes --]

Hello,

My recent make check failed the tests/packages.scm
"fold-available-packages with/without cache".

After janneke confirmed that his recent make checked failed the same
test, he encouraged me to submit this bug.

He also showed me how to make a shorter test-suite.log file via
make check TESTS='tests/packages.scm', which is what I'm attaching.

Still the whole test-suite.log file is super long, so here's the main
gist that you ought to see:

test-name: fold-available-packages with/without cache
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1309
source:
+ (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))
+ '()))))))
+ (and (equal?
+ (delete-duplicates from-cache)
+ from-cache)
+ (lset= equal? no-cache from-cache))))
actual-value: #f
result: FAIL

Thanks!

Joshua

[-- Attachment #1.2: Type: text/html, Size: 1714 bytes --]

[-- Attachment #2: test-suite.log --]
[-- Type: text/plain, Size: 90478 bytes --]

========================================
   GNU Guix UNKNOWN: ./test-suite.log
========================================

# TOTAL: 86
# PASS:  85
# SKIP:  0
# XFAIL: 0
# FAIL:  1
# XPASS: 0
# ERROR: 0

.. contents:: :depth: 2

FAIL: tests/packages
====================

test-name: printer with location
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:73
source:
+ (test-assert
+   "printer with location"
+   (string-match
+     "^#<package foo@0 foo.scm:42 [[:xdigit:]]+>$"
+     (with-output-to-string
+       (lambda ()
+         (write (dummy-package
+                  "foo"
+                  (location (make-location "foo.scm" 42 7))))))))
actual-value: #("#<package foo@0 foo.scm:42 7fe6271501e0>" (0 . 40))
result: PASS

test-name: printer without location
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:81
source:
+ (test-assert
+   "printer without location"
+   (string-match
+     "^#<package foo@0 [[:xdigit:]]+>$"
+     (with-output-to-string
+       (lambda ()
+         (write (dummy-package "foo" (location #f)))))))
actual-value: #("#<package foo@0 7fe6272e0f00>" (0 . 29))
result: PASS

test-name: hidden-package
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:88
source:
+ (test-assert
+   "hidden-package"
+   (and (hidden-package?
+          (hidden-package (dummy-package "foo")))
+        (not (hidden-package? (dummy-package "foo")))))
actual-value: #t
result: PASS

test-name: package-superseded
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:92
source:
+ (test-assert
+   "package-superseded"
+   (let* ((new (dummy-package "bar"))
+          (old (deprecated-package "foo" new)))
+     (and (eq? (package-superseded old) new)
+          (mock ((gnu packages)
+                 find-best-packages-by-name
+                 (const (list old)))
+                (specification->package "foo")
+                (and (eq? new (specification->package "foo"))
+                     (eq? new (specification->package+output "foo")))))))
actual-value: #t
result: PASS

test-name: transaction-upgrade-entry, zero upgrades
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:101
source:
+ (test-assert
+   "transaction-upgrade-entry, zero upgrades"
+   (let* ((old (dummy-package "foo" (version "1")))
+          (tx (mock ((gnu packages)
+                     find-best-packages-by-name
+                     (const '()))
+                    (transaction-upgrade-entry
+                      #f
+                      (manifest-entry
+                        (inherit (package->manifest-entry old))
+                        (item (string-append
+                                (%store-prefix)
+                                "/"
+                                (make-string 32 #\e)
+                                "-foo-1")))
+                      (manifest-transaction)))))
+     (manifest-transaction-null? tx)))
actual-value: #t
result: PASS

test-name: transaction-upgrade-entry, zero upgrades, equivalent package
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:114
source:
+ (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)))
actual-value: #t
result: PASS

test-name: transaction-upgrade-entry, zero upgrades, propagated inputs
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:127
source:
+ (test-assert
+   "transaction-upgrade-entry, zero upgrades, propagated inputs"
+   (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)))
actual-value: #t
result: PASS

test-name: transaction-upgrade-entry, one upgrade
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:149
source:
+ (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-best-packages-by-name
+                     (const (list new)))
+                    (transaction-upgrade-entry
+                      #f
+                      (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" "2" "out" item))
+                  (eq? item new)))
+          (null? (manifest-transaction-remove tx)))))
actual-value: #t
result: PASS

test-name: transaction-upgrade-entry, superseded package
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:166
source:
+ (test-assert
+   "transaction-upgrade-entry, superseded package"
+   (let* ((old (dummy-package "foo" (version "1")))
+          (new (dummy-package "bar" (version "2")))
+          (dep (deprecated-package "foo" new))
+          (tx (mock ((gnu packages)
+                     find-best-packages-by-name
+                     (const (list dep)))
+                    (transaction-upgrade-entry
+                      #f
+                      (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> "bar" "2" "out" item))
+                  (eq? item new)))
+          (match (manifest-transaction-remove tx)
+                 (((? manifest-pattern? pattern))
+                  (and (string=? (manifest-pattern-name pattern) "foo")
+                       (string=? (manifest-pattern-version pattern) "1")
+                       (string=?
+                         (manifest-pattern-output pattern)
+                         "out")))))))
actual-value: #t
result: PASS

test-name: transaction-upgrade-entry, grafts
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:188
source:
+ (test-assert
+   "transaction-upgrade-entry, grafts"
+   (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)))))))
actual-value: #t
result: PASS

test-name: package-field-location
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:212
source:
+ (test-assert
+   "package-field-location"
+   (let ()
+     (define (goto port line column)
+       (unless
+         (and (= (port-column port) (- column 1))
+              (= (port-line port) (- line 1)))
+         (unless
+           (eof-object? (get-char port))
+           (goto port line column))))
+     (define read-at
+       (match-lambda
+         (($ <location> file line column)
+          (call-with-input-file
+            (search-path %load-path file)
+            (lambda (port)
+              (goto port line column)
+              (read port))))))
+     (and (member
+            (read-at
+              (package-field-location %bootstrap-guile 'name))
+            (let ((name (package-name %bootstrap-guile)))
+              (list name `(name ,name))))
+          (member
+            (read-at
+              (package-field-location
+                %bootstrap-guile
+                'version))
+            (let ((version (package-version %bootstrap-guile)))
+              (list version `(version ,version))))
+          (not (package-field-location
+                 %bootstrap-guile
+                 'does-not-exist)))))
actual-value: #t
result: PASS

test-name: package-field-location, relative file name
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:239
source:
+ (test-equal
+   "package-field-location, relative file name"
+   (location-file
+     (package-location %bootstrap-guile))
+   (with-fluids
+     ((%file-port-name-canonicalization 'absolute))
+     (location-file
+       (package-field-location
+         %bootstrap-guile
+         'version))))
expected-value: "gnu/packages/bootstrap.scm"
actual-value: "gnu/packages/bootstrap.scm"
result: PASS

test-name: package-transitive-inputs
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:244
source:
+ (test-assert
+   "package-transitive-inputs"
+   (let* ((a (dummy-package "a"))
+          (b (dummy-package
+               "b"
+               (propagated-inputs `(("a" ,a)))))
+          (c (dummy-package "c" (inputs `(("a" ,a)))))
+          (d (dummy-package
+               "d"
+               (propagated-inputs `(("x" "something.drv")))))
+          (e (dummy-package
+               "e"
+               (inputs `(("b" ,b) ("c" ,c) ("d" ,d))))))
+     (and (null? (package-transitive-inputs a))
+          (equal?
+            `(("a" ,a))
+            (package-transitive-inputs b))
+          (equal?
+            `(("a" ,a))
+            (package-transitive-inputs c))
+          (equal?
+            (package-propagated-inputs d)
+            (package-transitive-inputs d))
+          (equal?
+            `(("b" ,b)
+              ("c" ,c)
+              ("d" ,d)
+              ("a" ,a)
+              ("x" "something.drv"))
+            (pk 'x (package-transitive-inputs e))))))

;;; (x (("b" #<package b@0 /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:246 7fe629d36280>) ("c" #<package c@0 /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:248 7fe629d36140>) ("d" #<package d@0 /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:250 7fe629d36000>) ("a" #<package a@0 /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:245 7fe629d363c0>) ("x" "something.drv")))
actual-value: #t
result: PASS

test-name: package-transitive-inputs, no duplicates
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:263
source:
+ (test-assert
+   "package-transitive-inputs, no duplicates"
+   (let* ((a (dummy-package "a"))
+          (b (dummy-package
+               "b"
+               (inputs `(("a+" ,a)))
+               (native-inputs `(("a*" ,a)))
+               (propagated-inputs `(("a" ,a)))))
+          (c (dummy-package
+               "c"
+               (propagated-inputs `(("b" ,b)))))
+          (d (dummy-package "d" (inputs `(("a" ,a) ("c" ,c)))))
+          (e (dummy-package "e" (inputs `(("b" ,b) ("c" ,c))))))
+     (and (null? (package-transitive-inputs a))
+          (equal?
+            `(("a*" ,a) ("a+" ,a) ("a" ,a))
+            (package-transitive-inputs b))
+          (equal?
+            `(("b" ,b) ("a" ,a))
+            (package-transitive-inputs c))
+          (equal?
+            `(("a" ,a) ("c" ,c) ("b" ,b))
+            (package-transitive-inputs d))
+          (equal?
+            `(("b" ,b) ("c" ,c) ("a" ,a))
+            (package-transitive-inputs e)))))
actual-value: #t
result: PASS

test-name: package-transitive-supported-systems
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:285
source:
+ (test-equal
+   "package-transitive-supported-systems"
+   '(("x" "y" "z") ("x" "y") ("y") ("y") ("y"))
+   (let* ((a (dummy-package
+               "a"
+               (build-system trivial-build-system)
+               (supported-systems '("x" "y" "z"))))
+          (b (dummy-package
+               "b"
+               (build-system trivial-build-system)
+               (supported-systems '("x" "y"))
+               (inputs `(("a" ,a)))))
+          (c (dummy-package
+               "c"
+               (build-system trivial-build-system)
+               (supported-systems '("y" "z"))
+               (inputs `(("b" ,b)))))
+          (d (dummy-package
+               "d"
+               (build-system trivial-build-system)
+               (supported-systems '("x" "y" "z"))
+               (inputs `(("b" ,b) ("c" ,c)))))
+          (e (dummy-package
+               "e"
+               (build-system trivial-build-system)
+               (supported-systems '("x" "y" "z"))
+               (inputs `(("d" ,d))))))
+     (list (package-transitive-supported-systems a)
+           (package-transitive-supported-systems b)
+           (package-transitive-supported-systems c)
+           (package-transitive-supported-systems d)
+           (package-transitive-supported-systems e))))
expected-value: (("x" "y" "z") ("x" "y") ("y") ("y") ("y"))
actual-value: (("x" "y" "z") ("x" "y") ("y") ("y") ("y"))
result: PASS

test-name: package-closure
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:318
source:
+ (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))))))
actual-value: #t
result: PASS

test-name: origin-actual-file-name
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:340
source:
+ (test-equal
+   "origin-actual-file-name"
+   "foo-1.tar.gz"
+   (let ((o (dummy-origin
+              (uri "http://www.example.com/foo-1.tar.gz"))))
+     (origin-actual-file-name o)))
expected-value: "foo-1.tar.gz"
actual-value: "foo-1.tar.gz"
result: PASS

test-name: origin-actual-file-name, file-name
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:345
source:
+ (test-equal
+   "origin-actual-file-name, file-name"
+   "foo-1.tar.gz"
+   (let ((o (dummy-origin
+              (uri "http://www.example.com/tarball")
+              (file-name "foo-1.tar.gz"))))
+     (origin-actual-file-name o)))
expected-value: "foo-1.tar.gz"
actual-value: "foo-1.tar.gz"
result: PASS

test-name: package-direct-sources, no source
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:362
source:
+ (test-assert
+   "package-direct-sources, no source"
+   (null? (package-direct-sources a)))
actual-value: #t
result: PASS

test-name: package-direct-sources, #f source
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:364
source:
+ (test-equal
+   "package-direct-sources, #f source"
+   (list i)
+   (package-direct-sources b))
expected-value: (#<origin "http://www.example.com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7fe6256c9420>)
actual-value: (#<origin "http://www.example.com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7fe6256c9420>)
result: PASS

test-name: package-direct-sources, not input source
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:367
source:
+ (test-equal
+   "package-direct-sources, not input source"
+   (list u)
+   (package-direct-sources d))
expected-value: (#<origin "http://www.example.com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7fe6256c94e0>)
actual-value: (#<origin "http://www.example.com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7fe6256c94e0>)
result: PASS

test-name: package-direct-sources
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:370
source:
+ (test-assert
+   "package-direct-sources"
+   (let ((s (package-direct-sources c)))
+     (and (= (length (pk 's-sources s)) 2)
+          (member o s)
+          (member i s))))

;;; (s-sources (#<origin "http://www.example.com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7fe6256c95a0> #<origin "http://www.example.com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7fe6256c9420>))
actual-value: (#<origin "http://www.example.com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7fe6256c9420>)
result: PASS

test-name: package-transitive-sources
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:375
source:
+ (test-assert
+   "package-transitive-sources"
+   (let ((s (package-transitive-sources d)))
+     (and (= (length (pk 'd-sources s)) 3)
+          (member o s)
+          (member i s)
+          (member u s))))

;;; (d-sources (#<origin "http://www.example.com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7fe6256c94e0> #<origin "http://www.example.com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7fe6256c95a0> #<origin "http://www.example.com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7fe6256c9420>))
actual-value: (#<origin "http://www.example.com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7fe6256c94e0> #<origin "http://www.example.com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7fe6256c95a0> #<origin "http://www.example.com" #<content-hash sha256:1xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx> () 7fe6256c9420>)
result: PASS

test-name: transitive-input-references
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:382
source:
+ (test-assert
+   "transitive-input-references"
+   (let* ((a (dummy-package "a"))
+          (b (dummy-package "b"))
+          (c (dummy-package
+               "c"
+               (inputs `(("a" ,a)))
+               (propagated-inputs `(("boo" ,b)))))
+          (d (dummy-package "d" (inputs `(("c*" ,c)))))
+          (keys (map (match-lambda (('assoc-ref 'l key) key))
+                     (pk 'refs
+                         (transitive-input-references
+                           'l
+                           (package-inputs d))))))
+     (and (= (length keys) 2)
+          (member "c*" keys)
+          (member "boo" keys))))

;;; (refs ((assoc-ref l "c*") (assoc-ref l "boo")))
actual-value: ("boo")
result: PASS

test-name: package-transitive-supported-systems, implicit inputs
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:399
source:
+ (test-equal
+   "package-transitive-supported-systems, implicit inputs"
+   %supported-systems
+   (let ((p (dummy-package
+              "foo"
+              (build-system gnu-build-system)
+              (supported-systems
+                `("does-not-exist" "foobar" ,@%supported-systems)))))
+     (parameterize
+       ((%current-system "armhf-linux"))
+       (package-transitive-supported-systems p))))
expected-value: ("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux" "mips64el-linux" "i586-gnu")
actual-value: ("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux" "mips64el-linux" "i586-gnu")
result: PASS

test-name: package-transitive-supported-systems: reduced binary seed, implicit inputs
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:411
source:
+ (test-equal
+   "package-transitive-supported-systems: reduced binary seed, implicit inputs"
+   '("x86_64-linux" "i686-linux")
+   (let ((p (dummy-package
+              "foo"
+              (build-system gnu-build-system)
+              (supported-systems
+                `("does-not-exist" "foobar" ,@%supported-systems)))))
+     (parameterize
+       ((%current-system "x86_64-linux"))
+       (package-transitive-supported-systems p))))
expected-value: ("x86_64-linux" "i686-linux")
actual-value: ("x86_64-linux" "i686-linux")
result: PASS

test-name: supported-package?
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:423
source:
+ (test-assert
+   "supported-package?"
+   (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")))))
actual-value: #t
result: PASS

test-name: supported-package? vs. system-dependent graph
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:435
source:
+ (test-assert
+   "supported-package? vs. system-dependent graph"
+   (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")
+          (supported-package? p "armhf-linux"))))
actual-value: ("armhf-linux")
result: PASS

test-name: package-source-derivation, file
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:457
source:
+ (test-assert
+   "package-source-derivation, file"
+   (let* ((file (search-path %load-path "guix.scm"))
+          (package
+            (package
+              (inherit (dummy-package "p"))
+              (source file)))
+          (source
+            (package-source-derivation
+              %store
+              (package-source package))))
+     (and (store-path? source)
+          (valid-path? %store source)
+          (equal?
+            (call-with-input-file source get-bytevector-all)
+            (call-with-input-file file get-bytevector-all)))))
actual-value: #t
result: PASS

test-name: package-source-derivation, store path
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:468
source:
+ (test-assert
+   "package-source-derivation, store path"
+   (let* ((file (add-to-store
+                  %store
+                  "guix.scm"
+                  #t
+                  "sha256"
+                  (search-path %load-path "guix.scm")))
+          (package
+            (package
+              (inherit (dummy-package "p"))
+              (source file)))
+          (source
+            (package-source-derivation
+              %store
+              (package-source package))))
+     (string=? file source)))
actual-value: #t
result: PASS

test-name: package-source-derivation, indirect store path
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:477
source:
+ (test-assert
+   "package-source-derivation, indirect store path"
+   (let* ((dir (add-to-store
+                 %store
+                 "guix-build"
+                 #t
+                 "sha256"
+                 (dirname
+                   (search-path %load-path "guix/build/utils.scm"))))
+          (package
+            (package
+              (inherit (dummy-package "p"))
+              (source (string-append dir "/utils.scm"))))
+          (source
+            (package-source-derivation
+              %store
+              (package-source package))))
+     (and (direct-store-path? source)
+          (string-suffix? "utils.scm" source))))
actual-value: #t
result: PASS

test-name: package-source-derivation, local-file
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:488
source:
+ (test-assert
+   "package-source-derivation, local-file"
+   (let* ((file (local-file "../guix/base32.scm"))
+          (package
+            (package
+              (inherit (dummy-package "p"))
+              (source file)))
+          (source
+            (package-source-derivation
+              %store
+              (package-source package))))
+     (and (store-path? source)
+          (string-suffix? "base32.scm" source)
+          (valid-path? %store source)
+          (equal?
+            (call-with-input-file source get-bytevector-all)
+            (call-with-input-file
+              (search-path %load-path "guix/base32.scm")
+              get-bytevector-all)))))
actual-value: #t
result: PASS

test-name: package-source-derivation, origin, sha512
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:502
source:
+ (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)))
expected-value: "hello"
actual-value: "hello"
result: PASS

test-name: package-source-derivation, origin, sha3-512
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:528
source:
+ (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)))
expected-value: "hello, sha3"
actual-value: "hello, sha3"
result: PASS

test-name: package-source-derivation, snippet
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:555
source:
+ (test-equal
+   "package-source-derivation, snippet"
+   "OK"
+   (let* ((source
+            (bootstrap-origin
+              (origin
+                (inherit
+                  (bootstrap-guile-origin (%current-system)))
+                (patch-inputs
+                  `(("tar" ,%bootstrap-coreutils&co)
+                    ("xz" ,%bootstrap-coreutils&co)
+                    ("patch" ,%bootstrap-coreutils&co)))
+                (patch-guile %bootstrap-guile)
+                (modules '((guix build utils)))
+                (snippet
+                  '(begin
+                     (chmod "." 511)
+                     (symlink "guile" "guile-rocks")
+                     (copy-recursively
+                       "../share/guile/2.0/scripts"
+                       "scripts")
+                     (chmod ".." 511))))))
+          (package
+            (package
+              (inherit (dummy-package "with-snippet"))
+              (source source)
+              (build-system trivial-build-system)
+              (inputs
+                `(("tar"
+                   ,(search-bootstrap-binary "tar" (%current-system)))
+                  ("xz"
+                   ,(search-bootstrap-binary "xz" (%current-system)))))
+              (arguments
+                `(#:guile
+                  ,%bootstrap-guile
+                  #:modules
+                  ((guix build utils))
+                  #:builder
+                  (begin
+                    (use-modules (guix build utils))
+                    (let ((tar (assoc-ref %build-inputs "tar"))
+                          (xz (assoc-ref %build-inputs "xz"))
+                          (source (assoc-ref %build-inputs "source")))
+                      (invoke
+                        tar
+                        "xvf"
+                        source
+                        "--use-compress-program"
+                        xz)
+                      (unless
+                        (and (string=? "guile" (readlink "bin/guile-rocks"))
+                             (file-exists? "bin/scripts/compile.scm"))
+                        (error "the snippet apparently failed"))
+                      (let ((out (assoc-ref %outputs "out")))
+                        (call-with-output-file
+                          out
+                          (lambda (p) (display "OK" p))))
+                      #t))))))
+          (drv (package-derivation %store package))
+          (out (derivation->output-path drv)))
+     (and (build-derivations
+            %store
+            (list (pk 'snippet-drv drv)))
+          (call-with-input-file out get-string-all))))

;;; (snippet-drv #<derivation /home/joshua/prog/gnu/guix/guix-src/test-tmp/store/sih43y3v9vqmj0vmzfpdihv7zx9hwdhi-with-snippet-0.drv => /home/joshua/prog/gnu/guix/guix-src/test-tmp/store/haajjhg68dhx812cblaj2497m0x23iip-with-snippet-0 7fe62520bc80>)
expected-value: "OK"
actual-value: "OK"
result: PASS

test-name: return value
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:609
source:
+ (test-assert
+   "return value"
+   (let ((drv (package-derivation %store (dummy-package "p"))))
+     (and (derivation? drv)
+          (file-exists? (derivation-file-name drv)))))
actual-value: #t
result: PASS

test-name: package-output
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:614
source:
+ (test-assert
+   "package-output"
+   (let* ((package (dummy-package "p"))
+          (drv (package-derivation %store package)))
+     (and (derivation? drv)
+          (string=?
+            (derivation->output-path drv)
+            (package-output %store package "out")))))
actual-value: #t
result: PASS

test-name: patch not found yields a run-time error
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:621
source:
+ (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
+                         (method (const #f))
+                         (uri "http://whatever")
+                         (patches
+                           (list (search-patch "does-not-exist.patch")))
+                         (sha256
+                           (base32
+                             "0amn0bbwqvsvvsh6drfwz20ydc2czk374lzw5kksbh6bf78k4ks4")))))))
+            (package-derivation %store p)
+            #f)))
expected-value: ("~a: patch not found\n" "does-not-exist.patch")
actual-value: ("~a: patch not found\n" "does-not-exist.patch")
result: PASS

test-name: &package-input-error
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:640
source:
+ (test-equal
+   "&package-input-error"
+   (list dummy (current-module))
+   (guard (c ((package-input-error? c)
+              (list (package-error-package c)
+                    (package-error-invalid-input c))))
+          (package-derivation %store dummy)))
expected-value: (#<package foo@0 /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:639 7fe629d36320> #<directory (test-packages) 7fe630a0dd20>)
actual-value: (#<package foo@0 /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:639 7fe629d36320> #<directory (test-packages) 7fe630a0dd20>)
result: PASS

test-name: reference to non-existent output
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:647
source:
+ (test-assert
+   "reference to non-existent output"
+   (parameterize
+     ((%graft? #f))
+     (let* ((dep (dummy-package "dep"))
+            (p (dummy-package
+                 "p"
+                 (inputs `(("dep" ,dep "non-existent"))))))
+       (guard (c ((derivation-missing-output-error? c)
+                  (and (string=?
+                         (derivation-missing-output c)
+                         "non-existent")
+                       (equal?
+                         (package-derivation %store dep)
+                         (derivation-error-derivation c)))))
+              (package-derivation %store p)))))
actual-value: #t
result: PASS

test-name: trivial
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:659
source:
+ (test-assert
+   "trivial"
+   (let* ((p (package
+               (inherit (dummy-package "trivial"))
+               (build-system trivial-build-system)
+               (source #f)
+               (arguments
+                 `(#:guile
+                   ,%bootstrap-guile
+                   #:builder
+                   (begin
+                     (mkdir %output)
+                     (call-with-output-file
+                       (string-append %output "/test")
+                       (lambda (p) (display '(hello guix) p)))
+                     #t)))))
+          (d (package-derivation %store p)))
+     (and (build-derivations %store (list d))
+          (let ((p (pk 'drv d (derivation->output-path d))))
+            (equal?
+              '(hello guix)
+              (call-with-input-file
+                (string-append p "/test")
+                read))))))

;;; (drv #<derivation /home/joshua/prog/gnu/guix/guix-src/test-tmp/store/6rmyjxb5fwf0nrrk6gqb2vhmqzyzg70d-trivial-0.drv => /home/joshua/prog/gnu/guix/guix-src/test-tmp/store/2p1zcn7sd3vv8lbn96ap211qdmzsr7fs-trivial-0 7fe6271aa640> "/home/joshua/prog/gnu/guix/guix-src/test-tmp/store/2p1zcn7sd3vv8lbn96ap211qdmzsr7fs-trivial-0")
actual-value: #t
result: PASS

test-name: trivial with local file as input
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:678
source:
+ (test-assert
+   "trivial with local file as input"
+   (let* ((i (search-path %load-path "ice-9/boot-9.scm"))
+          (p (package
+               (inherit
+                 (dummy-package "trivial-with-input-file"))
+               (build-system trivial-build-system)
+               (source #f)
+               (arguments
+                 `(#:guile
+                   ,%bootstrap-guile
+                   #:builder
+                   (begin
+                     (copy-file
+                       (assoc-ref %build-inputs "input")
+                       %output)
+                     #t)))
+               (inputs `(("input" ,i)))))
+          (d (package-derivation %store p)))
+     (and (build-derivations %store (list 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))))))

;;; (drv #<derivation /home/joshua/prog/gnu/guix/guix-src/test-tmp/store/lnb99jm0qxp262sim9dy9nzar9aphkx8-trivial-with-input-file-0.drv => /home/joshua/prog/gnu/guix/guix-src/test-tmp/store/gfhz8yz45zhbi4dxpmx6rks1hmw7zchr-trivial-with-input-file-0 7fe6257a3be0> "/home/joshua/prog/gnu/guix/guix-src/test-tmp/store/gfhz8yz45zhbi4dxpmx6rks1hmw7zchr-trivial-with-input-file-0")
actual-value: #t
result: PASS

test-name: trivial with source
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:696
source:
+ (test-assert
+   "trivial with source"
+   (let* ((i (search-path %load-path "ice-9/boot-9.scm"))
+          (p (package
+               (inherit (dummy-package "trivial-with-source"))
+               (build-system trivial-build-system)
+               (source i)
+               (arguments
+                 `(#:guile
+                   ,%bootstrap-guile
+                   #:builder
+                   (begin
+                     (copy-file
+                       (assoc-ref %build-inputs "source")
+                       %output)
+                     #t)))))
+          (d (package-derivation %store p)))
+     (and (build-derivations %store (list d))
+          (let ((p (derivation->output-path d)))
+            (equal?
+              (call-with-input-file p get-bytevector-all)
+              (call-with-input-file i get-bytevector-all))))))
actual-value: #t
result: PASS

test-name: trivial with system-dependent input
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:713
source:
+ (test-assert
+   "trivial with system-dependent input"
+   (let* ((p (package
+               (inherit
+                 (dummy-package "trivial-system-dependent-input"))
+               (build-system trivial-build-system)
+               (source #f)
+               (arguments
+                 `(#:guile
+                   ,%bootstrap-guile
+                   #:modules
+                   ((guix build utils))
+                   #:builder
+                   (begin
+                     (use-modules (guix build utils))
+                     (let ((out (assoc-ref %outputs "out"))
+                           (bash (assoc-ref %build-inputs "bash")))
+                       (invoke
+                         bash
+                         "-c"
+                         (format #f "echo hello > ~a" out))))))
+               (inputs
+                 `(("bash"
+                    ,(search-bootstrap-binary
+                       "bash"
+                       (%current-system)))))))
+          (d (package-derivation %store p)))
+     (and (build-derivations %store (list d))
+          (let ((p (pk 'drv d (derivation->output-path d))))
+            (eq? 'hello (call-with-input-file p read))))))

;;; (drv #<derivation /home/joshua/prog/gnu/guix/guix-src/test-tmp/store/5hc17z0kjl6hfiv0w22gl39amb4nffsf-trivial-system-dependent-input-0.drv => /home/joshua/prog/gnu/guix/guix-src/test-tmp/store/mc78i6x9a2pgag1ci6nw9mjg9c79v9sh-trivial-system-dependent-input-0 7fe625beb960> "/home/joshua/prog/gnu/guix/guix-src/test-tmp/store/mc78i6x9a2pgag1ci6nw9mjg9c79v9sh-trivial-system-dependent-input-0")
actual-value: #t
result: PASS

test-name: trivial with #:allowed-references
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:734
source:
+ (test-assert
+   "trivial with #:allowed-references"
+   (let* ((p (package
+               (inherit (dummy-package "trivial"))
+               (build-system trivial-build-system)
+               (arguments
+                 `(#:guile
+                   ,%bootstrap-guile
+                   #:allowed-references
+                   (,%bootstrap-guile)
+                   #:builder
+                   (begin
+                     (mkdir %output)
+                     (symlink %output (string-append %output "/self"))
+                     #t)))))
+          (d (package-derivation %store p)))
+     (guard (c ((store-protocol-error? c) #t))
+            (build-derivations %store (list d))
+            #f)))
random seed for tests: 1597062691
package 'foo' has been superseded by 'bar'
package 'foo' has been superseded by 'bar'
package 'foo' has been superseded by 'bar'
warning: package 'foo' no longer exists
package 'foo' has been superseded by 'bar'
@ build-started /home/joshua/prog/gnu/guix/guix-src/test-tmp/store/nz4f23s1j4v3vad5z1iq8i1p7qkw3rg4-trivial-0.drv - x86_64-linux /home/joshua/prog/gnu/guix/guix-src/test-tmp/var/log/guix/drvs/nz//4f23s1j4v3vad5z1iq8i1p7qkw3rg4-trivial-0.drv.bz2 10253
output (`/home/joshua/prog/gnu/guix/guix-src/test-tmp/store/4d83i4mkvyc1jj5hlp9078xv26c4dl5b-trivial-0') is not allowed to refer to path `/home/joshua/prog/gnu/guix/guix-src/test-tmp/store/4d83i4mkvyc1jj5hlp9078xv26c4dl5b-trivial-0'
@ build-failed /home/joshua/prog/gnu/guix/guix-src/test-tmp/store/nz4f23s1j4v3vad5z1iq8i1p7qkw3rg4-trivial-0.drv - 1 output (`/home/joshua/prog/gnu/guix/guix-src/test-tmp/store/4d83i4mkvyc1jj5hlp9078xv26c4dl5b-trivial-0') is not allowed to refer to path `/home/joshua/prog/gnu/guix/guix-src/test-tmp/store/4d83i4mkvyc1jj5hlp9078xv26c4dl5b-trivial-0'
actual-value: #t
result: PASS

test-name: search paths
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:753
source:
+ (test-assert
+   "search paths"
+   (let* ((p (make-prompt-tag "return-search-paths"))
+          (s (build-system
+               (name 'raw)
+               (description
+                 "Raw build system with direct store access")
+               (lower (lambda* (name
+                                #:key
+                                source
+                                inputs
+                                system
+                                target
+                                #:allow-other-keys)
+                        (bag (name name)
+                             (system system)
+                             (target target)
+                             (build-inputs inputs)
+                             (build (lambda* (store
+                                              name
+                                              inputs
+                                              #:key
+                                              outputs
+                                              system
+                                              search-paths)
+                                      search-paths)))))))
+          (x (list (search-path-specification
+                     (variable "GUILE_LOAD_PATH")
+                     (files '("share/guile/site/2.0")))
+                   (search-path-specification
+                     (variable "GUILE_LOAD_COMPILED_PATH")
+                     (files '("share/guile/site/2.0")))))
+          (a (package
+               (inherit (dummy-package "guile"))
+               (build-system s)
+               (native-search-paths x)))
+          (b (package
+               (inherit (dummy-package "guile-foo"))
+               (build-system s)
+               (inputs `(("guile" ,a)))))
+          (c (package
+               (inherit (dummy-package "guile-bar"))
+               (build-system s)
+               (inputs `(("guile" ,a) ("guile-foo" ,b))))))
+     (let-syntax ((collect
+                    (syntax-rules ()
+                      ((_ body ...)
+                       (call-with-prompt
+                         p
+                         (lambda () body ...)
+                         (lambda (k search-paths) search-paths))))))
+       (and (null? (collect (package-derivation %store a)))
+            (equal?
+              x
+              (collect (package-derivation %store b)))
+            (equal?
+              x
+              (collect (package-derivation %store c)))))))
actual-value: #t
result: PASS

test-name: package-transitive-native-search-paths
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:795
source:
+ (test-assert
+   "package-transitive-native-search-paths"
+   (let* ((sp (lambda (name)
+                (list (search-path-specification
+                        (variable name)
+                        (files '("foo/bar"))))))
+          (p0 (dummy-package
+                "p0"
+                (native-search-paths (sp "PATH0"))))
+          (p1 (dummy-package
+                "p1"
+                (native-search-paths (sp "PATH1"))))
+          (p2 (dummy-package
+                "p2"
+                (native-search-paths (sp "PATH2"))
+                (inputs `(("p0" ,p0)))
+                (propagated-inputs `(("p1" ,p1)))))
+          (p3 (dummy-package
+                "p3"
+                (native-search-paths (sp "PATH3"))
+                (native-inputs `(("p0" ,p0)))
+                (propagated-inputs `(("p2" ,p2))))))
+     (lset= string=?
+            '("PATH1" "PATH2" "PATH3")
+            (map search-path-specification-variable
+                 (package-transitive-native-search-paths p3)))))
actual-value: #t
result: PASS

test-name: package-cross-derivation
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:815
source:
+ (test-assert
+   "package-cross-derivation"
+   (let ((drv (package-cross-derivation
+                %store
+                (dummy-package "p")
+                "mips64el-linux-gnu")))
+     (and (derivation? drv)
+          (file-exists? (derivation-file-name drv)))))
actual-value: #t
result: PASS

test-name: package-cross-derivation, trivial-build-system
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:821
source:
+ (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 ((drv (package-cross-derivation
+                  %store
+                  p
+                  "mips64el-linux-gnu")))
+       (derivation? drv))))
actual-value: #t
result: PASS

test-name: package-cross-derivation, no cross builder
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:828
source:
+ (test-assert
+   "package-cross-derivation, no cross builder"
+   (let* ((b (build-system
+               (inherit trivial-build-system)
+               (lower (const #f))))
+          (p (package
+               (inherit (dummy-package "p"))
+               (build-system b))))
+     (guard (c ((package-cross-build-system-error? c)
+                (eq? (package-error-package c) p)))
+            (package-cross-derivation
+              %store
+              p
+              "mips64el-linux-gnu")
+            #f)))
actual-value: #t
result: PASS

test-name: package-grafts, indirect grafts
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:856
source:
+ (test-assert
+   "package-grafts, indirect grafts"
+   (let* ((new (dummy-package
+                 "dep"
+                 (arguments '(#:implicit-inputs? #f))))
+          (dep (package (inherit new) (version "0.0")))
+          (dep* (package (inherit dep) (replacement new)))
+          (dummy (dummy-package
+                   "dummy"
+                   (arguments '(#:implicit-inputs? #f))
+                   (inputs `(("dep" ,dep*))))))
+     (equal?
+       (package-grafts %store dummy)
+       (list (graft (origin (package-derivation %store dep))
+                    (replacement (package-derivation %store new)))))))
actual-value: #t
result: PASS

test-name: package-grafts, indirect grafts, propagated inputs
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:889
source:
+ (test-assert
+   "package-grafts, indirect grafts, propagated inputs"
+   (let* ((new (dummy-package
+                 "dep"
+                 (arguments '(#:implicit-inputs? #f))))
+          (dep (package (inherit new) (version "0.0")))
+          (dep* (package (inherit dep) (replacement new)))
+          (prop (dummy-package
+                  "propagated"
+                  (propagated-inputs `(("dep" ,dep*)))
+                  (arguments '(#:implicit-inputs? #f))))
+          (dummy (dummy-package
+                   "dummy"
+                   (arguments '(#:implicit-inputs? #f))
+                   (inputs `(("prop" ,prop))))))
+     (equal?
+       (package-grafts %store dummy)
+       (list (graft (origin (package-derivation %store dep))
+                    (replacement (package-derivation %store new)))))))
actual-value: #t
result: PASS

test-name: package-grafts, same replacement twice
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:905
source:
+ (test-assert
+   "package-grafts, same replacement twice"
+   (let* ((new (dummy-package
+                 "dep"
+                 (version "1")
+                 (arguments '(#:implicit-inputs? #f))))
+          (dep (package
+                 (inherit new)
+                 (version "0")
+                 (replacement new)))
+          (p1 (dummy-package
+                "intermediate1"
+                (arguments '(#:implicit-inputs? #f))
+                (inputs `(("dep" ,dep)))))
+          (p2 (dummy-package
+                "intermediate2"
+                (arguments '(#:implicit-inputs? #f))
+                (inputs `(("dep" ,(package (inherit dep)))))))
+          (p3 (dummy-package
+                "final"
+                (arguments '(#:implicit-inputs? #f))
+                (inputs `(("p1" ,p1) ("p2" ,p2))))))
+     (equal?
+       (package-grafts %store p3)
+       (list (graft (origin
+                      (package-derivation
+                        %store
+                        (package (inherit dep) (replacement #f))))
+                    (replacement (package-derivation %store new)))))))
actual-value: #t
result: PASS

test-name: package-grafts, dependency on several outputs
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:929
source:
+ (test-assert
+   "package-grafts, dependency on several outputs"
+   (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"))))))

;;; ((#<graft /home/joshua/prog/gnu/guix/guix-src/test-tmp/store/8cqk5miizh623krka4llq7q3w1nn38b1-p0-1.0-lib ==> /home/joshua/prog/gnu/guix/guix-src/test-tmp/store/mxhdjca9qs28gzmbkflzqpfv6kalxfc2-p0-1.1-lib 7fe6256b2840> #<graft /home/joshua/prog/gnu/guix/guix-src/test-tmp/store/bfyy157xqjx9k4xlabsdiplzjg3kmm49-p0-1.0 ==> /home/joshua/prog/gnu/guix/guix-src/test-tmp/store/rpx0n6d7cikmz835dcfxrhgnfx2ma8nq-p0-1.1 7fe6256b28a0>))
actual-value: #t
result: PASS

test-name: replacement also grafted
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:953
source:
+ (test-assert
+   "replacement also grafted"
+   (let* ((p1r (dummy-package
+                 "P1"
+                 (build-system trivial-build-system)
+                 (arguments
+                   `(#:guile
+                     ,%bootstrap-guile
+                     #:builder
+                     (let ((out (assoc-ref %outputs "out")))
+                       (mkdir out)
+                       (call-with-output-file
+                         (string-append out "/replacement")
+                         (const #t)))))))
+          (p1 (package
+                (inherit p1r)
+                (name "p1")
+                (replacement p1r)
+                (arguments
+                  `(#:guile
+                    ,%bootstrap-guile
+                    #:builder
+                    (begin (mkdir (assoc-ref %outputs "out")) #t)))))
+          (p2r (dummy-package
+                 "P2"
+                 (build-system trivial-build-system)
+                 (inputs `(("p1" ,p1)))
+                 (arguments
+                   `(#:guile
+                     ,%bootstrap-guile
+                     #:builder
+                     (let ((out (assoc-ref %outputs "out")))
+                       (mkdir out)
+                       (chdir out)
+                       (symlink (assoc-ref %build-inputs "p1") "p1")
+                       (call-with-output-file
+                         (string-append out "/replacement")
+                         (const #t)))))))
+          (p2 (package
+                (inherit p2r)
+                (name "p2")
+                (replacement p2r)
+                (arguments
+                  `(#:guile
+                    ,%bootstrap-guile
+                    #:builder
+                    (let ((out (assoc-ref %outputs "out")))
+                      (mkdir out)
+                      (chdir out)
+                      (symlink (assoc-ref %build-inputs "p1") "p1")
+                      #t)))))
+          (p3 (dummy-package
+                "p3"
+                (build-system trivial-build-system)
+                (inputs `(("p2" ,p2)))
+                (arguments
+                  `(#:guile
+                    ,%bootstrap-guile
+                    #:builder
+                    (let ((out (assoc-ref %outputs "out")))
+                      (mkdir out)
+                      (chdir out)
+                      (symlink (assoc-ref %build-inputs "p2") "p2")
+                      #t))))))
+     (lset= equal?
+            (package-grafts %store p3)
+            (list (graft (origin
+                           (package-derivation %store p1 #:graft? #f))
+                         (replacement (package-derivation %store p1r)))
+                  (graft (origin
+                           (package-derivation %store p2 #:graft? #f))
+                         (replacement
+                           (package-derivation %store p2r #:graft? #t)))))))
actual-value: #t
result: PASS

test-name: package->bag
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1050
source:
+ (test-equal
+   "package->bag"
+   `("foo86-hurd"
+     #f
+     (,(package-source gnu-make))
+     (,(canonical-package glibc))
+     (,(canonical-package coreutils)))
+   (let ((bag (package->bag gnu-make "foo86-hurd")))
+     (list (bag-system bag)
+           (bag-target bag)
+           (assoc-ref (bag-build-inputs bag) "source")
+           (assoc-ref (bag-build-inputs bag) "libc")
+           (assoc-ref (bag-build-inputs bag) "coreutils"))))
expected-value: ("foo86-hurd" #f (#<origin "mirror://gnu/make/make-4.3.tar.gz" #<content-hash sha256:06cfqzpqsvdnsxbysl5p2fgdgxgl9y4p7scpnrfa8z2zgkjdspz0> ("/home/joshua/prog/gnu/guix/guix-src/gnu/packages/patches/make-impure-dirs.patch") 7fe627040d80>) (#<package glibc@2.31 gnu/packages/commencement.scm:3447 7fe62713a140>) (#<package coreutils@8.32 guix/build-system/gnu.scm:143 7fe627142460>))
actual-value: ("foo86-hurd" #f (#<origin "mirror://gnu/make/make-4.3.tar.gz" #<content-hash sha256:06cfqzpqsvdnsxbysl5p2fgdgxgl9y4p7scpnrfa8z2zgkjdspz0> ("/home/joshua/prog/gnu/guix/guix-src/gnu/packages/patches/make-impure-dirs.patch") 7fe627040d80>) (#<package glibc@2.31 gnu/packages/commencement.scm:3447 7fe62713a140>) (#<package coreutils@8.32 guix/build-system/gnu.scm:143 7fe627142460>))
result: PASS

test-name: package->bag, sensitivity to %current-target-system
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1059
source:
+ (test-assert
+   "package->bag, sensitivity to %current-target-system"
+   (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)))))
actual-value: #t
result: PASS

test-name: package->bag, cross-compilation
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1092
source:
+ (test-equal
+   "package->bag, cross-compilation"
+   `(,(%current-system)
+     "foo86-hurd"
+     (,(package-source gnu-make))
+     (,(canonical-package glibc))
+     (,(canonical-package coreutils)))
+   (let ((bag (package->bag
+                gnu-make
+                (%current-system)
+                "foo86-hurd")))
+     (list (bag-system bag)
+           (bag-target bag)
+           (assoc-ref (bag-build-inputs bag) "source")
+           (assoc-ref (bag-build-inputs bag) "libc")
+           (assoc-ref (bag-build-inputs bag) "coreutils"))))
expected-value: ("x86_64-linux" "foo86-hurd" (#<origin "mirror://gnu/make/make-4.3.tar.gz" #<content-hash sha256:06cfqzpqsvdnsxbysl5p2fgdgxgl9y4p7scpnrfa8z2zgkjdspz0> ("/home/joshua/prog/gnu/guix/guix-src/gnu/packages/patches/make-impure-dirs.patch") 7fe627040d80>) (#<package glibc@2.31 gnu/packages/commencement.scm:3447 7fe62713a140>) (#<package coreutils@8.32 guix/build-system/gnu.scm:143 7fe627142460>))
actual-value: ("x86_64-linux" "foo86-hurd" (#<origin "mirror://gnu/make/make-4.3.tar.gz" #<content-hash sha256:06cfqzpqsvdnsxbysl5p2fgdgxgl9y4p7scpnrfa8z2zgkjdspz0> ("/home/joshua/prog/gnu/guix/guix-src/gnu/packages/patches/make-impure-dirs.patch") 7fe627040d80>) (#<package glibc@2.31 gnu/packages/commencement.scm:3447 7fe62713a140>) (#<package coreutils@8.32 guix/build-system/gnu.scm:143 7fe627142460>))
result: PASS

test-name: package->bag, propagated inputs
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1102
source:
+ (test-assert
+   "package->bag, propagated inputs"
+   (let* ((dep (dummy-package "dep"))
+          (prop (dummy-package
+                  "prop"
+                  (propagated-inputs `(("dep" ,dep)))))
+          (dummy (dummy-package
+                   "dummy"
+                   (inputs `(("prop" ,prop)))))
+          (inputs
+            (bag-transitive-inputs
+              (package->bag dummy #:graft? #f))))
+     (match (assoc "dep" inputs)
+            (("dep" package) (eq? package dep)))))
actual-value: #t
result: PASS

test-name: package->bag, sensitivity to %current-system
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1113
source:
+ (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)))))
actual-value: #t
result: PASS

test-name: package->bag, sensitivity to %current-target-system
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1127
source:
+ (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)))))
actual-value: #t
result: PASS

test-name: bag->derivation
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1140
source:
+ (test-assert
+   "bag->derivation"
+   (parameterize
+     ((%graft? #f))
+     (let ((bag (package->bag gnu-make))
+           (drv (package-derivation %store gnu-make)))
+       (parameterize
+         ((%current-system "foox86-hurd"))
+         (equal? drv (bag->derivation %store bag))))))
actual-value: #t
result: PASS

test-name: bag->derivation, cross-compilation
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1147
source:
+ (test-assert
+   "bag->derivation, cross-compilation"
+   (parameterize
+     ((%graft? #f))
+     (let* ((target "mips64el-linux-gnu")
+            (bag (package->bag gnu-make (%current-system) target))
+            (drv (package-cross-derivation %store gnu-make target)))
+       (parameterize
+         ((%current-system "foox86-hurd")
+          (%current-target-system "foo64-linux-gnu"))
+         (equal? drv (bag->derivation %store bag))))))
actual-value: #t
result: PASS

test-name: GNU Make, bootstrap
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1158
source:
+ (test-assert
+   "GNU Make, bootstrap"
+   (let ((gnu-make gnu-make-for-tests))
+     (and (package? gnu-make)
+          (or (location? (package-location gnu-make))
+              (not (package-location gnu-make)))
+          (let* ((drv (package-derivation %store gnu-make))
+                 (out (derivation->output-path drv)))
+            (and (build-derivations %store (list drv))
+                 (file-exists? (string-append out "/bin/make")))))))
actual-value: #t
result: PASS

test-name: package-mapping
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1170
source:
+ (test-equal
+   "package-mapping"
+   42
+   (let* ((dep (dummy-package
+                 "chbouib"
+                 (native-inputs `(("x" ,grep)))))
+          (p0 (dummy-package
+                "example"
+                (inputs
+                  `(("foo" ,coreutils) ("bar" ,grep) ("baz" ,dep)))))
+          (transform
+            (lambda (p) (package (inherit p) (source 42))))
+          (rewrite (package-mapping transform))
+          (p1 (rewrite p0)))
+     (and (eq? p1 (rewrite p0))
+          (eqv? 42 (package-source p1))
+          (match (package-inputs p1)
+                 ((("foo" dep1) ("bar" dep2) ("baz" dep3))
+                  (and (eq? dep1 (rewrite coreutils))
+                       (eq? dep2 (rewrite grep))
+                       (eq? dep3 (rewrite dep))
+                       (eqv? 42
+                             (package-source dep1)
+                             (package-source dep2)
+                             (package-source dep3))
+                       (match (package-native-inputs dep3)
+                              ((("x" dep))
+                               (and (eq? dep (rewrite grep))
+                                    (package-source dep))))))))))
expected-value: 42
actual-value: 42
result: PASS

test-name: package-input-rewriting
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1197
source:
+ (test-assert
+   "package-input-rewriting"
+   (let* ((dep (dummy-package
+                 "chbouib"
+                 (native-inputs `(("x" ,grep)))))
+          (p0 (dummy-package
+                "example"
+                (inputs
+                  `(("foo" ,coreutils) ("bar" ,grep) ("baz" ,dep)))))
+          (rewrite
+            (package-input-rewriting
+              `((,coreutils unquote sed)
+                (,grep unquote findutils))
+              (cut string-append "r-" <>)))
+          (p1 (rewrite p0))
+          (p2 (rewrite p0)))
+     (and (not (eq? p1 p0))
+          (eq? p1 p2)
+          (string=? "r-example" (package-name p1))
+          (match (package-inputs p1)
+                 ((("foo" dep1) ("bar" dep2) ("baz" dep3))
+                  (and (eq? dep1 sed)
+                       (eq? dep2 findutils)
+                       (string=? (package-name dep3) "r-chbouib")
+                       (eq? dep3 (rewrite dep))
+                       (match (package-native-inputs dep3)
+                              ((("x" dep)) (eq? dep findutils)))))))))
actual-value: #t
result: PASS

test-name: package-input-rewriting/spec
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1222
source:
+ (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" unquote (const sed))
+                ("grep" unquote (const findutils)))))
+          (p1 (rewrite p0))
+          (p2 (rewrite p0)))
+     (and (not (eq? p1 p0))
+          (eq? p1 p2)
+          (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))
+                       (match (package-native-inputs dep3)
+                              ((("x" dep))
+                               (string=?
+                                 (package-full-name dep)
+                                 (package-full-name findutils))))))))))
actual-value: #t
result: PASS

test-name: package-input-rewriting/spec, partial match
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1250
source:
+ (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" unquote (const sed))
+                ("grep" unquote (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))
+                       (match (package-native-inputs dep2)
+                              ((("x" dep))
+                               (string=?
+                                 (package-full-name dep)
+                                 (package-full-name findutils))))))))))
actual-value: #t
result: PASS

test-name: package-patched-vulnerabilities
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1273
source:
+ (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))))
expected-value: (("CVE-2015-1234") ("CVE-2016-1234" "CVE-2018-4567") ())
actual-value: (("CVE-2015-1234") ("CVE-2016-1234" "CVE-2018-4567") ())
result: PASS

test-name: fold-packages
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1288
source:
+ (test-eq
+   "fold-packages"
+   hello
+   (fold-packages
+     (lambda (p r)
+       (if (string=? (package-name p) "hello") p r))
+     #f))
expected-value: #<package hello@2.10 gnu/packages/base.scm:74 7fe62703a6e0>
actual-value: #<package hello@2.10 gnu/packages/base.scm:74 7fe62703a6e0>
result: PASS

test-name: fold-packages, hidden package
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1295
source:
+ (test-assert
+   "fold-packages, hidden package"
+   (match (fold-packages
+            (lambda (p r)
+              (if (and (string=? (package-name p) "guile")
+                       (string-prefix? "2.0" (package-version p)))
+                (cons p r)
+                r))
+            '())
+          ((one) (eq? one guile-2.0))))
actual-value: #t
result: PASS

test-name: fold-available-packages with/without cache
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1309
source:
+ (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))
+                         '()))))))
+     (and (equal?
+            (delete-duplicates from-cache)
+            from-cache)
+          (lset= equal? no-cache from-cache))))
actual-value: #f
result: FAIL

test-name: find-packages-by-name
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1332
source:
+ (test-assert
+   "find-packages-by-name"
+   (match (find-packages-by-name "hello")
+          (((? (cut eq? hello <>))) #t)
+          (wrong (pk 'find-packages-by-name wrong #f))))
actual-value: #t
result: PASS

test-name: find-packages-by-name with version
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1337
source:
+ (test-assert
+   "find-packages-by-name with version"
+   (match (find-packages-by-name
+            "hello"
+            (package-version hello))
+          (((? (cut eq? hello <>))) #t)
+          (wrong (pk 'find-packages-by-name wrong #f))))
actual-value: #t
result: PASS

test-name: find-packages-by-name with cache
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1342
source:
+ (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"))))))
expected-value: (#<package guile@3.0.4 gnu/packages/guile.scm:313 7fe62821c320> #<package guile@3.0.2 gnu/packages/guile.scm:284 7fe62821c3c0> #<package guile@2.2.7 gnu/packages/guile.scm:233 7fe62821c500> #<package guile@2.2.4 gnu/packages/guile.scm:271 7fe62821c460> #<package guile@2.0.14 gnu/packages/guile.scm:138 7fe62821c5a0> #<package guile@1.8.8 gnu/packages/guile.scm:75 7fe62821c640>)
actual-value: (#<package guile@3.0.4 gnu/packages/guile.scm:313 7fe62821c320> #<package guile@3.0.2 gnu/packages/guile.scm:284 7fe62821c3c0> #<package guile@2.2.7 gnu/packages/guile.scm:233 7fe62821c500> #<package guile@2.2.4 gnu/packages/guile.scm:271 7fe62821c460> #<package guile@2.0.14 gnu/packages/guile.scm:138 7fe62821c5a0> #<package guile@1.8.8 gnu/packages/guile.scm:75 7fe62821c640>)
result: PASS

test-name: find-packages-by-name + version, with cache
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1351
source:
+ (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"))))))
expected-value: (#<package guile@2.2.7 gnu/packages/guile.scm:233 7fe62821c500> #<package guile@2.2.4 gnu/packages/guile.scm:271 7fe62821c460> #<package guile@2.0.14 gnu/packages/guile.scm:138 7fe62821c5a0>)
actual-value: (#<package guile@2.2.7 gnu/packages/guile.scm:233 7fe62821c500> #<package guile@2.2.4 gnu/packages/guile.scm:271 7fe62821c460> #<package guile@2.0.14 gnu/packages/guile.scm:138 7fe62821c5a0>)
result: PASS

test-name: --search-paths with pattern
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1360
source:
+ (test-assert
+   "--search-paths with pattern"
+   (let* ((p1 (package
+                (name "foo")
+                (version "0")
+                (source #f)
+                (build-system trivial-build-system)
+                (arguments
+                  `(#:guile
+                    ,%bootstrap-guile
+                    #:modules
+                    ((guix build utils))
+                    #:builder
+                    (begin
+                      (use-modules (guix build utils))
+                      (let ((out (assoc-ref %outputs "out")))
+                        (mkdir-p (string-append out "/xml/bar/baz"))
+                        (call-with-output-file
+                          (string-append out "/xml/bar/baz/catalog.xml")
+                          (lambda (port) (display "xml? wat?!" port)))
+                        #t))))
+                (synopsis #f)
+                (description #f)
+                (home-page #f)
+                (license #f)))
+          (p2 (package
+                (name "libxml2")
+                (version "0.0.0")
+                (source #f)
+                (build-system trivial-build-system)
+                (arguments
+                  `(#:guile
+                    ,%bootstrap-guile
+                    #:builder
+                    (begin (mkdir (assoc-ref %outputs "out")) #t)))
+                (native-search-paths
+                  (package-native-search-paths libxml2))
+                (synopsis #f)
+                (description #f)
+                (home-page #f)
+                (license #f)))
+          (prof (run-with-store
+                  %store
+                  (profile-derivation
+                    (manifest
+                      (map package->manifest-entry (list p1 p2)))
+                    #:hooks
+                    '()
+                    #:locales?
+                    #f)
+                  #:guile-for-build
+                  (%guile-for-build))))
+     (build-derivations %store (list prof))
+     (string-match
+       (format
+         #f
+         "^export XML_CATALOG_FILES=\"~a/xml/+bar/baz/catalog\\.xml\"\n"
+         (regexp-quote (derivation->output-path prof)))
+       (with-output-to-string
+         (lambda ()
+           (guix-package
+             "-p"
+             (derivation->output-path prof)
+             "--search-paths"))))))
actual-value: #("export XML_CATALOG_FILES=\"/home/joshua/prog/gnu/guix/guix-src/test-tmp/store/7s60s8ilcn8si358l7r8lj2913y1ip5i-profile/xml/bar/baz/catalog.xml\"\n" (0 . 143))
result: PASS

test-name: --search-paths with single-item search path
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1411
source:
+ (test-assert
+   "--search-paths with single-item search path"
+   (let* ((p1 (dummy-package
+                "foo"
+                (build-system trivial-build-system)
+                (arguments
+                  `(#:guile
+                    ,%bootstrap-guile
+                    #:modules
+                    ((guix build utils))
+                    #:builder
+                    (begin
+                      (use-modules (guix build utils))
+                      (let ((out (assoc-ref %outputs "out")))
+                        (mkdir-p (string-append out "/etc/ssl/certs"))
+                        (call-with-output-file
+                          (string-append
+                            out
+                            "/etc/ssl/certs/ca-certificates.crt")
+                          (const #t))))))))
+          (p2 (package (inherit p1) (name "bar")))
+          (p3 (dummy-package
+                "git"
+                (build-system trivial-build-system)
+                (arguments
+                  `(#:guile
+                    ,%bootstrap-guile
+                    #:builder
+                    (begin (mkdir (assoc-ref %outputs "out")) #t)))
+                (native-search-paths
+                  (package-native-search-paths git))))
+          (prof1 (run-with-store
+                   %store
+                   (profile-derivation
+                     (packages->manifest (list p1 p3))
+                     #:hooks
+                     '()
+                     #:locales?
+                     #f)
+                   #:guile-for-build
+                   (%guile-for-build)))
+          (prof2 (run-with-store
+                   %store
+                   (profile-derivation
+                     (packages->manifest (list p2 p3))
+                     #:hooks
+                     '()
+                     #:locales?
+                     #f)
+                   #:guile-for-build
+                   (%guile-for-build))))
+     (build-derivations %store (list prof1 prof2))
+     (string-match
+       (format
+         #f
+         "^export GIT_SSL_CAINFO=\"~a/etc/ssl/certs/ca-certificates.crt"
+         (regexp-quote (derivation->output-path prof1)))
+       (with-output-to-string
+         (lambda ()
+           (guix-package
+             "-p"
+             (derivation->output-path prof1)
+             "-p"
+             (derivation->output-path prof2)
+             "--search-paths"))))))
actual-value: #("export GIT_SSL_CAINFO=\"/home/joshua/prog/gnu/guix/guix-src/test-tmp/store/h5xvbjmv0dj6plbiz7013ar946jc3mkk-profile/etc/ssl/certs/ca-certificates.crt\"\n" (0 . 148))
result: PASS

test-name: specification->package when not found
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1459
source:
+ (test-equal
+   "specification->package when not found"
+   'quit
+   (catch 'quit
+          (lambda ()
+            (specification->package
+              "this-package-does-not-exist"))
+          (lambda (key . args) key)))
expected-value: quit
actual-value: quit
result: PASS

test-name: specification->package+output
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1468
source:
+ (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)))
expected-value: ((#<package coreutils@8.32 gnu/packages/base.scm:307 7fe62703a280> "out") (#<package coreutils@8.32 gnu/packages/base.scm:307 7fe62703a280> "debug"))
actual-value: ((#<package coreutils@8.32 gnu/packages/base.scm:307 7fe62703a280> "out") (#<package coreutils@8.32 gnu/packages/base.scm:307 7fe62703a280> "debug"))
result: PASS

test-name: specification->package+output invalid output
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1477
source:
+ (test-equal
+   "specification->package+output invalid output"
+   'error
+   (catch 'quit
+          (lambda ()
+            (specification->package+output
+              "coreutils:does-not-exist"))
+          (lambda _ 'error)))
expected-value: error
actual-value: error
result: PASS

test-name: specification->package+output no default output
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1485
source:
+ (test-equal
+   "specification->package+output no default output"
+   `(,coreutils #f)
+   (call-with-values
+     (lambda ()
+       (specification->package+output "coreutils" #f))
+     list))
expected-value: (#<package coreutils@8.32 gnu/packages/base.scm:307 7fe62703a280> #f)
actual-value: (#<package coreutils@8.32 gnu/packages/base.scm:307 7fe62703a280> #f)
result: PASS

test-name: specification->package+output invalid output, no default
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1492
source:
+ (test-equal
+   "specification->package+output invalid output, no default"
+   'error
+   (catch 'quit
+          (lambda ()
+            (specification->package+output
+              "coreutils:does-not-exist"
+              #f))
+          (lambda _ 'error)))
expected-value: error
actual-value: error
result: PASS

test-name: find-package-locations
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1500
source:
+ (test-equal
+   "find-package-locations"
+   (map (lambda (package)
+          (cons (package-version package)
+                (package-location package)))
+        (find-packages-by-name "guile"))
+   (find-package-locations "guile"))
expected-value: (("3.0.4" . #<<location> file: "gnu/packages/guile.scm" line: 313 column: 2>) ("3.0.2" . #<<location> file: "gnu/packages/guile.scm" line: 284 column: 2>) ("2.2.7" . #<<location> file: "gnu/packages/guile.scm" line: 233 column: 2>) ("2.2.4" . #<<location> file: "gnu/packages/guile.scm" line: 271 column: 2>) ("2.0.14" . #<<location> file: "gnu/packages/guile.scm" line: 138 column: 2>) ("1.8.8" . #<<location> file: "gnu/packages/guile.scm" line: 75 column: 2>))
actual-value: (("3.0.4" . #<<location> file: "gnu/packages/guile.scm" line: 313 column: 2>) ("3.0.2" . #<<location> file: "gnu/packages/guile.scm" line: 284 column: 2>) ("2.2.7" . #<<location> file: "gnu/packages/guile.scm" line: 233 column: 2>) ("2.2.4" . #<<location> file: "gnu/packages/guile.scm" line: 271 column: 2>) ("2.0.14" . #<<location> file: "gnu/packages/guile.scm" line: 138 column: 2>) ("1.8.8" . #<<location> file: "gnu/packages/guile.scm" line: 75 column: 2>))
result: PASS

test-name: find-package-locations with cache
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1507
source:
+ (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"))))))
expected-value: (("3.0.4" . #<<location> file: "gnu/packages/guile.scm" line: 313 column: 2>) ("3.0.2" . #<<location> file: "gnu/packages/guile.scm" line: 284 column: 2>) ("2.2.7" . #<<location> file: "gnu/packages/guile.scm" line: 233 column: 2>) ("2.2.4" . #<<location> file: "gnu/packages/guile.scm" line: 271 column: 2>) ("2.0.14" . #<<location> file: "gnu/packages/guile.scm" line: 138 column: 2>) ("1.8.8" . #<<location> file: "gnu/packages/guile.scm" line: 75 column: 2>))
actual-value: (("3.0.4" . #<<location> file: "gnu/packages/guile.scm" line: 313 column: 2>) ("3.0.2" . #<<location> file: "gnu/packages/guile.scm" line: 284 column: 2>) ("2.2.7" . #<<location> file: "gnu/packages/guile.scm" line: 233 column: 2>) ("2.2.4" . #<<location> file: "gnu/packages/guile.scm" line: 271 column: 2>) ("2.0.14" . #<<location> file: "gnu/packages/guile.scm" line: 138 column: 2>) ("1.8.8" . #<<location> file: "gnu/packages/guile.scm" line: 75 column: 2>))
result: PASS

test-name: specification->location
location: /home/joshua/prog/gnu/guix/guix-src/tests/packages.scm:1519
source:
+ (test-equal
+   "specification->location"
+   (package-location
+     (specification->package "guile@2"))
+   (specification->location "guile@2"))
expected-value: #<<location> file: "gnu/packages/guile.scm" line: 233 column: 2>
actual-value: #<<location> file: "gnu/packages/guile.scm" line: 233 column: 2>
result: PASS

error: this-package-does-not-exist: unknown package
error: package `coreutils@8.32' lacks output `does-not-exist'
error: package `coreutils@8.32' lacks output `does-not-exist'
warning: ambiguous package specification `guile@2'
warning: choosing guile@2.2.7 from gnu/packages/guile.scm:233:2


^ permalink raw reply	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2020-08-10 12:42 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2020-08-10 10:07 bug#42794: make check fails test "tests/packages.scm fold-available-packages with/without cache" jbranso--- via Bug reports for GNU Guix
2020-08-10 12:41 ` Mathieu Othacehe

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.