diff options
| -rw-r--r-- | guix/tests.scm | 59 | ||||
| -rw-r--r-- | tests/derivations.scm | 48 |
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: |