%%%% Starting test store Group begin: store Test begin: test-name: "store-path-hash-part" source-file: "tests/store.scm" source-line: 58 source-form: (test-equal "store-path-hash-part" "283gqy39v3g9dxjy26rynl0zls82fmcg" (store-path-hash-part (string-append (%store-prefix) "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))) Test end: result-kind: pass actual-value: "283gqy39v3g9dxjy26rynl0zls82fmcg" expected-value: "283gqy39v3g9dxjy26rynl0zls82fmcg" Test begin: test-name: "store-path-hash-part #f" source-file: "tests/store.scm" source-line: 64 source-form: (test-equal "store-path-hash-part #f" #f (store-path-hash-part (string-append (%store-prefix) "/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))) Test end: result-kind: pass actual-value: #f expected-value: #f Test begin: test-name: "store-path-package-name" source-file: "tests/store.scm" source-line: 70 source-form: (test-equal "store-path-package-name" "guile-2.0.7" (store-path-package-name (string-append (%store-prefix) "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7"))) Test end: result-kind: pass actual-value: "guile-2.0.7" expected-value: "guile-2.0.7" Test begin: test-name: "store-path-package-name #f" source-file: "tests/store.scm" source-line: 76 source-form: (test-equal "store-path-package-name #f" #f (store-path-package-name "/foo/bar/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7")) Test end: result-kind: pass actual-value: #f expected-value: #f Test begin: test-name: "direct-store-path?" source-file: "tests/store.scm" source-line: 81 source-form: (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))))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "valid-path? live" source-file: "tests/store.scm" source-line: 93 source-form: (test-assert "valid-path? live" (let ((p (add-text-to-store %store "hello" "hello, world"))) (valid-path? %store p))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "valid-path? false" source-file: "tests/store.scm" source-line: 97 source-form: (test-assert "valid-path? false" (not (valid-path? %store (string-append (%store-prefix) "/" (make-string 32 #\e) "-foobar")))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "valid-path? error" source-file: "tests/store.scm" source-line: 102 source-form: (test-assert "valid-path? error" (with-store s (guard (c ((nix-protocol-error? c) #t)) (valid-path? s "foo") #f))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "valid-path? recovery" source-file: "tests/store.scm" source-line: 108 source-form: (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")))))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "hash-part->path" source-file: "tests/store.scm" source-line: 125 source-form: (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))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "dead-paths" source-file: "tests/store.scm" source-line: 130 source-form: (test-assert "dead-paths" (let ((p (add-text-to-store %store "random-text" (random-text)))) (member p (dead-paths %store)))) Test end: result-kind: pass actual-value: ("/home/nikita/guix/guix-savannah/test-tmp/store/z8pp09v5blb998dqkfl35q865qhsxg85-random-text" "/home/nikita/guix/guix-savannah/test-tmp/store/z8s2qipnmqzjmcfmf5bf16dhbgj5yryd-input.lock" "/home/nikita/guix/guix-savannah/test-tmp/store/zc25b4hj1smnk1n6y8vz4952bhbh947l-xcb-proto-1.7.1.tar.bz2-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/zc3hdr8s2pn6ggwq38ab3nngp89lfpj8-small-fixed-rec-guile-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/zc8y9538jh7s0zgbv5ym59fkhbyjf1rk-inputproto-2.2.tar.bz2-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/zclqih0ykr3bw0xx9mchji6268hdjjmh-libxrender-0.9.7.drv" "/home/nikita/guix/guix-savannah/test-tmp/store/zcnkwlhm9z85dp5a22vj6096lmiizipy-Python-2.7.6.tar.xz-guile-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/zhi6sz1n45kvg1ca3n8flpmqaf3si4as-readline-6.3.tar.xz.drv" "/home/nikita/guix/guix-savannah/test-tmp/store/zhk6widzr9fbalsv19pv58ih9mpiaagm-double.drv" "/home/nikita/guix/guix-savannah/test-tmp/store/zhmczkkaxabx6lgckgfk1nkplfnjahad-gdbm-1.11.drv" "/home/nikita/guix/guix-savannah/test-tmp/store/zi88mzyd8vv2wfbbwavbjj2d1fqw93rf-m4-1.4.17.tar.xz.drv" "/home/nikita/guix/guix-savannah/test-tmp/store/ziain09kpmz230fafz0jm7pskzi9x5l3-gmp-5.1.3-guile-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/zja9rm74rms76zlj7j5jqbkd3ckpjpy7-sed-4.2.2-guile-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/zk3qjjddk04cgg0121zpnc5icfnm0d6k-guile-2.0.9.tar.xz" "/home/nikita/guix/guix-savannah/test-tmp/store/zl3r4zlypwm4mipmd859jlbgp3ipvvn6-pkg-config-0.27.1-guile-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/zlva1hpp2fvp62sdfsgf7x8j8i7a0yms-flex-2.5.37.tar.xz-guile-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/zm15rai059j7jvnz1nld1h1x5l4yx95q-bison-2.7.1-guile-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/znq6nhvws165km6anjcly72z1w3vm9c8-references-graphs.drv" "/home/nikita/guix/guix-savannah/test-tmp/store/znv7xr4mpfqdkgw7vw7jm8rhkgkki583-gc-7.4.0.tar.gz.drv" "/home/nikita/guix/guix-savannah/test-tmp/store/zp0mwmgyby3kni4y8knrcxdyjsr5b347-foo-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/zq1fsldxk2mnkw3jy03zhlg80dlh04rf-glib-2.39.1.tar.xz.drv" "/home/nikita/guix/guix-savannah/test-tmp/store/zq7x0jfbbxrblxzjain0hlcw0s1f80il-xz-5.0.4.tar.gz.drv" "/home/nikita/guix/guix-savannah/test-tmp/store/zqdhvc9vviv1k4xbqvm3gzhk04amfzbi-libice-1.0.8-guile-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/zqygrvaym020jj4gdkkd5n4rf2im7g79-cloog-0.18.0.tar.gz.drv" "/home/nikita/guix/guix-savannah/test-tmp/store/zrahpaf2gmnn56m6n7p4xmy8yhmqcakl-goo-guile-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/zrdwfnkbmwaq8igbcqy0j4rxigfqja2a-readline-6.2.drv" "/home/nikita/guix/guix-savannah/test-tmp/store/zrkr440ps8nxwbgjjmbv2sr2mwcq90xf-libxau-1.0.7-guile-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/zrqhgckwjnqr5p74m278h1jb9mzzlqf8-acl-2.2.51-guile-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/zswhyql3nmpfc53l2qabgsnpr9psmhdr-glibc-bootstrap-0" "/home/nikita/guix/guix-savannah/test-tmp/store/zvxs0d0yx5xqgrfiz24lxc7b8rcazpl3-glibc-2.19.tar.xz.drv" "/home/nikita/guix/guix-savannah/test-tmp/store/zvza65bqm12n6rw5zd2pdjxa15vjbh6k-module-import-compiled" "/home/nikita/guix/guix-savannah/test-tmp/store/zw2c97rqj67hxmvqbacg3rd5qnp5va74-test-with-modules.drv" "/home/nikita/guix/guix-savannah/test-tmp/store/zysvl4i44wkfjl7a3zkfg42gjg6zdkzd-m4-1.4.17.tar.bz2.drv" "/home/nikita/guix/guix-savannah/test-tmp/store/zyv8f4crwrhwmhswa3n7ga74hgqzxgn0-libgc-7.4.0-guile-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/zz7c5ck4713bpkrmiwlqpqkd4lapg3dd-emacs-24.3-guile-builder" "/home/nikita/guix/guix-savannah/test-tmp/store/zzalgfrjgyr4zg0xp1dzmriimggnm8v7-coreutils-8.22.tar.xz-guile-builder") Test begin: test-name: "permanent root" source-file: "tests/store.scm" source-line: 151 source-form: (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))))))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "dead path can be explicitly collected" source-file: "tests/store.scm" source-line: 163 source-form: (test-assert "dead path can be explicitly collected" (let ((p (add-text-to-store %store "random-text" (random-text) (quote ())))) (let-values (((paths freed) (delete-paths %store (list p)))) (and (equal? paths (list p)) (> freed 0) (not (file-exists? p)))))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "references" source-file: "tests/store.scm" source-line: 171 source-form: (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))))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "requisites" source-file: "tests/store.scm" source-line: 181 source-form: (test-assert "requisites" (let* ((t1 (add-text-to-store %store "random1" (random-text) (quote ()))) (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 t1) (list t1)) (same? (requisites %store t2) (list t1 t2)) (same? (requisites %store t3) (list t1 t2 t3)) (same? (requisites %store t4) (list t1 t2 t3 t4))))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "derivers" source-file: "tests/store.scm" source-line: 199 source-form: (test-assert "derivers" (let* ((b (add-text-to-store %store "build" "echo $foo > $out" (quote ()))) (s (add-to-store %store "bash" #t "sha256" (search-bootstrap-binary "bash" (%current-system)))) (d (derivation %store "the-thing" s (quasiquote ("-e" (unquote b))) #:env-vars (quasiquote (("foo" unquote (random-text)))) #:inputs (quasiquote (((unquote b)) ((unquote 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)))))) Test end: result-kind: fail actual-value: #f actual-error: (srfi-34 #) Test begin: test-name: "topologically-sorted, one item" source-file: "tests/store.scm" source-line: 215 source-form: (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)))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "topologically-sorted, several items" source-file: "tests/store.scm" source-line: 223 source-form: (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)))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "topologically-sorted, more difficult" source-file: "tests/store.scm" source-line: 232 source-form: (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))))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "log-file, derivation" source-file: "tests/store.scm" source-line: 256 source-form: (test-assert "log-file, derivation" (let* ((b (add-text-to-store %store "build" "echo $foo > $out" (quote ()))) (s (add-to-store %store "bash" #t "sha256" (search-bootstrap-binary "bash" (%current-system)))) (d (derivation %store "the-thing" s (quasiquote ("-e" (unquote b))) #:env-vars (quasiquote (("foo" unquote (random-text)))) #:inputs (quasiquote (((unquote b)) ((unquote s))))))) (and (build-derivations %store (list d)) (file-exists? (pk (log-file %store (derivation-file-name d))))))) Test end: result-kind: fail actual-value: #f actual-error: (srfi-34 #) Test begin: test-name: "log-file, output file name" source-file: "tests/store.scm" source-line: 268 source-form: (test-assert "log-file, output file name" (let* ((b (add-text-to-store %store "build" "echo $foo > $out" (quote ()))) (s (add-to-store %store "bash" #t "sha256" (search-bootstrap-binary "bash" (%current-system)))) (d (derivation %store "the-thing" s (quasiquote ("-e" (unquote b))) #:env-vars (quasiquote (("foo" unquote (random-text)))) #:inputs (quasiquote (((unquote b)) ((unquote 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))))) Test end: result-kind: fail actual-value: #f actual-error: (srfi-34 #) Test begin: test-name: "no substitutes" source-file: "tests/store.scm" source-line: 283 source-form: (test-assert "no substitutes" (let* ((s (open-connection)) (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))))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "substitute query" source-file: "tests/store.scm" source-line: 296 source-form: (test-assert "substitute query" (let* ((s (open-connection)) (d (package-derivation s %bootstrap-guile (%current-system))) (o (derivation->output-path d)) (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (compose uri-path string->uri)))) (call-with-output-file (string-append dir "/nix-cache-info") (lambda (p) (format p "StoreDir: ~a\nWantMassQuery: 0\n" (%store-prefix)))) (call-with-output-file (string-append dir "/" (store-path-hash-part o) ".narinfo") (lambda (p) (format p "StorePath: ~a\nURL: ~a\nCompression: none\nNarSize: 1234\nReferences: \nSystem: ~a\nDeriver: ~a~%" o (string-append dir "/example.nar") (%current-system) (basename (derivation-file-name d))))) (false-if-exception (delete-file (string-append (getenv "XDG_CACHE_HOME") "/guix/substitute-binary/" (store-path-hash-part o)))) (set-build-options s #:use-substitutes? #t) (and (has-substitutes? s o) (equal? (list o) (substitutable-paths s (list o))) (match (pk (quote 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))))))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "substitute" source-file: "tests/store.scm" source-line: 339 source-form: (test-assert "substitute" (let* ((s (open-connection)) (c (random-text)) (d (build-expression->derivation s "substitute-me" (quasiquote (call-with-output-file %output (lambda (p) (exit 1) (display (unquote c) p)))) #:guile-for-build (package-derivation s %bootstrap-guile (%current-system)))) (o (derivation->output-path d)) (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (compose uri-path string->uri)))) (call-with-output-file (string-append dir "/nix-cache-info") (lambda (p) (format p "StoreDir: ~a\nWantMassQuery: 0\n" (%store-prefix)))) (call-with-output-file (string-append dir "/example.out") (lambda (p) (display c p))) (call-with-output-file (string-append dir "/example.nar") (lambda (p) (write-file (string-append dir "/example.out") p))) (call-with-output-file (string-append dir "/" (store-path-hash-part o) ".narinfo") (lambda (p) (format p "StorePath: ~a\nURL: ~a\nCompression: none\nNarSize: 1234\nNarHash: sha256:~a\nReferences: \nSystem: ~a\nDeriver: ~a~%" o "example.nar" (call-with-input-file (string-append dir "/example.nar") (compose bytevector->nix-base32-string sha256 get-bytevector-all)) (%current-system) (basename (derivation-file-name d))))) (set-build-options s #:use-substitutes? #t) (and (has-substitutes? s o) (build-derivations s (list d)) (equal? c (call-with-input-file o get-string-all))))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "substitute, corrupt output hash" source-file: "tests/store.scm" source-line: 390 source-form: (test-assert "substitute, corrupt output hash" (let* ((s (open-connection)) (c "hello, world") (d (build-expression->derivation s "corrupt-substitute" (quasiquote (mkdir %output)) #:guile-for-build (package-derivation s %bootstrap-guile (%current-system)))) (o (derivation->output-path d)) (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (compose uri-path string->uri)))) (call-with-output-file (string-append dir "/nix-cache-info") (lambda (p) (format p "StoreDir: ~a\nWantMassQuery: 0\n" (%store-prefix)))) (call-with-output-file (string-append dir "/example.out") (lambda (p) (display "The contents here do not match C." p))) (call-with-output-file (string-append dir "/example.nar") (lambda (p) (write-file (string-append dir "/example.out") p))) (call-with-output-file (string-append dir "/" (store-path-hash-part o) ".narinfo") (lambda (p) (format p "StorePath: ~a\nURL: ~a\nCompression: none\nNarSize: 1234\nNarHash: sha256:~a\nReferences: \nSystem: ~a\nDeriver: ~a~%" o "example.nar" (bytevector->nix-base32-string (sha256 (string->utf8 c))) (%current-system) (basename (derivation-file-name d))))) (set-build-options s #:use-substitutes? #t #:fallback? #f) (and (has-substitutes? s o) (guard (c ((nix-protocol-error? c) (pk (quote corrupt) c) (not (zero? (nix-protocol-error-status c))))) (build-derivations s (list d)) #f)))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "substitute --fallback" source-file: "tests/store.scm" source-line: 448 source-form: (test-assert "substitute --fallback" (let* ((s (open-connection)) (t (random-text)) (d (build-expression->derivation s "substitute-me-not" (quasiquote (call-with-output-file %output (lambda (p) (display (unquote t) p)))) #:guile-for-build (package-derivation s %bootstrap-guile (%current-system)))) (o (derivation->output-path d)) (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (compose uri-path string->uri)))) (call-with-output-file (string-append dir "/nix-cache-info") (lambda (p) (format p "StoreDir: ~a\nWantMassQuery: 0\n" (%store-prefix)))) (call-with-output-file (string-append dir "/" (store-path-hash-part o) ".narinfo") (lambda (p) (format p "StorePath: ~a\nURL: ~a\nCompression: none\nNarSize: 1234\nNarHash: sha256:0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73\nReferences: \nSystem: ~a\nDeriver: ~a~%" o "does-not-exist.nar" (%current-system) (basename (derivation-file-name d))))) (set-build-options s #:use-substitutes? #t) (and (has-substitutes? s o) (guard (c ((nix-protocol-error? c) (set-build-options s #:use-substitutes? #t #:fallback? #t) (and (build-derivations s (list d)) (equal? t (call-with-input-file o get-string-all))))) (build-derivations s (list d)) #f)))) Test end: result-kind: fail actual-value: #f actual-error: (srfi-34 #) Test begin: test-name: "export/import several paths" source-file: "tests/store.scm" source-line: 498 source-form: (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))))))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "export/import paths, ensure topological order" source-file: "tests/store.scm" source-line: 518 source-form: (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))))))) Test end: result-kind: pass actual-value: #t Test begin: test-name: "import corrupt path" source-file: "tests/store.scm" source-line: 540 source-form: (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 (quote 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 (quote corrupt-imported) imported) #f))))) Test end: result-kind: pass actual-value: 80 Test begin: test-name: "register-path" source-file: "tests/store.scm" source-line: 563 source-form: (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)))))) Test end: result-kind: pass actual-value: #t Group end: store # of expected passes 26 # of unexpected failures 4