tests: Further factorize substitute mocks.
* guix/tests.scm (derivation-narinfo): Turn 'nar' into a keyword
parameter. Add #:sha256 parameter, and honor it.
(call-with-derivation-narinfo): Add #:sha256 and pass it to
'derivation-narinfo'.
(with-derivation-narinfo): Extend with support for (sha256 => value).
* tests/store.scm ("substitute query"): Use 'with-derivation-narinfo'.
("substitute"): Likewise.
("substitute, corrupt output hash"): Likewise.
("substitute --fallback"): Likewise.
* tests/derivations.scm: Remove Emacs local variable.
This commit is contained in:
Ludovic Courtès
parent
2d53df66de
commit
6eebbab562
|
|
@ -42,6 +42,8 @@
|
|||
(eval . (put 'emacs-batch-edit-file 'scheme-indent-function 1))
|
||||
(eval . (put 'emacs-substitute-sexps 'scheme-indent-function 1))
|
||||
(eval . (put 'emacs-substitute-variables 'scheme-indent-function 1))
|
||||
(eval . (put 'with-derivation-narinfo 'scheme-indent-function 1))
|
||||
|
||||
|
||||
(eval . (put 'syntax-parameterize 'scheme-indent-function 1))
|
||||
(eval . (put 'with-monad 'scheme-indent-function 1))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -20,6 +20,7 @@
|
|||
#:use-module (guix store)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix base32)
|
||||
#:use-module (gnu packages bootstrap)
|
||||
#:use-module (srfi srfi-34)
|
||||
#:use-module (rnrs bytevectors)
|
||||
|
|
@ -86,25 +87,31 @@ given by REPLACEMENT."
|
|||
;;; Narinfo files, as used by the substituter.
|
||||
;;;
|
||||
|
||||
(define* (derivation-narinfo drv #:optional (nar "example.nar"))
|
||||
(define* (derivation-narinfo drv #:key (nar "example.nar")
|
||||
(sha256 (make-bytevector 32 0)))
|
||||
"Return the contents of the narinfo corresponding to DRV; NAR should be the
|
||||
file name of the archive containing the substitute for DRV."
|
||||
file name of the archive containing the substitute for DRV, and SHA256 is the
|
||||
expected hash."
|
||||
(format #f "StorePath: ~a
|
||||
URL: ~a
|
||||
Compression: none
|
||||
NarSize: 1234
|
||||
NarHash: sha256:~a
|
||||
References:
|
||||
System: ~a
|
||||
Deriver: ~a~%"
|
||||
(derivation->output-path drv) ; StorePath
|
||||
nar ; URL
|
||||
(bytevector->nix-base32-string sha256) ; NarHash
|
||||
(derivation-system drv) ; System
|
||||
(basename
|
||||
(derivation-file-name drv)))) ; Deriver
|
||||
|
||||
(define (call-with-derivation-narinfo drv thunk)
|
||||
(define* (call-with-derivation-narinfo drv thunk
|
||||
#:key (sha256 (make-bytevector 32 0)))
|
||||
"Call THUNK in a context where fake substituter data, as read by 'guix
|
||||
substitute-binary', has been installed for DRV."
|
||||
substitute-binary', has been installed for DRV. SHA256 is the hash of the
|
||||
expected output of DRV."
|
||||
(let* ((output (derivation->output-path drv))
|
||||
(dir (uri-path
|
||||
(string->uri (getenv "GUIX_BINARY_SUBSTITUTE_URL"))))
|
||||
|
|
@ -119,18 +126,24 @@ substitute-binary', has been installed for DRV."
|
|||
(%store-prefix))))
|
||||
(call-with-output-file narinfo
|
||||
(lambda (p)
|
||||
(display (derivation-narinfo drv) p))))
|
||||
(display (derivation-narinfo drv #:sha256 sha256) p))))
|
||||
thunk
|
||||
(lambda ()
|
||||
(delete-file narinfo)
|
||||
(delete-file info)))))
|
||||
|
||||
(define-syntax-rule (with-derivation-narinfo drv body ...)
|
||||
"Evaluate BODY in a context where DRV looks substitutable from the
|
||||
(define-syntax with-derivation-narinfo
|
||||
(syntax-rules (sha256 =>)
|
||||
"Evaluate BODY in a context where DRV looks substitutable from the
|
||||
substituter's viewpoint."
|
||||
(call-with-derivation-narinfo drv
|
||||
(lambda ()
|
||||
body ...)))
|
||||
((_ drv (sha256 => hash) body ...)
|
||||
(call-with-derivation-narinfo drv
|
||||
(lambda () body ...)
|
||||
#:sha256 hash))
|
||||
((_ drv body ...)
|
||||
(call-with-derivation-narinfo drv
|
||||
(lambda ()
|
||||
body ...)))))
|
||||
|
||||
(define-syntax-rule (dummy-package name* extra-fields ...)
|
||||
"Return a \"dummy\" package called NAME*, with all its compulsory fields
|
||||
|
|
|
|||
|
|
@ -916,7 +916,3 @@
|
|||
|
||||
|
||||
(exit (= (test-runner-fail-count (test-runner-current)) 0))
|
||||
|
||||
;; Local Variables:
|
||||
;; eval: (put 'with-derivation-narinfo 'scheme-indent-function 1)
|
||||
;; End:
|
||||
|
|
|
|||
229
tests/store.scm
229
tests/store.scm
|
|
@ -310,46 +310,27 @@
|
|||
|
||||
(test-assert "substitute query"
|
||||
(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))))
|
||||
(let* ((d (package-derivation s %bootstrap-guile (%current-system)))
|
||||
(o (derivation->output-path d)))
|
||||
;; Create fake substituter data, to be read by `substitute-binary'.
|
||||
(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
|
||||
URL: ~a
|
||||
Compression: none
|
||||
NarSize: 1234
|
||||
References:
|
||||
System: ~a
|
||||
Deriver: ~a~%"
|
||||
o ; StorePath
|
||||
(string-append dir "/example.nar") ; URL
|
||||
(%current-system) ; System
|
||||
(basename
|
||||
(derivation-file-name d))))) ; Deriver
|
||||
(with-derivation-narinfo d
|
||||
;; Remove entry from the local cache.
|
||||
(false-if-exception
|
||||
(delete-file (string-append (getenv "XDG_CACHE_HOME")
|
||||
"/guix/substitute-binary/"
|
||||
(store-path-hash-part o))))
|
||||
|
||||
;; Remove entry from the local cache.
|
||||
(false-if-exception
|
||||
(delete-file (string-append (getenv "XDG_CACHE_HOME")
|
||||
"/guix/substitute-binary/"
|
||||
(store-path-hash-part o))))
|
||||
|
||||
;; Make sure `substitute-binary' correctly communicates the above data.
|
||||
(set-build-options s #:use-substitutes? #t)
|
||||
(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))))))))
|
||||
;; Make sure `substitute-binary' correctly communicates the above
|
||||
;; data.
|
||||
(set-build-options s #:use-substitutes? #t)
|
||||
(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)))))))))
|
||||
|
||||
(test-assert "substitute"
|
||||
(with-store s
|
||||
|
|
@ -365,42 +346,24 @@ Deriver: ~a~%"
|
|||
(o (derivation->output-path d))
|
||||
(dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
|
||||
(compose uri-path string->uri))))
|
||||
;; Create fake substituter data, to be read by `substitute-binary'.
|
||||
(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
|
||||
URL: ~a
|
||||
Compression: none
|
||||
NarSize: 1234
|
||||
NarHash: sha256:~a
|
||||
References:
|
||||
System: ~a
|
||||
Deriver: ~a~%"
|
||||
o ; StorePath
|
||||
"example.nar" ; relative URL
|
||||
(call-with-input-file (string-append dir "/example.nar")
|
||||
(compose bytevector->nix-base32-string sha256
|
||||
get-bytevector-all))
|
||||
(%current-system) ; System
|
||||
(basename
|
||||
(derivation-file-name d))))) ; Deriver
|
||||
(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)))
|
||||
|
||||
;; Make sure we use `substitute-binary'.
|
||||
(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))))))
|
||||
(let ((h (call-with-input-file (string-append dir "/example.nar")
|
||||
port-sha256)))
|
||||
;; Create fake substituter data, to be read by `substitute-binary'.
|
||||
(with-derivation-narinfo d
|
||||
(sha256 => h)
|
||||
|
||||
;; Make sure we use `substitute-binary'.
|
||||
(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-assert "substitute, corrupt output hash"
|
||||
;; Tweak the substituter into installing a substitute whose hash doesn't
|
||||
|
|
@ -417,52 +380,33 @@ Deriver: ~a~%"
|
|||
(dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
|
||||
(compose uri-path string->uri))))
|
||||
;; Create fake substituter data, to be read by `substitute-binary'.
|
||||
(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
|
||||
URL: ~a
|
||||
Compression: none
|
||||
NarSize: 1234
|
||||
NarHash: sha256:~a
|
||||
References:
|
||||
System: ~a
|
||||
Deriver: ~a~%"
|
||||
o ; StorePath
|
||||
"example.nar" ; relative URL
|
||||
(bytevector->nix-base32-string
|
||||
(sha256 (string->utf8 c)))
|
||||
(%current-system) ; System
|
||||
(basename
|
||||
(derivation-file-name d))))) ; Deriver
|
||||
(with-derivation-narinfo d
|
||||
(sha256 => (sha256 (string->utf8 c)))
|
||||
|
||||
;; Make sure we use `substitute-binary'.
|
||||
(set-build-options s
|
||||
#:use-substitutes? #t
|
||||
#:fallback? #f)
|
||||
(and (has-substitutes? s o)
|
||||
(guard (c ((nix-protocol-error? c)
|
||||
;; XXX: the daemon writes "hash mismatch in downloaded
|
||||
;; path", but the actual error returned to the client
|
||||
;; doesn't mention that.
|
||||
(pk 'corrupt c)
|
||||
(not (zero? (nix-protocol-error-status c)))))
|
||||
(build-derivations s (list d))
|
||||
#f)))))
|
||||
(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)))
|
||||
|
||||
;; Make sure we use `substitute-binary'.
|
||||
(set-build-options s
|
||||
#:use-substitutes? #t
|
||||
#:fallback? #f)
|
||||
(and (has-substitutes? s o)
|
||||
(guard (c ((nix-protocol-error? c)
|
||||
;; XXX: the daemon writes "hash mismatch in downloaded
|
||||
;; path", but the actual error returned to the client
|
||||
;; doesn't mention that.
|
||||
(pk 'corrupt c)
|
||||
(not (zero? (nix-protocol-error-status c)))))
|
||||
(build-derivations s (list d))
|
||||
#f))))))
|
||||
|
||||
(test-assert "substitute --fallback"
|
||||
(with-store s
|
||||
(let* ((t (random-text)) ; contents of the output
|
||||
(let* ((t (random-text)) ; contents of the output
|
||||
(d (build-expression->derivation
|
||||
s "substitute-me-not"
|
||||
`(call-with-output-file %output
|
||||
|
|
@ -470,45 +414,24 @@ Deriver: ~a~%"
|
|||
(display ,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))))
|
||||
(o (derivation->output-path d)))
|
||||
;; Create fake substituter data, to be read by `substitute-binary'.
|
||||
(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
|
||||
URL: ~a
|
||||
Compression: none
|
||||
NarSize: 1234
|
||||
NarHash: sha256:0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73
|
||||
References:
|
||||
System: ~a
|
||||
Deriver: ~a~%"
|
||||
o ; StorePath
|
||||
"does-not-exist.nar" ; relative URL
|
||||
(%current-system) ; System
|
||||
(basename
|
||||
(derivation-file-name d))))) ; Deriver
|
||||
|
||||
;; Make sure we use `substitute-binary'.
|
||||
(set-build-options s #:use-substitutes? #t)
|
||||
(and (has-substitutes? s o)
|
||||
(guard (c ((nix-protocol-error? c)
|
||||
;; The substituter failed as expected. Now make sure that
|
||||
;; #:fallback? #t works correctly.
|
||||
(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)))))
|
||||
;; Should fail.
|
||||
(build-derivations s (list d))
|
||||
#f)))))
|
||||
(with-derivation-narinfo d
|
||||
;; Make sure we use `substitute-binary'.
|
||||
(set-build-options s #:use-substitutes? #t)
|
||||
(and (has-substitutes? s o)
|
||||
(guard (c ((nix-protocol-error? c)
|
||||
;; The substituter failed as expected. Now make
|
||||
;; sure that #:fallback? #t works correctly.
|
||||
(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)))))
|
||||
;; Should fail.
|
||||
(build-derivations s (list d))
|
||||
#f))))))
|
||||
|
||||
(test-assert "export/import several paths"
|
||||
(let* ((texts (unfold (cut >= <> 10)
|
||||
|
|
|
|||
Loading…
Reference in New Issue