Browse Source

tests: Move some of the narinfo test tools to (guix tests).

* guix/tests.scm (derivation-narinfo, call-with-derivation-narinfo): New
  procedures.
  (with-derivation-narinfo): New macro.
* tests/derivations.scm ("derivation-prerequisites-to-build and
  substitutes"): Use them.
version-0.8.3
Ludovic Courtès 7 years ago
parent
commit
e6740741d1
  1. 59
      guix/tests.scm
  2. 48
      tests/derivations.scm

59
guix/tests.scm

@ -23,9 +23,11 @@
#:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-34)
#:use-module (rnrs bytevectors)
#:use-module (web uri)
#:export (open-connection-for-tests
random-text
random-bytevector))
random-bytevector
with-derivation-narinfo))
;;; Commentary:
;;;
@ -67,4 +69,59 @@
(loop (1+ i)))
bv))))
;;;
;;; Narinfo files, as used by the substituter.
;;;
(define* (derivation-narinfo drv #:optional (nar "example.nar"))
"Return the contents of the narinfo corresponding to DRV; NAR should be the
file name of the archive containing the substitute for DRV."
(format #f "StorePath: ~a
URL: ~a
Compression: none
NarSize: 1234
References:
System: ~a
Deriver: ~a~%"
(derivation->output-path drv) ; StorePath
nar ; URL
(derivation-system drv) ; System
(basename
(derivation-file-name drv)))) ; Deriver
(define (call-with-derivation-narinfo drv thunk)
"Call THUNK in a context where fake substituter data, as read by 'guix
substitute-binary', has been installed for DRV."
(let* ((output (derivation->output-path drv))
(dir (uri-path
(string->uri (getenv "GUIX_BINARY_SUBSTITUTE_URL"))))
(info (string-append dir "/nix-cache-info"))
(narinfo (string-append dir "/" (store-path-hash-part output)
".narinfo")))
(dynamic-wind
(lambda ()
(call-with-output-file info
(lambda (p)
(format p "StoreDir: ~a\nWantMassQuery: 0\n"
(%store-prefix))))
(call-with-output-file narinfo
(lambda (p)
(display (derivation-narinfo drv) 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
substituter's viewpoint."
(call-with-derivation-narinfo drv
(lambda ()
body ...)))
;; Local Variables:
;; eval: (put 'call-with-derivation-narinfo 'scheme-indent-function 1)
;; End:
;;; tests.scm ends here

48
tests/derivations.scm

@ -567,43 +567,21 @@
(let* ((store (open-connection))
(drv (build-expression->derivation store "prereq-subst"
(random 1000)))
(output (derivation->output-path drv))
(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 "/" (store-path-hash-part output)
".narinfo")
(lambda (p)
(format p "StorePath: ~a
URL: ~a
Compression: none
NarSize: 1234
References:
System: ~a
Deriver: ~a~%"
output ; StorePath
(string-append dir "/example.nar") ; URL
(%current-system) ; System
(basename
(derivation-file-name drv))))) ; Deriver
(output (derivation->output-path drv)))
;; Make sure substitutes are usable.
(set-build-options store #:use-substitutes? #t)
(let-values (((build download)
(derivation-prerequisites-to-build store drv))
((build* download*)
(derivation-prerequisites-to-build store drv
#:use-substitutes? #f)))
(pk build download build* download*)
(and (null? build)
(equal? download (list output))
(null? download*)
(null? build*)))))
(with-derivation-narinfo drv
(let-values (((build download)
(derivation-prerequisites-to-build store drv))
((build* download*)
(derivation-prerequisites-to-build store drv
#:use-substitutes? #f)))
(and (null? build)
(equal? download (list output))
(null? download*)
(null? build*))))))
(test-assert "build-expression->derivation with expression returning #f"
(let* ((builder '(begin
@ -901,3 +879,7 @@ Deriver: ~a~%"
(exit (= (test-runner-fail-count (test-runner-current)) 0))
;; Local Variables:
;; eval: (put 'with-derivation-narinfo 'scheme-indent-function 1)
;; End:
Loading…
Cancel
Save