rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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 2015-02-02 10:37:23 +01:00
parent 2d53df66de
commit 6eebbab562
4 changed files with 102 additions and 168 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.dir-locals.el
View File

@ -42,6 +42,8 @@
(eval . (put 'emacs-batch-edit-file 'scheme-indent-function 1)) (eval . (put 'emacs-batch-edit-file 'scheme-indent-function 1))
(eval . (put 'emacs-substitute-sexps 'scheme-indent-function 1)) (eval . (put 'emacs-substitute-sexps 'scheme-indent-function 1))
(eval . (put 'emacs-substitute-variables '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 'syntax-parameterize 'scheme-indent-function 1))
(eval . (put 'with-monad 'scheme-indent-function 1)) (eval . (put 'with-monad 'scheme-indent-function 1))

35
guix/tests.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -20,6 +20,7 @@
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix base32)
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
@ -86,25 +87,31 @@ given by REPLACEMENT."
;;; Narinfo files, as used by the substituter. ;;; 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 "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 (format #f "StorePath: ~a
URL: ~a URL: ~a
Compression: none Compression: none
NarSize: 1234 NarSize: 1234
NarHash: sha256:~a
References: References:
System: ~a System: ~a
Deriver: ~a~%" Deriver: ~a~%"
(derivation->output-path drv) ; StorePath (derivation->output-path drv) ; StorePath
nar ; URL nar ; URL
(bytevector->nix-base32-string sha256) ; NarHash
(derivation-system drv) ; System (derivation-system drv) ; System
(basename (basename
(derivation-file-name drv)))) ; Deriver (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 "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)) (let* ((output (derivation->output-path drv))
(dir (uri-path (dir (uri-path
(string->uri (getenv "GUIX_BINARY_SUBSTITUTE_URL")))) (string->uri (getenv "GUIX_BINARY_SUBSTITUTE_URL"))))
@ -119,18 +126,24 @@ substitute-binary', has been installed for DRV."
(%store-prefix)))) (%store-prefix))))
(call-with-output-file narinfo (call-with-output-file narinfo
(lambda (p) (lambda (p)
(display (derivation-narinfo drv) p)))) (display (derivation-narinfo drv #:sha256 sha256) p))))
thunk thunk
(lambda () (lambda ()
(delete-file narinfo) (delete-file narinfo)
(delete-file info))))) (delete-file info)))))
(define-syntax-rule (with-derivation-narinfo drv body ...) (define-syntax with-derivation-narinfo
"Evaluate BODY in a context where DRV looks substitutable from the (syntax-rules (sha256 =>)
"Evaluate BODY in a context where DRV looks substitutable from the
substituter's viewpoint." substituter's viewpoint."
(call-with-derivation-narinfo drv ((_ drv (sha256 => hash) body ...)
(lambda () (call-with-derivation-narinfo drv
body ...))) (lambda () body ...)
#:sha256 hash))
((_ drv body ...)
(call-with-derivation-narinfo drv
(lambda ()
body ...)))))
(define-syntax-rule (dummy-package name* extra-fields ...) (define-syntax-rule (dummy-package name* extra-fields ...)
"Return a \"dummy\" package called NAME*, with all its compulsory fields "Return a \"dummy\" package called NAME*, with all its compulsory fields

4
tests/derivations.scm
View File

@ -916,7 +916,3 @@
(exit (= (test-runner-fail-count (test-runner-current)) 0)) (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
View File

@ -310,46 +310,27 @@
(test-assert "substitute query" (test-assert "substitute query"
(with-store s (with-store s
(let* ((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")
(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") (with-derivation-narinfo d
(lambda (p) ;; Remove entry from the local cache.
(format p "StoreDir: ~a\nWantMassQuery: 0\n" (false-if-exception
(%store-prefix)))) (delete-file (string-append (getenv "XDG_CACHE_HOME")
(call-with-output-file (string-append dir "/" (store-path-hash-part o) "/guix/substitute-binary/"
".narinfo") (store-path-hash-part o))))
(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
;; Remove entry from the local cache. ;; Make sure `substitute-binary' correctly communicates the above
(false-if-exception ;; data.
(delete-file (string-append (getenv "XDG_CACHE_HOME") (set-build-options s #:use-substitutes? #t)
"/guix/substitute-binary/" (and (has-substitutes? s o)
(store-path-hash-part o)))) (equal? (list o) (substitutable-paths s (list o)))
(match (pk 'spi (substitutable-path-info s (list o)))
;; Make sure `substitute-binary' correctly communicates the above data. (((? substitutable? s))
(set-build-options s #:use-substitutes? #t) (and (string=? (substitutable-deriver s)
(and (has-substitutes? s o) (derivation-file-name d))
(equal? (list o) (substitutable-paths s (list o))) (null? (substitutable-references s))
(match (pk 'spi (substitutable-path-info s (list o))) (equal? (substitutable-nar-size s) 1234)))))))))
(((? substitutable? s))
(and (string=? (substitutable-deriver s) (derivation-file-name d))
(null? (substitutable-references s))
(equal? (substitutable-nar-size s) 1234))))))))
(test-assert "substitute" (test-assert "substitute"
(with-store s (with-store s
@ -365,42 +346,24 @@ Deriver: ~a~%"
(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'. (call-with-output-file (string-append dir "/example.out")
(call-with-output-file (string-append dir "/nix-cache-info") (lambda (p)
(lambda (p) (display c p)))
(format p "StoreDir: ~a\nWantMassQuery: 0\n" (call-with-output-file (string-append dir "/example.nar")
(%store-prefix)))) (lambda (p)
(call-with-output-file (string-append dir "/example.out") (write-file (string-append dir "/example.out") p)))
(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
;; Make sure we use `substitute-binary'. (let ((h (call-with-input-file (string-append dir "/example.nar")
(set-build-options s #:use-substitutes? #t) port-sha256)))
(and (has-substitutes? s o) ;; Create fake substituter data, to be read by `substitute-binary'.
(build-derivations s (list d)) (with-derivation-narinfo d
(equal? c (call-with-input-file o get-string-all)))))) (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" (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
@ -417,52 +380,33 @@ Deriver: ~a~%"
(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") (with-derivation-narinfo d
(lambda (p) (sha256 => (sha256 (string->utf8 c)))
(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
;; Make sure we use `substitute-binary'. (call-with-output-file (string-append dir "/example.out")
(set-build-options s (lambda (p)
#:use-substitutes? #t (display "The contents here do not match C." p)))
#:fallback? #f) (call-with-output-file (string-append dir "/example.nar")
(and (has-substitutes? s o) (lambda (p)
(guard (c ((nix-protocol-error? c) (write-file (string-append dir "/example.out") p)))
;; XXX: the daemon writes "hash mismatch in downloaded
;; path", but the actual error returned to the client ;; Make sure we use `substitute-binary'.
;; doesn't mention that. (set-build-options s
(pk 'corrupt c) #:use-substitutes? #t
(not (zero? (nix-protocol-error-status c))))) #:fallback? #f)
(build-derivations s (list d)) (and (has-substitutes? s o)
#f))))) (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" (test-assert "substitute --fallback"
(with-store s (with-store s
(let* ((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
@ -470,45 +414,24 @@ Deriver: ~a~%"
(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")
(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") (with-derivation-narinfo d
(lambda (p) ;; Make sure we use `substitute-binary'.
(format p "StoreDir: ~a\nWantMassQuery: 0\n" (set-build-options s #:use-substitutes? #t)
(%store-prefix)))) (and (has-substitutes? s o)
(call-with-output-file (string-append dir "/" (store-path-hash-part o) (guard (c ((nix-protocol-error? c)
".narinfo") ;; The substituter failed as expected. Now make
(lambda (p) ;; sure that #:fallback? #t works correctly.
(format p "StorePath: ~a (set-build-options s
URL: ~a #:use-substitutes? #t
Compression: none #:fallback? #t)
NarSize: 1234 (and (build-derivations s (list d))
NarHash: sha256:0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73 (equal? t (call-with-input-file o
References: get-string-all)))))
System: ~a ;; Should fail.
Deriver: ~a~%" (build-derivations s (list d))
o ; StorePath #f))))))
"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)))))
(test-assert "export/import several paths" (test-assert "export/import several paths"
(let* ((texts (unfold (cut >= <> 10) (let* ((texts (unfold (cut >= <> 10)