diff options
Diffstat (limited to 'guix/tests.scm')
| -rw-r--r-- | guix/tests.scm | 69 |
1 files changed, 56 insertions, 13 deletions
diff --git a/guix/tests.scm b/guix/tests.scm index e1c194340c..4cd1ad6cf9 100644 --- a/guix/tests.scm +++ b/guix/tests.scm @@ -20,12 +20,13 @@ #:use-module ((guix config) #:select (%storedir %localstatedir)) #:use-module (guix store) #:use-module (guix derivations) + #:use-module (guix gexp) #:use-module (guix packages) #:use-module (guix base32) #:use-module (guix serialization) #:use-module (guix monads) #:use-module ((guix utils) #:select (substitute-keyword-arguments)) - #:use-module ((guix build utils) #:select (mkdir-p)) + #:use-module ((guix build utils) #:select (mkdir-p compressor)) #:use-module ((gcrypt hash) #:hide (sha256)) #:use-module (guix build-system gnu) #:use-module (gnu packages base) @@ -60,7 +61,9 @@ dummy-package dummy-origin - gnu-make-for-tests)) + gnu-make-for-tests + + test-file)) ;;; Commentary: ;;; @@ -135,17 +138,21 @@ no external store to talk to." (open-connection)) (const #f))) - (dynamic-wind - (const #t) - (lambda () - ;; Since we're using a different store we must clear the - ;; package-derivation cache. - (hash-clear! (@@ (guix packages) %derivation-cache)) - - (proc store)) - (lambda () - (when store - (close-connection store)))))) + (let ((store-variable (getenv "NIX_STORE_DIR"))) + (dynamic-wind + (lambda () + ;; This environment variable is set by 'pre-inst-env' but it + ;; influences '%store-directory' in (guix build utils), which is + ;; itself used in (guix packages). Thus, unset it before going any + ;; further. + (unsetenv "NIX_STORE_DIR")) + (lambda () + (proc store)) + (lambda () + (when store-variable + (setenv "NIX_STORE_DIR" store-variable)) + (when store + (close-connection store))))))) (define-syntax-rule (with-external-store store exp ...) "Evaluate EXP with STORE bound to the external store rather than the @@ -439,6 +446,42 @@ default values, and with EXTRA-FIELDS set as specified." (native-inputs '()) ;no need for 'pkg-config' (inputs %bootstrap-inputs-for-tests)))) + +;;; +;;; Test utility procedures. + +(define (test-file store name content) + "Create a simple file in STORE with CONTENT (a string), compressed according +to its file name extension. Return both its file name and its hash." + (let* ((ext (string-index-right name #\.)) + (name-sans-ext (if ext + (string-take name (string-index-right name #\.)) + name)) + (comp (compressor name)) + (command #~(if #+comp + (string-append #+%bootstrap-coreutils&co + "/bin/" #+comp) + #f)) + (f (with-imported-modules '((guix build utils)) + (computed-file name + #~(begin + (use-modules (guix build utils) + (rnrs io simple)) + (with-output-to-file #+name-sans-ext + (lambda _ + (format #t #+content))) + (when #+command + (invoke #+command #+name-sans-ext)) + (copy-file #+name #$output))))) + (file-drv (run-with-store store (lower-object f))) + (file (derivation->output-path file-drv)) + (file-drv-outputs (derivation-outputs file-drv)) + (_ (build-derivations store (list file-drv))) + (file-hash (derivation-output-hash + (assoc-ref file-drv-outputs "out")))) + (values file file-hash))) + +;;; ;; Local Variables: ;; eval: (put 'call-with-derivation-narinfo 'scheme-indent-function 1) ;; eval: (put 'call-with-derivation-substitute 'scheme-indent-function 2) |