======================================== 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 + "^#$" + (with-output-to-string + (lambda () + (write (dummy-package + "foo" + (location (make-location "foo.scm" 42 7)))))))) actual-value: #("#" (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 + "^#$" + (with-output-to-string + (lambda () + (write (dummy-package "foo" (location #f))))))) actual-value: #("#" (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) + ((($ "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) + ((($ "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) + ((($ "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 + (($ 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" #) ("c" #) ("d" #) ("a" #) ("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: (# () 7fe6256c9420>) actual-value: (# () 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: (# () 7fe6256c94e0>) actual-value: (# () 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 (# () 7fe6256c95a0> # () 7fe6256c9420>)) actual-value: (# () 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 (# () 7fe6256c94e0> # () 7fe6256c95a0> # () 7fe6256c9420>)) actual-value: (# () 7fe6256c94e0> # () 7fe6256c95a0> # () 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 # /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: (# #) actual-value: (# #) 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 # /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 # /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 # /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")))))) ;;; ((# /home/joshua/prog/gnu/guix/guix-src/test-tmp/store/mxhdjca9qs28gzmbkflzqpfv6kalxfc2-p0-1.1-lib 7fe6256b2840> # /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 (# ("/home/joshua/prog/gnu/guix/guix-src/gnu/packages/patches/make-impure-dirs.patch") 7fe627040d80>) (#) (#)) actual-value: ("foo86-hurd" #f (# ("/home/joshua/prog/gnu/guix/guix-src/gnu/packages/patches/make-impure-dirs.patch") 7fe627040d80>) (#) (#)) 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" (# ("/home/joshua/prog/gnu/guix/guix-src/gnu/packages/patches/make-impure-dirs.patch") 7fe627040d80>) (#) (#)) actual-value: ("x86_64-linux" "foo86-hurd" (# ("/home/joshua/prog/gnu/guix/guix-src/gnu/packages/patches/make-impure-dirs.patch") 7fe627040d80>) (#) (#)) 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: # actual-value: # 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: (# # # # # #) actual-value: (# # # # # #) 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: (# # #) actual-value: (# # #) 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: ((# "out") (# "debug")) actual-value: ((# "out") (# "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: (# #f) actual-value: (# #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" . #< file: "gnu/packages/guile.scm" line: 313 column: 2>) ("3.0.2" . #< file: "gnu/packages/guile.scm" line: 284 column: 2>) ("2.2.7" . #< file: "gnu/packages/guile.scm" line: 233 column: 2>) ("2.2.4" . #< file: "gnu/packages/guile.scm" line: 271 column: 2>) ("2.0.14" . #< file: "gnu/packages/guile.scm" line: 138 column: 2>) ("1.8.8" . #< file: "gnu/packages/guile.scm" line: 75 column: 2>)) actual-value: (("3.0.4" . #< file: "gnu/packages/guile.scm" line: 313 column: 2>) ("3.0.2" . #< file: "gnu/packages/guile.scm" line: 284 column: 2>) ("2.2.7" . #< file: "gnu/packages/guile.scm" line: 233 column: 2>) ("2.2.4" . #< file: "gnu/packages/guile.scm" line: 271 column: 2>) ("2.0.14" . #< file: "gnu/packages/guile.scm" line: 138 column: 2>) ("1.8.8" . #< 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" . #< file: "gnu/packages/guile.scm" line: 313 column: 2>) ("3.0.2" . #< file: "gnu/packages/guile.scm" line: 284 column: 2>) ("2.2.7" . #< file: "gnu/packages/guile.scm" line: 233 column: 2>) ("2.2.4" . #< file: "gnu/packages/guile.scm" line: 271 column: 2>) ("2.0.14" . #< file: "gnu/packages/guile.scm" line: 138 column: 2>) ("1.8.8" . #< file: "gnu/packages/guile.scm" line: 75 column: 2>)) actual-value: (("3.0.4" . #< file: "gnu/packages/guile.scm" line: 313 column: 2>) ("3.0.2" . #< file: "gnu/packages/guile.scm" line: 284 column: 2>) ("2.2.7" . #< file: "gnu/packages/guile.scm" line: 233 column: 2>) ("2.2.4" . #< file: "gnu/packages/guile.scm" line: 271 column: 2>) ("2.0.14" . #< file: "gnu/packages/guile.scm" line: 138 column: 2>) ("1.8.8" . #< 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: #< file: "gnu/packages/guile.scm" line: 233 column: 2> actual-value: #< 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