aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-10-29 00:09:38 +0100
committerLudovic Courtès <ludo@gnu.org>2014-10-29 00:31:23 +0100
commite6740741d188e01cb1a0b9c7db597a25128889d5 (patch)
tree5d9eae3c86e24a788204da4814dd06a40056507c
parenta96a82d79ead164e19a78f572254cf7f6f54d17c (diff)
downloadguix-e6740741d188e01cb1a0b9c7db597a25128889d5.tar
guix-e6740741d188e01cb1a0b9c7db597a25128889d5.tar.gz
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.
-rw-r--r--guix/tests.scm59
-rw-r--r--tests/derivations.scm48
2 files changed, 73 insertions, 34 deletions
diff --git a/guix/tests.scm b/guix/tests.scm
index 4f7b0c8171..022679902a 100644
--- a/guix/tests.scm
+++ b/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
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 698640b548..9073867793 100644
--- a/tests/derivations.scm
+++ b/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: