tests: Narinfos can specify an non-empty reference list.

* guix/tests.scm (derivation-narinfo): Add #:references and honor it.
(call-with-derivation-narinfo, call-with-derivation-substitute):
Likewise.
(with-derivation-narinfo, with-derivation-substitute): Add 'references'
keyword.
This commit is contained in:
Ludovic Courtès 2016-03-04 17:57:49 +01:00
parent c8f9f24776
commit 7bfeb9df20

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -132,21 +132,23 @@ (define-syntax-rule (mock (module proc replacement) body ...)
;;; ;;;
(define* (derivation-narinfo drv #:key (nar "example.nar") (define* (derivation-narinfo drv #:key (nar "example.nar")
(sha256 (make-bytevector 32 0))) (sha256 (make-bytevector 32 0))
"Return the contents of the narinfo corresponding to DRV; NAR should be the (references '()))
file name of the archive containing the substitute for DRV, and SHA256 is the "Return the contents of the narinfo corresponding to DRV, with the specified
expected hash." REFERENCES (a list of store items); NAR should be the 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 NarHash: sha256:~a
References: References: ~a
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 (bytevector->nix-base32-string sha256) ; NarHash
(string-join (map basename references)) ; References
(derivation-system drv) ; System (derivation-system drv) ; System
(basename (basename
(derivation-file-name drv)))) ; Deriver (derivation-file-name drv)))) ; Deriver
@ -157,7 +159,9 @@ (define %substitute-directory
(compose uri-path string->uri)))) (compose uri-path string->uri))))
(define* (call-with-derivation-narinfo drv thunk (define* (call-with-derivation-narinfo drv thunk
#:key (sha256 (make-bytevector 32 0))) #:key
(sha256 (make-bytevector 32 0))
(references '()))
"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', has been installed for DRV. SHA256 is the hash of the substitute', has been installed for DRV. SHA256 is the hash of the
expected output of DRV." expected output of DRV."
@ -174,27 +178,36 @@ (define* (call-with-derivation-narinfo drv thunk
(%store-prefix)))) (%store-prefix))))
(call-with-output-file narinfo (call-with-output-file narinfo
(lambda (p) (lambda (p)
(display (derivation-narinfo drv #:sha256 sha256) p)))) (display (derivation-narinfo drv #:sha256 sha256
#:references references)
p))))
thunk thunk
(lambda () (lambda ()
(delete-file narinfo) (delete-file narinfo)
(delete-file info))))) (delete-file info)))))
(define-syntax with-derivation-narinfo (define-syntax with-derivation-narinfo
(syntax-rules (sha256 =>) (syntax-rules (sha256 references =>)
"Evaluate BODY in a context where DRV looks substitutable from the "Evaluate BODY in a context where DRV looks substitutable from the
substituter's viewpoint." substituter's viewpoint."
((_ drv (sha256 => hash) body ...) ((_ drv (sha256 => hash) (references => refs) body ...)
(call-with-derivation-narinfo drv (call-with-derivation-narinfo drv
(lambda () body ...) (lambda () body ...)
#:sha256 hash)) #:sha256 hash
#:references refs))
((_ drv (sha256 => hash) body ...)
(with-derivation-narinfo drv
(sha256 => hash) (references => '())
body ...))
((_ drv body ...) ((_ drv body ...)
(call-with-derivation-narinfo drv (call-with-derivation-narinfo drv
(lambda () (lambda ()
body ...))))) body ...)))))
(define* (call-with-derivation-substitute drv contents thunk (define* (call-with-derivation-substitute drv contents thunk
#:key sha256) #:key
sha256
(references '()))
"Call THUNK in a context where a substitute for DRV has been installed, "Call THUNK in a context where a substitute for DRV has been installed,
using CONTENTS, a string, as its contents. If SHA256 is true, use it as the using CONTENTS, a string, as its contents. If SHA256 is true, use it as the
expected hash of the substitute; otherwise use the hash of the nar containing expected hash of the substitute; otherwise use the hash of the nar containing
@ -214,7 +227,8 @@ (define dir (%substitute-directory))
;; Create fake substituter data, to be read by 'guix substitute'. ;; Create fake substituter data, to be read by 'guix substitute'.
(call-with-derivation-narinfo drv (call-with-derivation-narinfo drv
thunk thunk
#:sha256 (or sha256 hash)))) #:sha256 (or sha256 hash)
#:references references)))
(lambda () (lambda ()
(delete-file (string-append dir "/example.out")) (delete-file (string-append dir "/example.out"))
(delete-file (string-append dir "/example.nar"))))) (delete-file (string-append dir "/example.nar")))))
@ -231,13 +245,18 @@ (define shebang
(> (string-length shebang) 128)) (> (string-length shebang) 128))
(define-syntax with-derivation-substitute (define-syntax with-derivation-substitute
(syntax-rules (sha256 =>) (syntax-rules (sha256 references =>)
"Evaluate BODY in a context where DRV is substitutable with the given "Evaluate BODY in a context where DRV is substitutable with the given
CONTENTS." CONTENTS."
((_ drv contents (sha256 => hash) body ...) ((_ drv contents (sha256 => hash) (references => refs) body ...)
(call-with-derivation-substitute drv contents (call-with-derivation-substitute drv contents
(lambda () body ...) (lambda () body ...)
#:sha256 hash)) #:sha256 hash
#:references refs))
((_ drv contents (sha256 => hash) body ...)
(with-derivation-substitute drv contents
(sha256 => hash) (references => '())
body ...))
((_ drv contents body ...) ((_ drv contents body ...)
(call-with-derivation-substitute drv contents (call-with-derivation-substitute drv contents
(lambda () (lambda ()