ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-11 21:59:08 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

tests: Use 'with-store' as appropriate.

Browse source 
* tests/store.scm ("no substitutes", "substitute query",
  "substitute", "substitute, corrupt output hash",
  "substitute --fallback"): Use 'with-store' instead of
  'open-connection'.
This commit is contained in:
Ludovic Courtès 2015-02-01 23:16:11 +01:00
parent 1af50c224d
commit 2d53df66de
1 changed files with 168 additions and 168 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

336
tests/store.scm
View file

@ -296,90 +296,90 @@ (define (same? x y)
(log-file %store o))))) (log-file %store o)))))
(test-assert "no substitutes" (test-assert "no substitutes"
(let* ((s (open-connection)) (with-store s
(d1 (package-derivation s %bootstrap-guile (%current-system))) (let* ((d1 (package-derivation s %bootstrap-guile (%current-system)))
(d2 (package-derivation s %bootstrap-glibc (%current-system))) (d2 (package-derivation s %bootstrap-glibc (%current-system)))
(o (map derivation->output-path (list d1 d2)))) (o (map derivation->output-path (list d1 d2))))
(set-build-options s #:use-substitutes? #f) (set-build-options s #:use-substitutes? #f)
(and (not (has-substitutes? s (derivation-file-name d1))) (and (not (has-substitutes? s (derivation-file-name d1)))
(not (has-substitutes? s (derivation-file-name d2))) (not (has-substitutes? s (derivation-file-name d2)))
(null? (substitutable-paths s o)) (null? (substitutable-paths s o))
(null? (substitutable-path-info s o))))) (null? (substitutable-path-info s o))))))
(test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1)) (test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1))
(test-assert "substitute query" (test-assert "substitute query"
(let* ((s (open-connection)) (with-store s
(d (package-derivation s %bootstrap-guile (%current-system))) (let* ((d (package-derivation s %bootstrap-guile (%current-system)))
(o (derivation->output-path d)) (o (derivation->output-path d))
(dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
(compose uri-path string->uri)))) (compose uri-path string->uri))))
;; Create fake substituter data, to be read by `substitute-binary'. ;; Create fake substituter data, to be read by `substitute-binary'.
(call-with-output-file (string-append dir "/nix-cache-info") (call-with-output-file (string-append dir "/nix-cache-info")
(lambda (p) (lambda (p)
(format p "StoreDir: ~a\nWantMassQuery: 0\n" (format p "StoreDir: ~a\nWantMassQuery: 0\n"
(%store-prefix)))) (%store-prefix))))
(call-with-output-file (string-append dir "/" (store-path-hash-part o) (call-with-output-file (string-append dir "/" (store-path-hash-part o)
".narinfo") ".narinfo")
(lambda (p) (lambda (p)
(format p "StorePath: ~a (format p "StorePath: ~a
URL: ~a URL: ~a
Compression: none Compression: none
NarSize: 1234 NarSize: 1234
References: References:
System: ~a System: ~a
Deriver: ~a~%" Deriver: ~a~%"
o ; StorePath o ; StorePath
(string-append dir "/example.nar") ; URL (string-append dir "/example.nar") ; URL
(%current-system) ; System (%current-system) ; System
(basename (basename
(derivation-file-name d))))) ; Deriver (derivation-file-name d))))) ; Deriver
;; Remove entry from the local cache. ;; Remove entry from the local cache.
(false-if-exception (false-if-exception
(delete-file (string-append (getenv "XDG_CACHE_HOME") (delete-file (string-append (getenv "XDG_CACHE_HOME")
"/guix/substitute-binary/" "/guix/substitute-binary/"
(store-path-hash-part o)))) (store-path-hash-part o))))
;; Make sure `substitute-binary' correctly communicates the above data. ;; Make sure `substitute-binary' correctly communicates the above data.
(set-build-options s #:use-substitutes? #t) (set-build-options s #:use-substitutes? #t)
(and (has-substitutes? s o) (and (has-substitutes? s o)
(equal? (list o) (substitutable-paths s (list o))) (equal? (list o) (substitutable-paths s (list o)))
(match (pk 'spi (substitutable-path-info s (list o))) (match (pk 'spi (substitutable-path-info s (list o)))
(((? substitutable? s)) (((? substitutable? s))
(and (string=? (substitutable-deriver s) (derivation-file-name d)) (and (string=? (substitutable-deriver s) (derivation-file-name d))
(null? (substitutable-references s)) (null? (substitutable-references s))
(equal? (substitutable-nar-size s) 1234))))))) (equal? (substitutable-nar-size s) 1234))))))))
(test-assert "substitute" (test-assert "substitute"
(let* ((s (open-connection)) (with-store s
(c (random-text)) ; contents of the output (let* ((c (random-text)) ; contents of the output
(d (build-expression->derivation (d (build-expression->derivation
s "substitute-me" s "substitute-me"
`(call-with-output-file %output `(call-with-output-file %output
(lambda (p) (lambda (p)
(exit 1) ; would actually fail (exit 1) ; would actually fail
(display ,c p))) (display ,c p)))
#:guile-for-build #:guile-for-build
(package-derivation s %bootstrap-guile (%current-system)))) (package-derivation s %bootstrap-guile (%current-system))))
(o (derivation->output-path d)) (o (derivation->output-path d))
(dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
(compose uri-path string->uri)))) (compose uri-path string->uri))))
;; Create fake substituter data, to be read by `substitute-binary'. ;; Create fake substituter data, to be read by `substitute-binary'.
(call-with-output-file (string-append dir "/nix-cache-info") (call-with-output-file (string-append dir "/nix-cache-info")
(lambda (p) (lambda (p)
(format p "StoreDir: ~a\nWantMassQuery: 0\n" (format p "StoreDir: ~a\nWantMassQuery: 0\n"
(%store-prefix)))) (%store-prefix))))
(call-with-output-file (string-append dir "/example.out") (call-with-output-file (string-append dir "/example.out")
(lambda (p) (lambda (p)
(display c p))) (display c p)))
(call-with-output-file (string-append dir "/example.nar") (call-with-output-file (string-append dir "/example.nar")
(lambda (p) (lambda (p)
(write-file (string-append dir "/example.out") p))) (write-file (string-append dir "/example.out") p)))
(call-with-output-file (string-append dir "/" (store-path-hash-part o) (call-with-output-file (string-append dir "/" (store-path-hash-part o)
".narinfo") ".narinfo")
(lambda (p) (lambda (p)
(format p "StorePath: ~a (format p "StorePath: ~a
URL: ~a URL: ~a
Compression: none Compression: none
NarSize: 1234 NarSize: 1234
@ -387,50 +387,50 @@ (define (same? x y)
References: References:
System: ~a System: ~a
Deriver: ~a~%" Deriver: ~a~%"
o ; StorePath o ; StorePath
"example.nar" ; relative URL "example.nar" ; relative URL
(call-with-input-file (string-append dir "/example.nar") (call-with-input-file (string-append dir "/example.nar")
(compose bytevector->nix-base32-string sha256 (compose bytevector->nix-base32-string sha256
get-bytevector-all)) get-bytevector-all))
(%current-system) ; System (%current-system) ; System
(basename (basename
(derivation-file-name d))))) ; Deriver (derivation-file-name d))))) ; Deriver
;; Make sure we use `substitute-binary'. ;; Make sure we use `substitute-binary'.
(set-build-options s #:use-substitutes? #t) (set-build-options s #:use-substitutes? #t)
(and (has-substitutes? s o) (and (has-substitutes? s o)
(build-derivations s (list d)) (build-derivations s (list d))
(equal? c (call-with-input-file o get-string-all))))) (equal? c (call-with-input-file o get-string-all))))))
(test-assert "substitute, corrupt output hash" (test-assert "substitute, corrupt output hash"
;; Tweak the substituter into installing a substitute whose hash doesn't ;; Tweak the substituter into installing a substitute whose hash doesn't
;; match the one announced in the narinfo. The daemon must notice this and ;; match the one announced in the narinfo. The daemon must notice this and
;; raise an error. ;; raise an error.
(let* ((s (open-connection)) (with-store s
(c "hello, world") ; contents of the output (let* ((c "hello, world") ; contents of the output
(d (build-expression->derivation (d (build-expression->derivation
s "corrupt-substitute" s "corrupt-substitute"
`(mkdir %output) `(mkdir %output)
#:guile-for-build #:guile-for-build
(package-derivation s %bootstrap-guile (%current-system)))) (package-derivation s %bootstrap-guile (%current-system))))
(o (derivation->output-path d)) (o (derivation->output-path d))
(dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
(compose uri-path string->uri)))) (compose uri-path string->uri))))
;; Create fake substituter data, to be read by `substitute-binary'. ;; Create fake substituter data, to be read by `substitute-binary'.
(call-with-output-file (string-append dir "/nix-cache-info") (call-with-output-file (string-append dir "/nix-cache-info")
(lambda (p) (lambda (p)
(format p "StoreDir: ~a\nWantMassQuery: 0\n" (format p "StoreDir: ~a\nWantMassQuery: 0\n"
(%store-prefix)))) (%store-prefix))))
(call-with-output-file (string-append dir "/example.out") (call-with-output-file (string-append dir "/example.out")
(lambda (p) (lambda (p)
(display "The contents here do not match C." p))) (display "The contents here do not match C." p)))
(call-with-output-file (string-append dir "/example.nar") (call-with-output-file (string-append dir "/example.nar")
(lambda (p) (lambda (p)
(write-file (string-append dir "/example.out") p))) (write-file (string-append dir "/example.out") p)))
(call-with-output-file (string-append dir "/" (store-path-hash-part o) (call-with-output-file (string-append dir "/" (store-path-hash-part o)
".narinfo") ".narinfo")
(lambda (p) (lambda (p)
(format p "StorePath: ~a (format p "StorePath: ~a
URL: ~a URL: ~a
Compression: none Compression: none
NarSize: 1234 NarSize: 1234
@ -438,50 +438,50 @@ (define (same? x y)
References: References:
System: ~a System: ~a
Deriver: ~a~%" Deriver: ~a~%"
o ; StorePath o ; StorePath
"example.nar" ; relative URL "example.nar" ; relative URL
(bytevector->nix-base32-string (bytevector->nix-base32-string
(sha256 (string->utf8 c))) (sha256 (string->utf8 c)))
(%current-system) ; System (%current-system) ; System
(basename (basename
(derivation-file-name d))))) ; Deriver (derivation-file-name d))))) ; Deriver
;; Make sure we use `substitute-binary'. ;; Make sure we use `substitute-binary'.
(set-build-options s (set-build-options s
#:use-substitutes? #t #:use-substitutes? #t
#:fallback? #f) #:fallback? #f)
(and (has-substitutes? s o) (and (has-substitutes? s o)
(guard (c ((nix-protocol-error? c) (guard (c ((nix-protocol-error? c)
;; XXX: the daemon writes "hash mismatch in downloaded ;; XXX: the daemon writes "hash mismatch in downloaded
;; path", but the actual error returned to the client ;; path", but the actual error returned to the client
;; doesn't mention that. ;; doesn't mention that.
(pk 'corrupt c) (pk 'corrupt c)
(not (zero? (nix-protocol-error-status c))))) (not (zero? (nix-protocol-error-status c)))))
(build-derivations s (list d)) (build-derivations s (list d))
#f)))) #f)))))
(test-assert "substitute --fallback" (test-assert "substitute --fallback"
(let* ((s (open-connection)) (with-store s
(t (random-text)) ; contents of the output (let* ((t (random-text)) ; contents of the output
(d (build-expression->derivation (d (build-expression->derivation
s "substitute-me-not" s "substitute-me-not"
`(call-with-output-file %output `(call-with-output-file %output
(lambda (p) (lambda (p)
(display ,t p))) (display ,t p)))
#:guile-for-build #:guile-for-build
(package-derivation s %bootstrap-guile (%current-system)))) (package-derivation s %bootstrap-guile (%current-system))))
(o (derivation->output-path d)) (o (derivation->output-path d))
(dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL") (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
(compose uri-path string->uri)))) (compose uri-path string->uri))))
;; Create fake substituter data, to be read by `substitute-binary'. ;; Create fake substituter data, to be read by `substitute-binary'.
(call-with-output-file (string-append dir "/nix-cache-info") (call-with-output-file (string-append dir "/nix-cache-info")
(lambda (p) (lambda (p)
(format p "StoreDir: ~a\nWantMassQuery: 0\n" (format p "StoreDir: ~a\nWantMassQuery: 0\n"
(%store-prefix)))) (%store-prefix))))
(call-with-output-file (string-append dir "/" (store-path-hash-part o) (call-with-output-file (string-append dir "/" (store-path-hash-part o)
".narinfo") ".narinfo")
(lambda (p) (lambda (p)
(format p "StorePath: ~a (format p "StorePath: ~a
URL: ~a URL: ~a
Compression: none Compression: none
NarSize: 1234 NarSize: 1234
@ -489,26 +489,26 @@ (define (same? x y)
References: References:
System: ~a System: ~a
Deriver: ~a~%" Deriver: ~a~%"
o ; StorePath o ; StorePath
"does-not-exist.nar" ; relative URL "does-not-exist.nar" ; relative URL
(%current-system) ; System (%current-system) ; System
(basename (basename
(derivation-file-name d))))) ; Deriver (derivation-file-name d))))) ; Deriver
;; Make sure we use `substitute-binary'. ;; Make sure we use `substitute-binary'.
(set-build-options s #:use-substitutes? #t) (set-build-options s #:use-substitutes? #t)
(and (has-substitutes? s o) (and (has-substitutes? s o)
(guard (c ((nix-protocol-error? c) (guard (c ((nix-protocol-error? c)
;; The substituter failed as expected. Now make sure that ;; The substituter failed as expected. Now make sure that
;; #:fallback? #t works correctly. ;; #:fallback? #t works correctly.
(set-build-options s (set-build-options s
#:use-substitutes? #t #:use-substitutes? #t
#:fallback? #t) #:fallback? #t)
(and (build-derivations s (list d)) (and (build-derivations s (list d))
(equal? t (call-with-input-file o get-string-all))))) (equal? t (call-with-input-file o get-string-all)))))
;; Should fail. ;; Should fail.
(build-derivations s (list d)) (build-derivations s (list d))
#f)))) #f)))))
(test-assert "export/import several paths" (test-assert "export/import several paths"
(let* ((texts (unfold (cut >= <> 10) (let* ((texts (unfold (cut >= <> 10)