;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module (guix grafts)
#:use-module (guix store)
#:use-module (guix utils)
- #:use-module (guix hash)
+ #:use-module (gcrypt hash)
#:use-module (guix base32)
#:use-module (guix tests)
#:use-module (guix tests http)
#:use-module ((guix packages) #:select (package-derivation base32))
#:use-module ((guix build utils) #:select (executable-file?))
- #:use-module ((gnu packages) #:select (search-bootstrap-binary))
#:use-module (gnu packages bootstrap)
#:use-module ((gnu packages guile) #:select (guile-1.8))
#:use-module (srfi srfi-1)
(set-build-options %store
#:use-substitutes? #f
#:keep-going? #t)
- (guard (c ((nix-protocol-error? c)
- (and (= 100 (nix-protocol-error-status c))
- (string-contains (nix-protocol-error-message c)
+ (guard (c ((store-protocol-error? c)
+ (and (= 100 (store-protocol-error-status c))
+ (string-contains (store-protocol-error-message c)
(derivation-file-name d1))
(not (valid-path? %store (derivation->output-path d1)))
(valid-path? %store (derivation->output-path d2)))))
(test-assert "unknown built-in builder"
(let ((drv (derivation %store "ohoh" "builtin:does-not-exist" '())))
- (guard (c ((nix-protocol-error? c)
- (string-contains (nix-protocol-error-message c) "failed")))
+ (guard (c ((store-protocol-error? c)
+ (string-contains (store-protocol-error-message c) "failed")))
(build-derivations %store (list drv))
#f)))
. ,(object->string (%local-url))))
#:hash-algo 'sha256
#:hash (sha256 (random-bytevector 100))))) ;wrong
- (guard (c ((nix-protocol-error? c)
- (string-contains (nix-protocol-error-message c) "failed")))
+ (guard (c ((store-protocol-error? c)
+ (string-contains (store-protocol-error-message c) "failed")))
(build-derivations %store (list drv))
#f))))
. ,(object->string (%local-url))))
#:hash-algo 'sha256
#:hash (sha256 (random-bytevector 100)))))
- (guard (c ((nix-protocol-error? c)
- (string-contains (nix-protocol-error-message (pk c)) "failed")))
+ (guard (c ((store-protocol-error? c)
+ (string-contains (store-protocol-error-message (pk c)) "failed")))
(build-derivations %store (list drv))
#f))))
(drv (derivation %store "world"
"builtin:download" '()
#:env-vars `(("url" . ,(object->string url))))))
- (guard (c ((nix-protocol-error? c)
- (string-contains (nix-protocol-error-message c) "failed")))
+ (guard (c ((store-protocol-error? c)
+ (string-contains (store-protocol-error-message c) "failed")))
(build-derivations %store (list drv))
#f)))
`("-c" ,(string-append "echo " txt "> $out"))
#:inputs `((,%bash) (,txt))
#:allowed-references '())))
- (guard (c ((nix-protocol-error? c)
+ (guard (c ((store-protocol-error? c)
;; There's no specific error message to check for.
#t))
(build-derivations %store (list drv))
`("-c" ,"echo $out > $out")
#:inputs `((,%bash))
#:allowed-references '())))
- (guard (c ((nix-protocol-error? c)
+ (guard (c ((store-protocol-error? c)
;; There's no specific error message to check for.
#t))
(build-derivations %store (list drv))
`("-c" ,(string-append "echo " txt "> $out"))
#:inputs `((,%bash) (,txt))
#:disallowed-references (list txt))))
- (guard (c ((nix-protocol-error? c)
+ (guard (c ((store-protocol-error? c)
;; There's no specific error message to check for.
#t))
(build-derivations %store (list drv))
#f)))
-;; Here we should get the value of $NIX_STATE_DIR that the daemon sees, which
-;; is a unique value for each test process; this value is the same as the one
-;; we see in the process executing this file since it is set by 'test-env'.
+;; Here we should get the value of $GUIX_STATE_DIRECTORY that the daemon sees,
+;; which is a unique value for each test process; this value is the same as
+;; the one we see in the process executing this file since it is set by
+;; 'test-env'.
(test-equal "derivation #:leaked-env-vars"
- (getenv "NIX_STATE_DIR")
- (let* ((value (getenv "NIX_STATE_DIR"))
+ (getenv "GUIX_STATE_DIRECTORY")
+ (let* ((value (getenv "GUIX_STATE_DIRECTORY"))
(drv (derivation %store "leaked-env-vars" %bash
- '("-c" "echo -n $NIX_STATE_DIR > $out")
+ '("-c" "echo -n $GUIX_STATE_DIRECTORY > $out")
#:hash (sha256 (string->utf8 value))
#:hash-algo 'sha256
#:inputs `((,%bash))
- #:leaked-env-vars '("NIX_STATE_DIR"))))
+ #:leaked-env-vars '("GUIX_STATE_DIRECTORY"))))
(and (build-derivations %store (list drv))
(call-with-input-file (derivation->output-path drv)
get-string-all))))
(builder '(begin (sleep 100) (mkdir %output) #t))
(drv (build-expression->derivation store "silent" builder))
(out-path (derivation->output-path drv)))
- (guard (c ((nix-protocol-error? c)
- (and (string-contains (nix-protocol-error-message c)
+ (guard (c ((store-protocol-error? c)
+ (and (string-contains (store-protocol-error-message c)
"failed")
(not (valid-path? store out-path)))))
(build-derivations store (list drv))
(builder '(begin (sleep 100) (mkdir %output) #t))
(drv (build-expression->derivation store "slow" builder))
(out-path (derivation->output-path drv)))
- (guard (c ((nix-protocol-error? c)
- (and (string-contains (nix-protocol-error-message c)
+ (guard (c ((store-protocol-error? c)
+ (and (string-contains (store-protocol-error-message c)
"failed")
(not (valid-path? store out-path)))))
(build-derivations store (list drv))
#f)))
+(test-assert "build-derivations with specific output"
+ (with-store store
+ (let* ((content (random-text)) ;contents of the output
+ (drv (build-expression->derivation
+ store "substitute-me"
+ `(begin ,content (exit 1)) ;would fail
+ #:outputs '("out" "one" "two")
+ #:guile-for-build
+ (package-derivation store %bootstrap-guile)))
+ (out (derivation->output-path drv)))
+ (with-derivation-substitute drv content
+ (set-build-options store #:use-substitutes? #t
+ #:substitute-urls (%test-substitute-urls))
+ (and (has-substitutes? store out)
+
+ ;; Ask for nothing but the "out" output of DRV.
+ (build-derivations store `((,drv . "out")))
+
+ (valid-path? store out)
+ (equal? (pk 'x content) (pk 'y (call-with-input-file out get-string-all)))
+ )))))
+
(test-assert "build-expression->derivation and derivation-prerequisites-to-build"
(let ((drv (build-expression->derivation %store "fail" #f)))
;; The only direct dependency is (%guile-for-build) and it's already
#f)) ; fail!
(drv (build-expression->derivation %store "fail" builder))
(out-path (derivation->output-path drv)))
- (guard (c ((nix-protocol-error? c)
+ (guard (c ((store-protocol-error? c)
;; Note that the output path may exist at this point, but it
;; is invalid.
(and (string-match "build .* failed"
- (nix-protocol-error-message c))
+ (store-protocol-error-message c))
(not (valid-path? %store out-path)))))
(build-derivations %store (list drv))
#f)))
((p2 . _)
(string<? p1 p2)))))))))))))
+(test-equal "derivation-properties"
+ (list '() '((type . test)))
+ (let ((drv1 (build-expression->derivation %store "bar"
+ '(mkdir %output)))
+ (drv2 (build-expression->derivation %store "foo"
+ '(mkdir %output)
+ #:properties '((type . test)))))
+ (list (derivation-properties drv1)
+ (derivation-properties drv2))))
+
(test-equal "map-derivation"
"hello"
(let* ((joke (package-derivation %store guile-1.8))
HCoop / jackhill / guix / guix.git / blobdiff