test-name: store-path-hash-part location: /home/rsd/v/git/others/guix/tests/store.scm:51 source: + (test-equal + "store-path-hash-part" + "283gqy39v3g9dxjy26rynl0zls82fmcg" + (store-path-hash-part + (string-append + (%store-prefix) + "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))) expected-value: 283gqy39v3g9dxjy26rynl0zls82fmcg actual-value: 283gqy39v3g9dxjy26rynl0zls82fmcg result: PASS test-name: store-path-hash-part #f location: /home/rsd/v/git/others/guix/tests/store.scm:57 source: + (test-equal + "store-path-hash-part #f" + #f + (store-path-hash-part + (string-append + (%store-prefix) + "/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))) expected-value: #f actual-value: #f result: PASS test-name: store-path-package-name location: /home/rsd/v/git/others/guix/tests/store.scm:63 source: + (test-equal + "store-path-package-name" + "guile-2.0.7" + (store-path-package-name + (string-append + (%store-prefix) + "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))) expected-value: guile-2.0.7 actual-value: guile-2.0.7 result: PASS test-name: store-path-package-name #f location: /home/rsd/v/git/others/guix/tests/store.scm:69 source: + (test-equal + "store-path-package-name #f" + #f + (store-path-package-name + "/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")) expected-value: #f actual-value: #f result: PASS test-name: direct-store-path? location: /home/rsd/v/git/others/guix/tests/store.scm:74 source: + (test-assert + "direct-store-path?" + (and (direct-store-path? + (string-append + (%store-prefix) + "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")) + (not (direct-store-path? + (string-append + (%store-prefix) + "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7/bin/guile"))) + (not (direct-store-path? (%store-prefix))))) actual-value: #t result: PASS test-name: valid-path? live location: /home/rsd/v/git/others/guix/tests/store.scm:86 source: + (test-assert + "valid-path? live" + (let ((p (add-text-to-store %store "hello" "hello, world"))) + (valid-path? %store p))) result: SKIP test-name: valid-path? false location: /home/rsd/v/git/others/guix/tests/store.scm:90 source: + (test-assert + "valid-path? false" + (not (valid-path? + %store + (string-append + (%store-prefix) + "/" + (make-string 32 #\e) + "-foobar")))) result: SKIP test-name: valid-path? error location: /home/rsd/v/git/others/guix/tests/store.scm:95 source: + (test-assert + "valid-path? error" + (with-store + s + (guard (c ((nix-protocol-error? c) #t)) + (valid-path? s "foo") + #f))) result: SKIP test-name: valid-path? recovery location: /home/rsd/v/git/others/guix/tests/store.scm:101 source: + (test-assert + "valid-path? recovery" + (with-store + s + (let-syntax ((true-if-error + (syntax-rules () + ((_ exp) + (guard (c ((nix-protocol-error? c) #t)) exp #f))))) + (and (true-if-error (valid-path? s "foo")) + (true-if-error (valid-path? s "bar")) + (true-if-error (valid-path? s "baz")) + (true-if-error (valid-path? s "chbouib")) + (valid-path? + s + (add-text-to-store s "valid" "yeah")))))) result: SKIP test-name: hash-part->path location: /home/rsd/v/git/others/guix/tests/store.scm:118 source: + (test-assert + "hash-part->path" + (let ((p (add-text-to-store %store "hello" "hello, world"))) + (equal? + (hash-part->path %store (store-path-hash-part p)) + p))) result: SKIP test-name: dead-paths location: /home/rsd/v/git/others/guix/tests/store.scm:123 source: + (test-assert + "dead-paths" + (let ((p (add-text-to-store + %store + "random-text" + (random-text)))) + (->bool (member p (dead-paths %store))))) result: SKIP test-name: permanent root location: /home/rsd/v/git/others/guix/tests/store.scm:144 source: + (test-assert + "permanent root" + (let* ((p (with-store + store + (let ((p (add-text-to-store + store + "random-text" + (random-text)))) + (add-permanent-root p) + (add-permanent-root p) + p)))) + (and (member p (live-paths %store)) + (begin + (remove-permanent-root p) + (->bool (member p (dead-paths %store))))))) result: SKIP test-name: dead path can be explicitly collected location: /home/rsd/v/git/others/guix/tests/store.scm:156 source: + (test-assert + "dead path can be explicitly collected" + (let ((p (add-text-to-store + %store + "random-text" + (random-text) + '()))) + (let-values + (((paths freed) (delete-paths %store (list p)))) + (and (equal? paths (list p)) + (> freed 0) + (not (file-exists? p)))))) result: SKIP test-name: add-text-to-store vs. delete-paths location: /home/rsd/v/git/others/guix/tests/store.scm:164 source: + (test-assert + "add-text-to-store vs. delete-paths" + (with-store + store + (let* ((text (random-text)) + (path (add-text-to-store store "delete-me" text)) + (deleted (delete-paths store (list path))) + (path2 (add-text-to-store store "delete-me" text))) + (and (string=? path path2) + (equal? deleted (list path)) + (valid-path? store path) + (file-exists? path))))) result: SKIP test-name: add-to-store vs. delete-paths location: /home/rsd/v/git/others/guix/tests/store.scm:177 source: + (test-assert + "add-to-store vs. delete-paths" + (with-store + store + (let* ((file (search-path %load-path "guix.scm")) + (path (add-to-store store "delete-me" #t "sha256" file)) + (deleted (delete-paths store (list path))) + (path2 (add-to-store store "delete-me" #t "sha256" file))) + (and (string=? path path2) + (equal? deleted (list path)) + (valid-path? store path) + (file-exists? path))))) result: SKIP test-name: references location: /home/rsd/v/git/others/guix/tests/store.scm:189 source: + (test-assert + "references" + (let* ((t1 (add-text-to-store + %store + "random1" + (random-text))) + (t2 (add-text-to-store + %store + "random2" + (random-text) + (list t1)))) + (and (equal? (list t1) (references %store t2)) + (equal? (list t2) (referrers %store t1)) + (null? (references %store t1)) + (null? (referrers %store t2))))) result: SKIP test-name: references/substitutes missing reference info location: /home/rsd/v/git/others/guix/tests/store.scm:199 source: + (test-assert + "references/substitutes missing reference info" + (with-store + s + (set-build-options s #:use-substitutes? #f) + (guard (c ((nix-protocol-error? c) #t)) + (let* ((b (add-to-store + s + "bash" + #t + "sha256" + (search-bootstrap-binary + "bash" + (%current-system)))) + (d (derivation + s + "the-thing" + b + '("--help") + #:inputs + `((,b))))) + (references/substitutes + s + (list (derivation->output-path d) b)) + #f)))) result: SKIP test-name: references/substitutes with substitute info location: /home/rsd/v/git/others/guix/tests/store.scm:211 source: + (test-assert + "references/substitutes with substitute info" + (with-store + s + (set-build-options s #:use-substitutes? #t) + (let* ((t1 (add-text-to-store s "random1" (random-text))) + (t2 (add-text-to-store + s + "random2" + (random-text) + (list t1))) + (t3 (add-text-to-store + s + "build" + "echo -n $t2 > $out")) + (b (add-to-store + s + "bash" + #t + "sha256" + (search-bootstrap-binary + "bash" + (%current-system)))) + (d (derivation + s + "the-thing" + b + `("-e" ,t3) + #:inputs + `((,b) (,t3) (,t2)) + #:env-vars + `(("t2" unquote t2)))) + (o (derivation->output-path d))) + (with-derivation-narinfo + d + (sha256 => (sha256 (string->utf8 t2))) + (references => (list t2)) + (equal? + (references/substitutes s (list o t3 t2 t1)) + `((,t2) () (,t1) ())))))) result: SKIP test-name: substitutable-path-info when substitutes are turned off location: /home/rsd/v/git/others/guix/tests/store.scm:235 source: + (test-equal + "substitutable-path-info when substitutes are turned off" + '() + (with-store + s + (set-build-options s #:use-substitutes? #f) + (let* ((b (add-to-store + s + "bash" + #t + "sha256" + (search-bootstrap-binary + "bash" + (%current-system)))) + (d (derivation + s + "the-thing" + b + '("--version") + #:inputs + `((,b)))) + (o (derivation->output-path d))) + (with-derivation-narinfo + d + (substitutable-path-info s (list o)))))) expected-value: () actual-value: #f actual-error: + (srfi-34 + #) result: FAIL test-name: substitutable-paths when substitutes are turned off location: /home/rsd/v/git/others/guix/tests/store.scm:248 source: + (test-equal + "substitutable-paths when substitutes are turned off" + '() + (with-store + s + (set-build-options s #:use-substitutes? #f) + (let* ((b (add-to-store + s + "bash" + #t + "sha256" + (search-bootstrap-binary + "bash" + (%current-system)))) + (d (derivation + s + "the-thing" + b + '("--version") + #:inputs + `((,b)))) + (o (derivation->output-path d))) + (with-derivation-narinfo + d + (substitutable-paths s (list o)))))) expected-value: () actual-value: #f actual-error: + (srfi-34 + #) result: FAIL test-name: requisites location: /home/rsd/v/git/others/guix/tests/store.scm:261 source: + (test-assert + "requisites" + (let* ((t1 (add-text-to-store + %store + "random1" + (random-text) + '())) + (t2 (add-text-to-store + %store + "random2" + (random-text) + (list t1))) + (t3 (add-text-to-store + %store + "random3" + (random-text) + (list t2))) + (t4 (add-text-to-store + %store + "random4" + (random-text) + (list t1 t3)))) + (define (same? x y) + (and (= (length x) (length y)) + (lset= equal? x y))) + (and (same? (requisites %store (list t1)) (list t1)) + (same? (requisites %store (list t2)) + (list t1 t2)) + (same? (requisites %store (list t3)) + (list t1 t2 t3)) + (same? (requisites %store (list t4)) + (list t1 t2 t3 t4)) + (same? (requisites %store (list t1 t2 t3 t4)) + (list t1 t2 t3 t4))))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: derivers location: /home/rsd/v/git/others/guix/tests/store.scm:281 source: + (test-assert + "derivers" + (let* ((b (add-text-to-store + %store + "build" + "echo $foo > $out" + '())) + (s (add-to-store + %store + "bash" + #t + "sha256" + (search-bootstrap-binary + "bash" + (%current-system)))) + (d (derivation + %store + "the-thing" + s + `("-e" ,b) + #:env-vars + `(("foo" unquote (random-text))) + #:inputs + `((,b) (,s)))) + (o (derivation->output-path d))) + (and (build-derivations %store (list d)) + (equal? + (query-derivation-outputs + %store + (derivation-file-name d)) + (list o)) + (equal? + (valid-derivers %store o) + (list (derivation-file-name d)))))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: topologically-sorted, one item location: /home/rsd/v/git/others/guix/tests/store.scm:297 source: + (test-assert + "topologically-sorted, one item" + (let* ((a (add-text-to-store %store "a" "a")) + (b (add-text-to-store %store "b" "b" (list a))) + (c (add-text-to-store %store "c" "c" (list b))) + (d (add-text-to-store %store "d" "d" (list c))) + (s (topologically-sorted %store (list d)))) + (equal? s (list a b c d)))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: topologically-sorted, several items location: /home/rsd/v/git/others/guix/tests/store.scm:305 source: + (test-assert + "topologically-sorted, several items" + (let* ((a (add-text-to-store %store "a" "a")) + (b (add-text-to-store %store "b" "b" (list a))) + (c (add-text-to-store %store "c" "c" (list b))) + (d (add-text-to-store %store "d" "d" (list c))) + (s1 (topologically-sorted %store (list d a c b))) + (s2 (topologically-sorted %store (list b d c a b d)))) + (equal? s1 s2 (list a b c d)))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: topologically-sorted, more difficult location: /home/rsd/v/git/others/guix/tests/store.scm:314 source: + (test-assert + "topologically-sorted, more difficult" + (let* ((a (add-text-to-store %store "a" "a")) + (b (add-text-to-store %store "b" "b" (list a))) + (c (add-text-to-store %store "c" "c" (list b))) + (d (add-text-to-store %store "d" "d" (list c))) + (w (add-text-to-store %store "w" "w")) + (x (add-text-to-store %store "x" "x" (list w))) + (y (add-text-to-store %store "y" "y" (list x d))) + (s1 (topologically-sorted %store (list y))) + (s2 (topologically-sorted %store (list c y))) + (s3 (topologically-sorted + %store + (cons y (references %store y))))) + (let* ((x-then-d? + (equal? (references %store y) (list x d)))) + (and (equal? + s1 + (if x-then-d? + (list w x a b c d y) + (list a b c d w x y))) + (equal? + s2 + (if x-then-d? + (list a b c w x d y) + (list a b c d w x y))) + (lset= string=? s1 s3))))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: current-build-output-port, UTF-8 location: /home/rsd/v/git/others/guix/tests/store.scm:338 source: + (test-assert + "current-build-output-port, UTF-8" + (string-contains + (with-fluids + ((%default-port-encoding "UTF-8")) + (call-with-output-string + (lambda (port) + (parameterize + ((current-build-output-port port)) + (let* ((s "Here\u2019s a Greek letter: \u03bb.") + (d (build-expression->derivation + %store + "foo" + `(display ,s) + #:guile-for-build + (package-derivation + s + %bootstrap-guile + (%current-system))))) + (guard (c ((nix-protocol-error? c) #t)) + (build-derivations %store (list d)))))))) + "Here\u2019s a Greek letter: \u03bb.")) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 + "struct" + "Here\u2019s a Greek letter: \u03bb.") + ("Here\u2019s a Greek letter: \u03bb.")) result: FAIL test-name: current-build-output-port, UTF-8 + garbage location: /home/rsd/v/git/others/guix/tests/store.scm:354 source: + (test-assert + "current-build-output-port, UTF-8 + garbage" + (string-contains + (with-fluids + ((%default-port-encoding "UTF-8")) + (call-with-output-string + (lambda (port) + (parameterize + ((current-build-output-port port)) + (let ((d (build-expression->derivation + %store + "foo" + `(begin + (use-modules (rnrs io ports)) + (display "garbage: ") + (put-bytevector (current-output-port) #vu8(128)) + (display "lambda: \u03bb\n")) + #:guile-for-build + (package-derivation %store %bootstrap-guile)))) + (guard (c ((nix-protocol-error? c) #t)) + (build-derivations %store (list d)))))))) + "garbage: ?lambda: \u03bb")) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: log-file, derivation location: /home/rsd/v/git/others/guix/tests/store.scm:374 source: + (test-assert + "log-file, derivation" + (let* ((b (add-text-to-store + %store + "build" + "echo $foo > $out" + '())) + (s (add-to-store + %store + "bash" + #t + "sha256" + (search-bootstrap-binary + "bash" + (%current-system)))) + (d (derivation + %store + "the-thing" + s + `("-e" ,b) + #:env-vars + `(("foo" unquote (random-text))) + #:inputs + `((,b) (,s))))) + (and (build-derivations %store (list d)) + (file-exists? + (pk (log-file %store (derivation-file-name d))))))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: log-file, output file name location: /home/rsd/v/git/others/guix/tests/store.scm:386 source: + (test-assert + "log-file, output file name" + (let* ((b (add-text-to-store + %store + "build" + "echo $foo > $out" + '())) + (s (add-to-store + %store + "bash" + #t + "sha256" + (search-bootstrap-binary + "bash" + (%current-system)))) + (d (derivation + %store + "the-thing" + s + `("-e" ,b) + #:env-vars + `(("foo" unquote (random-text))) + #:inputs + `((,b) (,s)))) + (o (derivation->output-path d))) + (and (build-derivations %store (list d)) + (file-exists? (pk (log-file %store o))) + (string=? + (log-file %store (derivation-file-name d)) + (log-file %store o))))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: no substitutes location: /home/rsd/v/git/others/guix/tests/store.scm:401 source: + (test-assert + "no substitutes" + (with-store + s + (let* ((d1 (package-derivation + s + %bootstrap-guile + (%current-system))) + (d2 (package-derivation + s + %bootstrap-glibc + (%current-system))) + (o (map derivation->output-path (list d1 d2)))) + (set-build-options s #:use-substitutes? #f) + (and (not (has-substitutes? s (derivation-file-name d1))) + (not (has-substitutes? s (derivation-file-name d2))) + (null? (substitutable-paths s o)) + (null? (substitutable-path-info s o)))))) actual-value: #f actual-error: + (srfi-34 + #) result: FAIL test-name: build-things with output path location: /home/rsd/v/git/others/guix/tests/store.scm:412 source: + (test-assert + "build-things with output path" + (with-store + s + (let* ((c (random-text)) + (d (build-expression->derivation + s + "substitute-me" + `(call-with-output-file + %output + (lambda (p) (display ,c p))) + #:guile-for-build + (package-derivation + s + %bootstrap-guile + (%current-system)))) + (o (derivation->output-path d))) + (set-build-options s #:use-substitutes? #f) + (build-things s (list o)) + (not (valid-path? s o))))) actual-value: #f actual-error: + (srfi-34 + #) result: FAIL test-name: substitute query location: /home/rsd/v/git/others/guix/tests/store.scm:432 source: + (test-assert + "substitute query" + (with-store + s + (let* ((d (package-derivation + s + %bootstrap-guile + (%current-system))) + (o (derivation->output-path d))) + (with-derivation-narinfo + d + (false-if-exception + (delete-file-recursively + (string-append + (getenv "XDG_CACHE_HOME") + "/guix/substitute"))) + (set-build-options + s + #:use-substitutes? + #t + #:substitute-urls + (%test-substitute-urls)) + (and (has-substitutes? s o) + (equal? + (list o) + (substitutable-paths s (list o))) + (match (pk 'spi (substitutable-path-info s (list o))) + (((? substitutable? s)) + (and (string=? + (substitutable-deriver s) + (derivation-file-name d)) + (null? (substitutable-references s)) + (equal? (substitutable-nar-size s) 1234))))))))) actual-value: #f actual-error: + (srfi-34 + #) result: FAIL test-name: substitute query, alternating URLs location: /home/rsd/v/git/others/guix/tests/store.scm:456 source: + (test-assert + "substitute query, alternating URLs" + (let* ((d (with-store + s + (package-derivation + s + %bootstrap-guile + (%current-system)))) + (o (derivation->output-path d))) + (with-derivation-narinfo + d + (false-if-exception + (delete-file-recursively + (string-append + (getenv "XDG_CACHE_HOME") + "/guix/substitute"))) + (and (with-store + s + (set-build-options + s + #:use-substitutes? + #t + #:substitute-urls + (%test-substitute-urls)) + (has-substitutes? s o)) + (with-store + s + (set-build-options + s + #:use-substitutes? + #t + #:substitute-urls + (list "http://does-not-exist")) + (not (has-substitutes? s o))) + (with-store + s + (set-build-options + s + #:use-substitutes? + #t + #:substitute-urls + (%test-substitute-urls)) + (has-substitutes? s o)) + (with-store + s + (set-build-options + s + #:use-substitutes? + #t + #:substitute-urls + '()) + (not (has-substitutes? s o))))))) actual-value: #f actual-error: + (srfi-34 + #) result: FAIL test-name: substitute location: /home/rsd/v/git/others/guix/tests/store.scm:488 source: + (test-assert + "substitute" + (with-store + s + (let* ((c (random-text)) + (d (build-expression->derivation + s + "substitute-me" + `(call-with-output-file + %output + (lambda (p) (exit 1) (display ,c p))) + #:guile-for-build + (package-derivation + s + %bootstrap-guile + (%current-system)))) + (o (derivation->output-path d))) + (with-derivation-substitute + d + c + (set-build-options + s + #:use-substitutes? + #t + #:substitute-urls + (%test-substitute-urls)) + (and (has-substitutes? s o) + (build-derivations s (list d)) + (equal? + c + (call-with-input-file o get-string-all))))))) actual-value: #f actual-error: + (srfi-34 + #) result: FAIL test-name: substitute + build-things with output path location: /home/rsd/v/git/others/guix/tests/store.scm:507 source: + (test-assert + "substitute + build-things with output path" + (with-store + s + (let* ((c (random-text)) + (d (build-expression->derivation + s + "substitute-me" + `(call-with-output-file + %output + (lambda (p) (exit 1) (display ,c p))) + #:guile-for-build + (package-derivation + s + %bootstrap-guile + (%current-system)))) + (o (derivation->output-path d))) + (with-derivation-substitute + d + c + (set-build-options + s + #:use-substitutes? + #t + #:substitute-urls + (%test-substitute-urls)) + (and (has-substitutes? s o) + (build-things s (list o)) + (valid-path? s o) + (equal? + c + (call-with-input-file o get-string-all))))))) actual-value: #f actual-error: + (srfi-34 + #) result: FAIL test-name: substitute, corrupt output hash location: /home/rsd/v/git/others/guix/tests/store.scm:527 source: + (test-assert + "substitute, corrupt output hash" + (with-store + s + (let* ((c "hello, world") + (d (build-expression->derivation + s + "corrupt-substitute" + `(mkdir %output) + #:guile-for-build + (package-derivation + s + %bootstrap-guile + (%current-system)))) + (o (derivation->output-path d))) + (with-derivation-substitute + d + c + (sha256 => (make-bytevector 32 0)) + (set-build-options + s + #:use-substitutes? + #t + #:fallback? + #f + #:substitute-urls + (%test-substitute-urls)) + (and (has-substitutes? s o) + (guard (c ((nix-protocol-error? c) + (pk 'corrupt c) + (not (zero? (nix-protocol-error-status c))))) + (build-derivations s (list d)) + #f)))))) actual-value: #f actual-error: + (srfi-34 + #) result: FAIL test-name: substitute --fallback location: /home/rsd/v/git/others/guix/tests/store.scm:557 source: + (test-assert + "substitute --fallback" + (with-store + s + (let* ((t (random-text)) + (d (build-expression->derivation + s + "substitute-me-not" + `(call-with-output-file + %output + (lambda (p) (display ,t p))) + #:guile-for-build + (package-derivation + s + %bootstrap-guile + (%current-system)))) + (o (derivation->output-path d))) + (with-derivation-narinfo + d + (set-build-options + s + #:use-substitutes? + #t + #:substitute-urls + (%test-substitute-urls)) + (and (has-substitutes? s o) + (guard (c ((nix-protocol-error? c) + (set-build-options + s + #:use-substitutes? + #t + #:substitute-urls + (%test-substitute-urls) + #:fallback? + #t) + (and (build-derivations s (list d)) + (equal? + t + (call-with-input-file o get-string-all))))) + (build-derivations s (list d)) + #f)))))) actual-value: #f actual-error: + (srfi-34 + #) result: FAIL test-name: export/import several paths location: /home/rsd/v/git/others/guix/tests/store.scm:589 source: + (test-assert + "export/import several paths" + (let* ((texts (unfold + (cut >= <> 10) + (lambda _ (random-text)) + #{1+}# + 0)) + (files (map (cut add-text-to-store %store "text" <>) + texts)) + (dump (call-with-bytevector-output-port + (cut export-paths %store files <>)))) + (delete-paths %store files) + (and (every (negate file-exists?) files) + (let* ((source (open-bytevector-input-port dump)) + (imported (import-paths %store source))) + (and (equal? imported files) + (every file-exists? files) + (equal? + texts + (map (lambda (file) + (call-with-input-file file get-string-all)) + files))))))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: export/import paths, ensure topological order location: /home/rsd/v/git/others/guix/tests/store.scm:609 source: + (test-assert + "export/import paths, ensure topological order" + (let* ((file0 (add-text-to-store %store "baz" (random-text))) + (file1 (add-text-to-store + %store + "foo" + (random-text) + (list file0))) + (file2 (add-text-to-store + %store + "bar" + (random-text) + (list file1))) + (files (list file1 file2)) + (dump1 (call-with-bytevector-output-port + (cute export-paths %store (list file1 file2) <>))) + (dump2 (call-with-bytevector-output-port + (cute export-paths %store (list file2 file1) <>)))) + (delete-paths %store files) + (and (every (negate file-exists?) files) + (bytevector=? dump1 dump2) + (let* ((source (open-bytevector-input-port dump1)) + (imported (import-paths %store source))) + (and (equal? imported (list file1 file2)) + (every file-exists? files) + (equal? (list file0) (references %store file1)) + (equal? (list file1) (references %store file2))))))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: export/import incomplete location: /home/rsd/v/git/others/guix/tests/store.scm:631 source: + (test-assert + "export/import incomplete" + (let* ((file0 (add-text-to-store %store "baz" (random-text))) + (file1 (add-text-to-store + %store + "foo" + (random-text) + (list file0))) + (file2 (add-text-to-store + %store + "bar" + (random-text) + (list file1))) + (dump (call-with-bytevector-output-port + (cute export-paths %store (list file2) <>)))) + (delete-paths %store (list file0 file1 file2)) + (guard (c ((nix-protocol-error? c) + (and (not (zero? (nix-protocol-error-status c))) + (string-contains + (nix-protocol-error-message c) + "not valid")))) + (import-paths + %store + (open-bytevector-input-port dump))))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: export/import recursive location: /home/rsd/v/git/others/guix/tests/store.scm:648 source: + (test-assert + "export/import recursive" + (let* ((file0 (add-text-to-store %store "baz" (random-text))) + (file1 (add-text-to-store + %store + "foo" + (random-text) + (list file0))) + (file2 (add-text-to-store + %store + "bar" + (random-text) + (list file1))) + (dump (call-with-bytevector-output-port + (cute export-paths + %store + (list file2) + <> + #:recursive? + #t)))) + (delete-paths %store (list file0 file1 file2)) + (let ((imported + (import-paths + %store + (open-bytevector-input-port dump)))) + (and (equal? imported (list file0 file1 file2)) + (every file-exists? (list file0 file1 file2)) + (equal? (list file0) (references %store file1)) + (equal? (list file1) (references %store file2)))))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: write-file & export-path yield the same result location: /home/rsd/v/git/others/guix/tests/store.scm:664 source: + (test-assert + "write-file & export-path yield the same result" + (run-with-store + %store + (mlet* %store-monad + ((drv1 (package->derivation %bootstrap-guile)) + (out1 -> (derivation->output-path drv1)) + (data -> + (unfold + (cut >= <> 26) + (lambda (i) (random-bytevector 128)) + #{1+}# + 0)) + (build -> + (gexp (begin + (use-modules (rnrs io ports) (srfi srfi-1)) + (let () + (define letters + (map (lambda (i) + (string + (integer->char + (+ i (char->integer #\a))))) + (iota 26))) + (define (touch file data) + (call-with-output-file + file + (lambda (port) (put-bytevector port data)))) + (mkdir (ungexp output)) + (chdir (ungexp output)) + (for-each + touch + (append (drop letters 10) (take letters 10)) + (list (ungexp-splicing data))) + #t)))) + (drv2 (gexp->derivation "bunch" build)) + (out2 -> (derivation->output-path drv2)) + (item-info -> (store-lift query-path-info))) + (mbegin + %store-monad + (built-derivations (list drv1 drv2)) + (foldm %store-monad + (lambda (item result) + (define ref-hash + (let-values + (((port get) (open-sha256-port))) + (write-file item port) + (close-port port) + (get))) + (>>= (item-info item) + (lambda (info) + (return + (and result + (bytevector=? + (path-info-hash info) + ref-hash)))))) + #t + (list out1 out2)))) + #:guile-for-build + (%guile-for-build))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: import corrupt path location: /home/rsd/v/git/others/guix/tests/store.scm:730 source: + (test-assert + "import corrupt path" + (let* ((text (random-text)) + (file (add-text-to-store %store "text" text)) + (dump (call-with-bytevector-output-port + (cut export-paths %store (list file) <>)))) + (delete-paths %store (list file)) + (let* ((index (quotient (bytevector-length dump) 4)) + (byte (bytevector-u8-ref dump index))) + (bytevector-u8-set! dump index (logxor 255 byte))) + (and (not (file-exists? file)) + (guard (c ((nix-protocol-error? c) + (pk 'c c) + (and (not (zero? (nix-protocol-error-status c))) + (string-contains + (nix-protocol-error-message c) + "corrupt")))) + (let* ((source (open-bytevector-input-port dump)) + (imported (import-paths %store source))) + (pk 'corrupt-imported imported) + #f))))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: register-path location: /home/rsd/v/git/others/guix/tests/store.scm:753 source: + (test-assert + "register-path" + (let ((file (string-append + (%store-prefix) + "/" + (make-string 32 #\f) + "-fake"))) + (when (valid-path? %store file) + (delete-paths %store (list file))) + (false-if-exception (delete-file file)) + (let ((ref (add-text-to-store + %store + "ref-of-fake" + (random-text))) + (drv (string-append file ".drv"))) + (call-with-output-file + file + (cut display "This is a fake store item.\n" <>)) + (register-path + file + #:references + (list ref) + #:deriver + drv) + (and (valid-path? %store file) + (equal? (references %store file) (list ref)) + (null? (valid-derivers %store file)) + (null? (referrers %store file)))))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: verify-store location: /home/rsd/v/git/others/guix/tests/store.scm:773 source: + (test-assert + "verify-store" + (let* ((text (random-text)) + (file1 (add-text-to-store %store "foo" text)) + (file2 (add-text-to-store + %store + "bar" + (random-text) + (list file1)))) + (and (pk 'verify1 (verify-store %store)) + (begin + (delete-file file1) + (not (pk 'verify2 (verify-store %store)))) + (begin + (call-with-output-file + file1 + (lambda (port) (display text port))) + (pk 'verify3 (verify-store %store)))))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: verify-store + check-contents location: /home/rsd/v/git/others/guix/tests/store.scm:790 source: + (test-assert + "verify-store + check-contents" + (with-store + s + (let* ((text (random-text)) + (drv (build-expression->derivation + s + "corrupt" + `(let ((out (assoc-ref %outputs "out"))) + (call-with-output-file + out + (lambda (port) (display ,text port))) + #t) + #:guile-for-build + (package-derivation + s + %bootstrap-guile + (%current-system)))) + (file (derivation->output-path drv))) + (with-derivation-substitute + drv + text + (and (build-derivations s (list drv)) + (verify-store s #:check-contents? #t) + (begin + (chmod file 420) + (call-with-output-file + file + (lambda (port) (display "corrupt!" port))) + #t) + (not (verify-store s #:check-contents? #t)) + (delete-paths s (list file))))))) actual-value: #f actual-error: + (srfi-34 + #) result: FAIL test-name: build-things, check mode location: /home/rsd/v/git/others/guix/tests/store.scm:827 source: + (test-assert + "build-things, check mode" + (with-store + store + (call-with-temporary-output-file + (lambda (entropy entropy-port) + (write (random-text) entropy-port) + (force-output entropy-port) + (let* ((drv (build-expression->derivation + store + "non-deterministic" + `(begin + (use-modules (rnrs io ports)) + (let ((out (assoc-ref %outputs "out"))) + (call-with-output-file + out + (lambda (port) + (display + (call-with-input-file + ,entropy + get-string-all) + port))) + #t)) + #:guile-for-build + (package-derivation + store + %bootstrap-guile + (%current-system)))) + (file (derivation->output-path drv))) + (and (build-things + store + (list (derivation-file-name drv))) + (begin + (write (random-text) entropy-port) + (force-output entropy-port) + (guard (c ((nix-protocol-error? c) + (pk 'determinism-exception c) + (and (not (zero? (nix-protocol-error-status c))) + (string-contains + (nix-protocol-error-message c) + "deterministic")))) + (build-things + store + (list (derivation-file-name drv)) + (build-mode check)) + #f)))))))) actual-value: #f actual-error: + (srfi-34 + #) result: FAIL test-name: build multiple times location: /home/rsd/v/git/others/guix/tests/store.scm:864 source: + (test-assert + "build multiple times" + (with-store + store + (set-build-options + store + #:rounds + 2 + #:use-substitutes? + #f) + (call-with-temporary-output-file + (lambda (entropy entropy-port) + (write (random-text) entropy-port) + (force-output entropy-port) + (let* ((drv (build-expression->derivation + store + "non-deterministic" + `(begin + (use-modules (rnrs io ports)) + (let ((out (assoc-ref %outputs "out"))) + (call-with-output-file + out + (lambda (port) + (display + (call-with-input-file + ,entropy + get-string-all) + port) + (call-with-output-file + ,entropy + (lambda (port) (write 'foobar port))))) + #t)) + #:guile-for-build + (package-derivation + store + %bootstrap-guile + (%current-system)))) + (file (derivation->output-path drv))) + (guard (c ((nix-protocol-error? c) + (pk 'multiple-build c) + (and (not (zero? (nix-protocol-error-status c))) + (string-contains + (nix-protocol-error-message c) + "deterministic")))) + (current-build-output-port (current-error-port)) + (build-things + store + (list (derivation-file-name drv))) + #f)))))) actual-value: #f actual-error: + (srfi-34 + #) result: FAIL test-name: store-lower location: /home/rsd/v/git/others/guix/tests/store.scm:902 source: + (test-equal + "store-lower" + "Lowered." + (let* ((add (store-lower text-file)) + (file (add %store "foo" "Lowered."))) + (call-with-input-file file get-string-all))) expected-value: Lowered. actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: current-system location: /home/rsd/v/git/others/guix/tests/store.scm:908 source: + (test-equal + "current-system" + "bar" + (parameterize + ((%current-system "frob")) + (run-with-store + %store + (mbegin + %store-monad + (set-current-system "bar") + (current-system)) + #:system + "foo"))) expected-value: bar actual-value: bar result: PASS test-name: query-path-info location: /home/rsd/v/git/others/guix/tests/store.scm:917 source: + (test-assert + "query-path-info" + (let* ((ref (add-text-to-store %store "ref" "foo")) + (item (add-text-to-store + %store + "item" + "bar" + (list ref))) + (info (query-path-info %store item))) + (and (equal? (path-info-references info) (list ref)) + (equal? + (path-info-hash info) + (sha256 + (string->utf8 + (call-with-output-string + (cut write-file item <>)))))))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL test-name: path-info-deriver location: /home/rsd/v/git/others/guix/tests/store.scm:927 source: + (test-assert + "path-info-deriver" + (let* ((b (add-text-to-store + %store + "build" + "echo $foo > $out" + '())) + (s (add-to-store + %store + "bash" + #t + "sha256" + (search-bootstrap-binary + "bash" + (%current-system)))) + (d (derivation + %store + "the-thing" + s + `("-e" ,b) + #:env-vars + `(("foo" unquote (random-text))) + #:inputs + `((,b) (,s)))) + (o (derivation->output-path d))) + (and (build-derivations %store (list d)) + (not (path-info-deriver (query-path-info %store b))) + (string=? + (derivation-file-name d) + (path-info-deriver (query-path-info %store o)))))) actual-value: #f actual-error: + (wrong-type-arg + "struct_vtable" + "Wrong type argument in position ~A (expecting ~A): ~S" + (1 "struct" #f) + (#f)) result: FAIL random seed for tests: 1473544907 warning: build daemon error: #