ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-25 20:19:18 -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

30
tests/store.scm
View file

@ -296,21 +296,21 @@ (define (same? x y)
(log-file %store o)))))
(test-assert "no substitutes"
(let* ((s (open-connection))
(d1 (package-derivation s %bootstrap-guile (%current-system)))
(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)))))
(null? (substitutable-path-info s o))))))
(test-skip (if (getenv "GUIX_BINARY_SUBSTITUTE_URL") 0 1))
(test-assert "substitute query"
(let* ((s (open-connection))
(d (package-derivation s %bootstrap-guile (%current-system)))
(with-store s
(let* ((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))))
@ -349,11 +349,11 @@ (define (same? x y)
(((? substitutable? s))
(and (string=? (substitutable-deriver s) (derivation-file-name d))
(null? (substitutable-references s))
(equal? (substitutable-nar-size s) 1234)))))))
(equal? (substitutable-nar-size s) 1234))))))))
(test-assert "substitute"
(let* ((s (open-connection))
(c (random-text)) ; contents of the output
(with-store s
(let* ((c (random-text)) ; contents of the output
(d (build-expression->derivation
s "substitute-me"
`(call-with-output-file %output
@ -400,14 +400,14 @@ (define (same? x y)
(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)))))
(equal? c (call-with-input-file o get-string-all))))))
(test-assert "substitute, corrupt output hash"
;; Tweak the substituter into installing a substitute whose hash doesn't
;; match the one announced in the narinfo. The daemon must notice this and
;; raise an error.
(let* ((s (open-connection))
(c "hello, world") ; contents of the output
(with-store s
(let* ((c "hello, world") ; contents of the output
(d (build-expression->derivation
s "corrupt-substitute"
`(mkdir %output)
@ -458,11 +458,11 @@ (define (same? x y)
(pk 'corrupt c)
(not (zero? (nix-protocol-error-status c)))))
(build-derivations s (list d))
#f))))
#f)))))
(test-assert "substitute --fallback"
(let* ((s (open-connection))
(t (random-text)) ; contents of the output
(with-store s
(let* ((t (random-text)) ; contents of the output
(d (build-expression->derivation
s "substitute-me-not"
`(call-with-output-file %output
@ -508,7 +508,7 @@ (define (same? x y)
(equal? t (call-with-input-file o get-string-all)))))
;; Should fail.
(build-derivations s (list d))
#f))))
#f)))))
(test-assert "export/import several paths"
(let* ((texts (unfold (cut >= <> 10)