%%%% Starting test packages
Group begin: packages
Test begin:
  test-name: "package-field-location"
  source-file: "tests/packages.scm"
  source-line: 58
  source-form: (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 (quote name))) (let ((name (package-name %bootstrap-guile))) (list name (quasiquote (name (unquote name)))))) (member (read-at (package-field-location %bootstrap-guile (quote version))) (let ((version (package-version %bootstrap-guile))) (list version (quasiquote (version (unquote version)))))) (not (package-field-location %bootstrap-guile (quote does-not-exist))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "package-field-location, relative file name"
  source-file: "tests/packages.scm"
  source-line: 85
  source-form: (test-equal "package-field-location, relative file name" (location-file (package-location %bootstrap-guile)) (with-fluids ((%file-port-name-canonicalization (quote absolute))) (location-file (package-field-location %bootstrap-guile (quote version)))))
Test end:
  result-kind: pass
  actual-value: "gnu/packages/bootstrap.scm"
  expected-value: "gnu/packages/bootstrap.scm"
Test begin:
  test-name: "package-transitive-inputs"
  source-file: "tests/packages.scm"
  source-line: 90
  source-form: (test-assert "package-transitive-inputs" (let* ((a (dummy-package "a")) (b (dummy-package "b" (propagated-inputs (quasiquote (("a" (unquote a))))))) (c (dummy-package "c" (inputs (quasiquote (("a" (unquote a))))))) (d (dummy-package "d" (propagated-inputs (quasiquote (("x" "something.drv")))))) (e (dummy-package "e" (inputs (quasiquote (("b" (unquote b)) ("c" (unquote c)) ("d" (unquote d)))))))) (and (null? (package-transitive-inputs a)) (equal? (quasiquote (("a" (unquote a)))) (package-transitive-inputs b)) (equal? (quasiquote (("a" (unquote a)))) (package-transitive-inputs c)) (equal? (package-propagated-inputs d) (package-transitive-inputs d)) (equal? (quasiquote (("b" (unquote b)) ("b/a" (unquote a)) ("c" (unquote c)) ("d" (unquote d)) ("d/x" "something.drv"))) (pk (quote x) (package-transitive-inputs e))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "package-source-derivation, file"
  source-file: "tests/packages.scm"
  source-line: 111
  source-form: (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)))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "package-source-derivation, store path"
  source-file: "tests/packages.scm"
  source-line: 122
  source-form: (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)))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "package-source-derivation, indirect store path"
  source-file: "tests/packages.scm"
  source-line: 131
  source-form: (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))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "package-source-derivation, snippet"
  source-file: "tests/packages.scm"
  source-line: 144
  source-form: (test-equal "package-source-derivation, snippet" "OK" (let* ((file (search-bootstrap-binary "guile-2.0.9.tar.xz" (%current-system))) (sha256 (call-with-input-file file port-sha256)) (fetch (lambda* (store url hash-algo hash #:optional name #:key system) (pk (quote fetch) url hash-algo hash name system) (add-to-store store (basename url) #f "sha256" url))) (source (bootstrap-origin (origin (method fetch) (uri file) (sha256 sha256) (patch-inputs (quasiquote (("tar" (unquote %bootstrap-coreutils&co)) ("xz" (unquote %bootstrap-coreutils&co)) ("patch" (unquote %bootstrap-coreutils&co))))) (patch-guile %bootstrap-guile) (modules (quote ((guix build utils)))) (imported-modules modules) (snippet (quote (begin (chmod "." 511) (symlink "guile" "guile-rocks") (copy-recursively "../share/guile/2.0/scripts" "scripts") (pk %build-inputs %outputs))))))) (package (package (inherit (dummy-package "with-snippet")) (source source) (build-system trivial-build-system) (inputs (quasiquote (("tar" (unquote (search-bootstrap-binary "tar" (%current-system)))) ("xz" (unquote (search-bootstrap-binary "xz" (%current-system))))))) (arguments (quasiquote (#:guile (unquote %bootstrap-guile) #:builder (let ((tar (assoc-ref %build-inputs "tar")) (xz (assoc-ref %build-inputs "xz")) (source (assoc-ref %build-inputs "source"))) (and (zero? (system* tar "xvf" source "--use-compress-program" xz)) (string=? "guile" (readlink "bin/guile-rocks")) (file-exists? "bin/scripts/compile.scm") (let ((out (assoc-ref %outputs "out"))) (call-with-output-file out (lambda (p) (display "OK" p))))))))))) (drv (package-derivation %store package)) (out (derivation->output-path drv))) (and (build-derivations %store (list (pk (quote snippet-drv) drv))) (call-with-input-file out get-string-all))))
Test end:
  result-kind: pass
  actual-value: "OK"
  expected-value: "OK"
Test begin:
  test-name: "return value"
  source-file: "tests/packages.scm"
  source-line: 203
  source-form: (test-assert "return value" (let ((drv (package-derivation %store (dummy-package "p")))) (and (derivation? drv) (file-exists? (derivation-file-name drv)))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "package-output"
  source-file: "tests/packages.scm"
  source-line: 208
  source-form: (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")))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "trivial"
  source-file: "tests/packages.scm"
  source-line: 215
  source-form: (test-assert "trivial" (let* ((p (package (inherit (dummy-package "trivial")) (build-system trivial-build-system) (source #f) (arguments (quasiquote (#:guile (unquote %bootstrap-guile) #:builder (begin (mkdir %output) (call-with-output-file (string-append %output "/test") (lambda (p) (display (quote (hello guix)) p))))))))) (d (package-derivation %store p))) (and (build-derivations %store (list d)) (let ((p (pk (quote drv) d (derivation->output-path d)))) (equal? (quote (hello guix)) (call-with-input-file (string-append p "/test") read))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "trivial with local file as input"
  source-file: "tests/packages.scm"
  source-line: 233
  source-form: (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 (quasiquote (#:guile (unquote %bootstrap-guile) #:builder (copy-file (assoc-ref %build-inputs "input") %output)))) (inputs (quasiquote (("input" (unquote i))))))) (d (package-derivation %store p))) (and (build-derivations %store (list d)) (let ((p (pk (quote drv) d (derivation->output-path d)))) (equal? (call-with-input-file p get-bytevector-all) (call-with-input-file i get-bytevector-all))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "trivial with source"
  source-file: "tests/packages.scm"
  source-line: 249
  source-form: (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 (quasiquote (#:guile (unquote %bootstrap-guile) #:builder (copy-file (assoc-ref %build-inputs "source") %output)))))) (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))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "trivial with system-dependent input"
  source-file: "tests/packages.scm"
  source-line: 264
  source-form: (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 (quasiquote (#:guile (unquote %bootstrap-guile) #:builder (let ((out (assoc-ref %outputs "out")) (bash (assoc-ref %build-inputs "bash"))) (zero? (system* bash "-c" (format #f "echo hello > ~a" out))))))) (inputs (quasiquote (("bash" (unquote (search-bootstrap-binary "bash" (%current-system))))))))) (d (package-derivation %store p))) (and (build-derivations %store (list d)) (let ((p (pk (quote drv) d (derivation->output-path d)))) (eq? (quote hello) (call-with-input-file p read))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "search paths"
  source-file: "tests/packages.scm"
  source-line: 282
  source-form: (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") (build (lambda* (store name source inputs #:key outputs system search-paths) search-paths)))) (x (list (search-path-specification (variable "GUILE_LOAD_PATH") (directories (quote ("share/guile/site/2.0")))) (search-path-specification (variable "GUILE_LOAD_COMPILED_PATH") (directories (quote ("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 (quasiquote (("guile" (unquote a))))))) (c (package (inherit (dummy-package "guile-bar")) (build-system s) (inputs (quasiquote (("guile" (unquote a)) ("guile-foo" (unquote 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)))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "package-cross-derivation"
  source-file: "tests/packages.scm"
  source-line: 317
  source-form: (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)))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "package-cross-derivation, trivial-build-system"
  source-file: "tests/packages.scm"
  source-line: 323
  source-form: (test-assert "package-cross-derivation, trivial-build-system" (let ((p (package (inherit (dummy-package "p")) (build-system trivial-build-system) (arguments (quote (#:builder (exit 1))))))) (let ((drv (package-cross-derivation %store p "mips64el-linux-gnu"))) (derivation? drv))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "package-cross-derivation, no cross builder"
  source-file: "tests/packages.scm"
  source-line: 330
  source-form: (test-assert "package-cross-derivation, no cross builder" (let* ((b (build-system (inherit trivial-build-system) (cross-build #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)))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "GNU Make, bootstrap"
  source-file: "tests/packages.scm"
  source-line: 342
  source-form: (test-assert "GNU Make, bootstrap" (let ((gnu-make (@@ (gnu packages base) gnu-make-boot0))) (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")))))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "fold-packages"
  source-file: "tests/packages.scm"
  source-line: 354
  source-form: (test-eq "fold-packages" hello (fold-packages (lambda (p r) (if (string=? (package-name p) "hello") p r)) #f))
Test end:
  result-kind: pass
  actual-value: #<package hello-2.9 gnu/packages/base.scm:55 a9d8210>
  expected-value: #<package hello-2.9 gnu/packages/base.scm:55 a9d8210>
Test begin:
  test-name: "find-packages-by-name"
  source-file: "tests/packages.scm"
  source-line: 361
  source-form: (test-assert "find-packages-by-name" (match (find-packages-by-name "hello") (((? (cut eq? hello <>))) #t) (wrong (pk (quote find-packages-by-name) wrong #f))))
Test end:
  result-kind: pass
  actual-value: #t
Test begin:
  test-name: "find-packages-by-name with version"
  source-file: "tests/packages.scm"
  source-line: 366
  source-form: (test-assert "find-packages-by-name with version" (match (find-packages-by-name "hello" (package-version hello)) (((? (cut eq? hello <>))) #t) (wrong (pk (quote find-packages-by-name) wrong #f))))
Test end:
  result-kind: pass
  actual-value: #t
Group end: packages
# of expected passes      21