Browse Source

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.
version-0.8.3
Ludovic Courtès 7 years ago
parent
commit
6eebbab562
  1. 2
      .dir-locals.el
  2. 35
      guix/tests.scm
  3. 4
      tests/derivations.scm
  4. 235
      tests/store.scm

2
.dir-locals.el

@ -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))

35
guix/tests.scm

@ -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

4
tests/derivations.scm

@ -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:

235
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
;; 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))))))))
(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))))
;; 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
;; 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))))))
(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)))
(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
;; 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)))))
(with-derivation-narinfo d
(sha256 => (sha256 (string->utf8 c)))
(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…
Cancel
Save