;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 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 (gcrypt hash)
+ #:use-module ((gcrypt hash) #:prefix gcrypt:)
#: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)
(test-assert "parse & export"
(let* ((f (search-path %load-path "tests/test.drv"))
(b1 (call-with-input-file f get-bytevector-all))
- (d1 (read-derivation (open-bytevector-input-port b1)))
+ (d1 (read-derivation (open-bytevector-input-port b1)
+ identity))
(b2 (call-with-bytevector-output-port (cut write-derivation d1 <>)))
- (d2 (read-derivation (open-bytevector-input-port b2))))
+ (d2 (read-derivation (open-bytevector-input-port b2)
+ identity)))
(and (equal? b1 b2)
(equal? d1 d2))))
#:env-vars '(("HOME" . "/homeless")
("zzz" . "Z!")
("AAA" . "A!"))
- #:inputs `((,%bash) (,builder))))
+ #:sources `(,%bash ,builder)))
(succeeded?
(build-derivations %store (list drv))))
(and succeeded?
(string=? (call-with-input-file path read-line)
"hello, world"))))))
-(test-assert "derivation with local file as input"
- (let* ((builder (add-text-to-store
- %store "my-builder.sh"
- "(while read line ; do echo \"$line\" ; done) < $in > $out"
- '()))
- (input (search-path %load-path "ice-9/boot-9.scm"))
- (input* (add-to-store %store (basename input)
- #t "sha256" input))
- (drv (derivation %store "derivation-with-input-file"
- %bash `(,builder)
-
- ;; Cheat to pass the actual file name to the
- ;; builder.
- #:env-vars `(("in" . ,input*))
-
- #:inputs `((,%bash)
- (,builder)
- (,input))))) ; ← local file name
- (and (build-derivations %store (list drv))
- ;; Note: we can't compare the files because the above trick alters
- ;; the contents.
- (valid-path? %store (derivation->output-path drv)))))
-
(test-assert "derivation fails but keep going"
;; In keep-going mode, 'build-derivations' should fail because of D1, but it
;; must return only after D2 has succeeded.
(with-store store
(let* ((d1 (derivation %store "fails"
%bash `("-c" "false")
- #:inputs `((,%bash))))
+ #:sources (list %bash)))
(d2 (build-expression->derivation %store "sleep-then-succeed"
`(begin
,(random-text)
'()))
(drv1 (derivation %store "foo"
%bash `(,build1)
- #:inputs `((,%bash) (,build1))))
+ #:sources `(,%bash ,build1)))
(drv2 (derivation %store "bar"
%bash `(,build2)
- #:inputs `((,%bash) (,build2)))))
+ #:sources `(,%bash ,build2))))
(and (build-derivations %store (list drv1 drv2))
(let ((file1 (derivation->output-path drv1))
(file2 (derivation->output-path drv2)))
(test-skip 1))
(test-assert "'download' built-in builder"
(let ((text (random-text)))
- (with-http-server 200 text
+ (with-http-server `((200 ,text))
(let* ((drv (derivation %store "world"
"builtin:download" '()
#:env-vars `(("url"
. ,(object->string (%local-url))))
#:hash-algo 'sha256
- #:hash (sha256 (string->utf8 text)))))
+ #:hash (gcrypt:sha256 (string->utf8 text)))))
(and (build-derivations %store (list drv))
(string=? (call-with-input-file (derivation->output-path drv)
get-string-all)
(unless (http-server-can-listen?)
(test-skip 1))
(test-assert "'download' built-in builder, invalid hash"
- (with-http-server 200 "hello, world!"
+ (with-http-server `((200 "hello, world!"))
(let* ((drv (derivation %store "world"
"builtin:download" '()
#:env-vars `(("url"
. ,(object->string (%local-url))))
#:hash-algo 'sha256
- #:hash (sha256 (random-bytevector 100))))) ;wrong
+ #:hash (gcrypt:sha256 (random-bytevector 100))))) ;wrong
(guard (c ((store-protocol-error? c)
(string-contains (store-protocol-error-message c) "failed")))
(build-derivations %store (list drv))
(unless (http-server-can-listen?)
(test-skip 1))
(test-assert "'download' built-in builder, not found"
- (with-http-server 404 "not found"
+ (with-http-server '((404 "not found"))
(let* ((drv (derivation %store "will-never-be-found"
"builtin:download" '()
#:env-vars `(("url"
. ,(object->string (%local-url))))
#:hash-algo 'sha256
- #:hash (sha256 (random-bytevector 100)))))
+ #:hash (gcrypt:sha256 (random-bytevector 100)))))
(guard (c ((store-protocol-error? c)
(string-contains (store-protocol-error-message (pk c)) "failed")))
(build-derivations %store (list drv))
#:env-vars `(("url"
. ,(object->string (%local-url))))
#:hash-algo 'sha256
- #:hash (sha256 (string->utf8 text)))))
- (and (with-http-server 200 text
+ #:hash (gcrypt:sha256 (string->utf8 text)))))
+ (and (with-http-server `((200 ,text))
(build-derivations %store (list drv)))
- (with-http-server 200 text
+ (with-http-server `((200 ,text))
(build-derivations %store (list drv)
(build-mode check)))
(string=? (call-with-input-file (derivation->output-path drv)
(test-assert "fixed-output-derivation?"
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
"echo -n hello > $out" '()))
- (hash (sha256 (string->utf8 "hello")))
+ (hash (gcrypt:sha256 (string->utf8 "hello")))
(drv (derivation %store "fixed"
%bash `(,builder)
- #:inputs `((,builder))
+ #:sources (list builder)
#:hash hash #:hash-algo 'sha256)))
(fixed-output-derivation? drv)))
-(test-assert "fixed-output derivation"
- (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
- "echo -n hello > $out" '()))
- (hash (sha256 (string->utf8 "hello")))
- (drv (derivation %store "fixed"
- %bash `(,builder)
- #:inputs `((,builder)) ; optional
- #:hash hash #:hash-algo 'sha256))
- (succeeded? (build-derivations %store (list drv))))
- (and succeeded?
- (let ((p (derivation->output-path drv)))
- (and (equal? (string->utf8 "hello")
- (call-with-input-file p get-bytevector-all))
- (bytevector? (query-path-hash %store p)))))))
+(test-equal "fixed-output derivation"
+ '(sha1 sha256 sha512)
+ (map (lambda (hash-algorithm)
+ (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
+ "echo -n hello > $out" '()))
+ (sha256 (gcrypt:sha256 (string->utf8 "hello")))
+ (hash (gcrypt:bytevector-hash
+ (string->utf8 "hello")
+ (gcrypt:lookup-hash-algorithm hash-algorithm)))
+ (drv (derivation %store
+ (string-append
+ "fixed-" (symbol->string hash-algorithm))
+ %bash `(,builder)
+ #:sources `(,builder) ;optional
+ #:hash hash
+ #:hash-algo hash-algorithm)))
+ (build-derivations %store (list drv))
+ (let ((p (derivation->output-path drv)))
+ (and (bytevector=? (string->utf8 "hello")
+ (call-with-input-file p get-bytevector-all))
+ (bytevector? (query-path-hash %store p))
+ hash-algorithm))))
+ '(sha1 sha256 sha512)))
(test-assert "fixed-output derivation: output paths are equal"
(let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
"echo -n hello > $out" '()))
(builder2 (add-text-to-store %store "fixed-builder2.sh"
"echo hey; echo -n hello > $out" '()))
- (hash (sha256 (string->utf8 "hello")))
+ (hash (gcrypt:sha256 (string->utf8 "hello")))
(drv1 (derivation %store "fixed"
%bash `(,builder1)
#:hash hash #:hash-algo 'sha256))
(test-assert "fixed-output derivation, recursive"
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
"echo -n hello > $out" '()))
- (hash (sha256 (string->utf8 "hello")))
+ (hash (gcrypt:sha256 (string->utf8 "hello")))
(drv (derivation %store "fixed-rec"
%bash `(,builder)
- #:inputs `((,builder))
+ #:sources (list builder)
#:hash (base32 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
#:hash-algo 'sha256
#:recursive? #t))
"echo -n hello > $out" '()))
(builder2 (add-text-to-store %store "fixed-builder2.sh"
"echo hey; echo -n hello > $out" '()))
- (hash (sha256 (string->utf8 "hello")))
+ (hash (gcrypt:sha256 (string->utf8 "hello")))
(fixed1 (derivation %store "fixed"
%bash `(,builder1)
#:hash hash #:hash-algo 'sha256))
(final1 (derivation %store "final"
%bash `(,builder3)
#:env-vars `(("in" . ,fixed-out))
- #:inputs `((,%bash) (,builder3) (,fixed1))))
+ #:sources (list %bash builder3)
+ #:inputs (list (derivation-input fixed1))))
(final2 (derivation %store "final"
%bash `(,builder3)
#:env-vars `(("in" . ,fixed-out))
- #:inputs `((,%bash) (,builder3) (,fixed2))))
+ #:sources (list %bash builder3)
+ #:inputs (list (derivation-input fixed2))))
(succeeded? (build-derivations %store
(list final1 final2))))
(and succeeded?
(equal? (derivation->output-path final1)
(derivation->output-path final2)))))
+(test-assert "derivation with duplicate fixed-output inputs"
+ ;; Here we create a derivation that has two inputs, both of which are
+ ;; fixed-output leading to the same result. This test ensures the hash of
+ ;; that derivation is correctly computed, namely that duplicate inputs are
+ ;; coalesced. See <https://bugs.gnu.org/36777>.
+ (let* ((builder1 (add-text-to-store %store "fixed-builder1.sh"
+ "echo -n hello > $out" '()))
+ (builder2 (add-text-to-store %store "fixed-builder2.sh"
+ "echo hey; echo -n hello > $out" '()))
+ (hash (gcrypt:sha256 (string->utf8 "hello")))
+ (fixed1 (derivation %store "fixed"
+ %bash `(,builder1)
+ #:hash hash #:hash-algo 'sha256))
+ (fixed2 (derivation %store "fixed"
+ %bash `(,builder2)
+ #:hash hash #:hash-algo 'sha256))
+ (builder3 (add-text-to-store %store "builder.sh"
+ "echo fake builder"))
+ (final (derivation %store "final"
+ %bash `(,builder3)
+ #:sources (list %bash builder3)
+ #:inputs (list (derivation-input fixed1)
+ (derivation-input fixed2)))))
+ (and (derivation? final)
+ (match (derivation-inputs final)
+ (((= derivation-input-derivation one)
+ (= derivation-input-derivation two))
+ (and (not (string=? (derivation-file-name one)
+ (derivation-file-name two)))
+ (string=? (derivation->output-path one)
+ (derivation->output-path two))))))))
+
(test-assert "multiple-output derivation"
(let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
"echo one > $out ; echo two > $second"
#:env-vars '(("HOME" . "/homeless")
("zzz" . "Z!")
("AAA" . "A!"))
- #:inputs `((,%bash) (,builder))
+ #:sources `(,%bash ,builder)
#:outputs '("out" "second")))
(succeeded? (build-derivations %store (list drv))))
(and succeeded?
'()))
(drv (derivation %store "fixed"
%bash `(,builder)
- #:inputs `((,%bash) (,builder))
+ #:sources `(,%bash ,builder)
#:outputs '("out" "AAA")))
(succeeded? (build-derivations %store (list drv))))
(and succeeded?
(inputs (map (lambda (file)
(derivation %store "derivation-input"
%bash '()
- #:inputs `((,%bash) (,file))))
+ #:sources `(,%bash ,file)))
sources))
(builder (add-text-to-store %store "builder.sh"
"echo one > $one ; echo two > $two"
'()))
(drv (derivation %store "derivation"
%bash `(,builder)
- #:inputs `((,%bash) (,builder)
- ,@(map list (append sources inputs)))
+ #:sources `(,%bash ,builder ,@sources)
+ #:inputs (map derivation-input inputs)
#:outputs '("two" "one")))
(drv* (call-with-input-file (derivation-file-name drv)
read-derivation)))
'()))
(mdrv (derivation %store "multiple-output"
%bash `(,builder1)
- #:inputs `((,%bash) (,builder1))
+ #:sources (list %bash builder1)
#:outputs '("out" "two")))
(builder2 (add-text-to-store %store "my-mo-user-builder.sh"
"read x < $one;
("two"
. ,(derivation->output-path
mdrv "two")))
- #:inputs `((,%bash)
- (,builder2)
- ;; two occurrences of MDRV:
- (,mdrv)
- (,mdrv "two")))))
+ #:sources (list %bash builder2)
+ ;; two occurrences of MDRV:
+ #:inputs
+ (list (derivation-input mdrv)
+ (derivation-input mdrv '("two"))))))
(and (build-derivations %store (list (pk 'udrv udrv)))
(let ((p (derivation->output-path udrv)))
(and (valid-path? %store p)
`(("bash" . ,%bash)
("input1" . ,input1)
("input2" . ,input2))
- #:inputs `((,%bash) (,builder))))
+ #:sources (list %bash builder)))
(out (derivation->output-path drv)))
(define (deps path . deps)
(let ((count (length deps)))
(test-assert "derivation #:allowed-references, ok"
(let ((drv (derivation %store "allowed" %bash
'("-c" "echo hello > $out")
- #:inputs `((,%bash))
+ #:sources (list %bash)
#:allowed-references '())))
(build-derivations %store (list drv))))
(let* ((txt (add-text-to-store %store "foo" "Hello, world."))
(drv (derivation %store "disallowed" %bash
`("-c" ,(string-append "echo " txt "> $out"))
- #:inputs `((,%bash) (,txt))
+ #:sources (list %bash txt)
#:allowed-references '())))
(guard (c ((store-protocol-error? c)
;; There's no specific error message to check for.
(test-assert "derivation #:allowed-references, self allowed"
(let ((drv (derivation %store "allowed" %bash
'("-c" "echo $out > $out")
- #:inputs `((,%bash))
+ #:sources (list %bash)
#:allowed-references '("out"))))
(build-derivations %store (list drv))))
(test-assert "derivation #:allowed-references, self not allowed"
(let ((drv (derivation %store "disallowed" %bash
`("-c" ,"echo $out > $out")
- #:inputs `((,%bash))
+ #:sources (list %bash)
#:allowed-references '())))
(guard (c ((store-protocol-error? c)
;; There's no specific error message to check for.
(test-assert "derivation #:disallowed-references, ok"
(let ((drv (derivation %store "disallowed" %bash
'("-c" "echo hello > $out")
- #:inputs `((,%bash))
+ #:sources (list %bash)
#:disallowed-references '("out"))))
(build-derivations %store (list drv))))
(let* ((txt (add-text-to-store %store "foo" "Hello, world."))
(drv (derivation %store "disdisallowed" %bash
`("-c" ,(string-append "echo " txt "> $out"))
- #:inputs `((,%bash) (,txt))
+ #:sources (list %bash txt)
#:disallowed-references (list txt))))
(guard (c ((store-protocol-error? c)
;; There's no specific error message to check for.
(let* ((value (getenv "GUIX_STATE_DIRECTORY"))
(drv (derivation %store "leaked-env-vars" %bash
'("-c" "echo -n $GUIX_STATE_DIRECTORY > $out")
- #:hash (sha256 (string->utf8 value))
+ #:hash (gcrypt:sha256 (string->utf8 value))
#:hash-algo 'sha256
- #:inputs `((,%bash))
+ #:sources (list %bash)
#:leaked-env-vars '("GUIX_STATE_DIRECTORY"))))
(and (build-derivations %store (list drv))
(call-with-input-file (derivation->output-path drv)
,(string-append
(derivation->output-path %coreutils)
"/bin")))
- #:inputs `((,builder)
- (,%coreutils))))
+ #:sources (list builder)
+ #:inputs (list (derivation-input %coreutils))))
(succeeded?
(build-derivations %store (list drv))))
(and succeeded?
(test-assert "build-expression->derivation and derivation-prerequisites"
(let ((drv (build-expression->derivation %store "fail" #f)))
(any (match-lambda
- (($ <derivation-input> path)
+ (($ <derivation-input> (= derivation-file-name path))
(string=? path (derivation-file-name (%guile-for-build)))))
(derivation-prerequisites drv))))
(match (derivation-prerequisites c
(cut valid-derivation-input? %store
<>))
- ((($ <derivation-input> file ("out")))
+ ((($ <derivation-input> (= derivation-file-name file) ("out")))
(string=? file (derivation-file-name b)))
(x
(pk 'fail x #f)))))
(build-derivations store (list drv))
#f)))
-(test-assert "build-expression->derivation and derivation-prerequisites-to-build"
+(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")))
+
+ ;; Synonymous:
+ (build-derivations store (list (derivation-input 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-build-plan"
(let ((drv (build-expression->derivation %store "fail" #f)))
;; The only direct dependency is (%guile-for-build) and it's already
;; built.
- (null? (derivation-prerequisites-to-build %store drv))))
+ (null? (derivation-build-plan %store (derivation-inputs drv)))))
-(test-assert "derivation-prerequisites-to-build when outputs already present"
- (let* ((builder '(begin (mkdir %output) #t))
+(test-assert "derivation-build-plan when outputs already present"
+ (let* ((builder `(begin ,(random-text) (mkdir %output) #t))
(input-drv (build-expression->derivation %store "input" builder))
- (input-path (derivation-output-path
- (assoc-ref (derivation-outputs input-drv)
- "out")))
+ (input-path (derivation->output-path input-drv))
(drv (build-expression->derivation %store "something" builder
#:inputs
`(("i" ,input-drv))))
(output (derivation->output-path drv)))
- ;; Make sure these things are not already built.
- (when (valid-path? %store input-path)
- (delete-paths %store (list input-path)))
- (when (valid-path? %store output)
- (delete-paths %store (list output)))
-
- (and (equal? (map derivation-input-path
- (derivation-prerequisites-to-build %store drv))
- (list (derivation-file-name input-drv)))
+ ;; Assume these things are not already built.
+ (when (or (valid-path? %store input-path)
+ (valid-path? %store output))
+ (error "things already built" input-drv))
+
+ (and (lset= equal?
+ (map derivation-file-name
+ (derivation-build-plan %store
+ (list (derivation-input drv))))
+ (list (derivation-file-name input-drv)
+ (derivation-file-name drv)))
;; Build DRV and delete its input.
(build-derivations %store (list drv))
;; Now INPUT-PATH is missing, yet it shouldn't be listed as a
;; prerequisite to build because DRV itself is already built.
- (null? (derivation-prerequisites-to-build %store drv)))))
+ (null? (derivation-build-plan %store
+ (list (derivation-input drv)))))))
-(test-assert "derivation-prerequisites-to-build and substitutes"
+(test-assert "derivation-build-plan and substitutes"
(let* ((store (open-connection))
(drv (build-expression->derivation store "prereq-subst"
(random 1000)))
(with-derivation-narinfo drv
(let-values (((build download)
- (derivation-prerequisites-to-build store drv))
+ (derivation-build-plan store
+ (list (derivation-input drv))))
((build* download*)
- (derivation-prerequisites-to-build store drv
- #:substitutable-info
- (const #f))))
+ (derivation-build-plan store
+ (list (derivation-input drv))
+ #:substitutable-info
+ (const #f))))
(and (null? build)
(equal? (map substitutable-path download) (list output))
(null? download*)
- (null? build*))))))
+ (equal? (list drv) build*))))))
-(test-assert "derivation-prerequisites-to-build and substitutes, non-substitutable build"
+(test-assert "derivation-build-plan and substitutes, non-substitutable build"
(let* ((store (open-connection))
(drv (build-expression->derivation store "prereq-no-subst"
(random 1000)
(with-derivation-narinfo drv
(let-values (((build download)
- (derivation-prerequisites-to-build store drv)))
+ (derivation-build-plan store
+ (list (derivation-input drv)))))
;; Despite being available as a substitute, DRV will be built locally
;; due to #:substitutable? #f.
(and (null? download)
(match build
- (((? derivation-input? input))
- (string=? (derivation-input-path input)
- (derivation-file-name drv)))))))))
+ (((= derivation-file-name build))
+ (string=? build (derivation-file-name drv)))))))))
-(test-assert "derivation-prerequisites-to-build and substitutes, local build"
+(test-assert "derivation-build-plan and substitutes, non-substitutable dep"
+ (with-store store
+ (let* ((drv1 (build-expression->derivation store "prereq-no-subst"
+ (random 1000)
+ #:substitutable? #f))
+ (drv2 (build-expression->derivation store "substitutable"
+ (random 1000)
+ #:inputs `(("dep" ,drv1)))))
+
+ ;; Make sure substitutes are usable.
+ (set-build-options store #:use-substitutes? #t
+ #:substitute-urls (%test-substitute-urls))
+
+ (with-derivation-narinfo drv2
+ (sha256 => (make-bytevector 32 0))
+ (references => (list (derivation->output-path drv1)))
+
+ (let-values (((build download)
+ (derivation-build-plan store
+ (list (derivation-input drv2)))))
+ ;; Although DRV2 is available as a substitute, we must build its
+ ;; dependency, DRV1, due to #:substitutable? #f.
+ (and (match download
+ (((= substitutable-path item))
+ (string=? item (derivation->output-path drv2))))
+ (match build
+ (((= derivation-file-name build))
+ (string=? build (derivation-file-name drv1))))))))))
+
+(test-assert "derivation-build-plan and substitutes, local build"
(with-store store
(let* ((drv (build-expression->derivation store "prereq-subst-local"
(random 1000)
(with-derivation-narinfo drv
(let-values (((build download)
- (derivation-prerequisites-to-build store drv)))
+ (derivation-build-plan store
+ (list (derivation-input drv)))))
;; #:local-build? is *not* synonymous with #:substitutable?, so we
;; must be able to substitute DRV's output.
;; See <http://bugs.gnu.org/18747>.
(((= substitutable-path item))
(string=? item (derivation->output-path drv))))))))))
-(test-assert "derivation-prerequisites-to-build in 'check' mode"
+(test-assert "derivation-build-plan in 'check' mode"
(with-store store
(let* ((dep (build-expression->derivation store "dep"
`(begin ,(random-text)
(delete-paths store (list (derivation->output-path dep)))
;; In 'check' mode, DEP must be rebuilt.
- (and (null? (derivation-prerequisites-to-build store drv))
- (match (derivation-prerequisites-to-build store drv
- #:mode (build-mode
- check))
- ((input)
- (string=? (derivation-input-path input)
- (derivation-file-name dep))))))))
+ (and (null? (derivation-build-plan store
+ (list (derivation-input drv))))
+ (lset= equal?
+ (derivation-build-plan store
+ (list (derivation-input drv))
+ #:mode (build-mode check))
+ (list drv dep))))))
+
+(test-assert "derivation-input-fold"
+ (let* ((builder (add-text-to-store %store "my-builder.sh"
+ "echo hello, world > \"$out\"\n"
+ '()))
+ (drv1 (derivation %store "foo"
+ %bash `(,builder)
+ #:sources `(,%bash ,builder)))
+ (drv2 (derivation %store "bar"
+ %bash `(,builder)
+ #:inputs `((,drv1))
+ #:sources `(,%bash ,builder))))
+ (equal? (derivation-input-fold (lambda (input result)
+ (cons (derivation-input-derivation input)
+ result))
+ '()
+ (list (derivation-input drv2)))
+ (list drv1 drv2))))
(test-assert "substitution-oracle and #:substitute? #f"
(with-store store
(builder2 '(call-with-output-file (pk 'difference-here! %output)
(lambda (p)
(write "hello" p))))
- (hash (sha256 (string->utf8 "hello")))
+ (hash (gcrypt:sha256 (string->utf8 "hello")))
(input1 (build-expression->derivation %store "fixed" builder1
#:hash hash
#:hash-algo 'sha256))
(builder2 '(call-with-output-file (pk 'difference-here! %output)
(lambda (p)
(write "hello" p))))
- (hash (sha256 (string->utf8 "hello")))
+ (hash (gcrypt:sha256 (string->utf8 "hello")))
(input1 (build-expression->derivation %store "fixed" builder1
#:hash hash
#:hash-algo 'sha256))
(derivation->output-path bash-full)
`("-e" ,script1)
- #:inputs `((,bash-full) (,script1))))
+ #:sources (list script1)
+ #:inputs
+ (list (derivation-input bash-full '("out")))))
(drv2 (map-derivation %store drv1
`((,bash-full . ,%bash)
(,script1 . ,script2))))
(test-end)
;; Local Variables:
-;; eval: (put 'with-http-server 'scheme-indent-function 2)
+;; eval: (put 'with-http-server 'scheme-indent-function 1)
;; End:
HCoop / jackhill / guix / guix.git / blobdiff