derivations: Update tests to use new calling convention.

* tests/derivations.scm ("build derivation with 1 source"): Adjust to
new 'derivation' calling convention.
("identical files are deduplicated"): Likewise.
("fixed-output-derivation?"): Likewise.
("fixed-output derivation"): Likewise.
("fixed-output derivation, recursive"): Likewise.
("derivation with a fixed-output input"): Likewise.
("multiple-output derivation"): Likewise.
("multiple-output derivation, non-alphabetic order"): Likewise.
("read-derivation vs. derivation"): Likewise.
("user of multiple-output derivation"): Likewise.
("derivation with #:references-graphs"): Likewise.
("derivation #:allowed-references, ok"): Likewise.
("derivation #:allowed-references, not allowed"): Likewise.
("derivation #:allowed-references, self allowed"): Likewise.
("derivation #:allowed-references, self not allowed"): Likewise.
("derivation #:disallowed-references, ok"): Likewise.
("derivation #:disallowed-references, not ok"): Likewise.
("derivation #:leaked-env-vars"): Likewise.
("build derivation with coreutils"): Likewise.
("map-derivation, sources"): Likewise.
("derivation with local file as input"): Remove.
master
Ludovic Courtès 2019-07-10 18:14:47 +02:00
parent d145832151
commit 9e64302d68
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 35 additions and 54 deletions

View File

@ -137,7 +137,7 @@
#:env-vars '(("HOME" . "/homeless") #:env-vars '(("HOME" . "/homeless")
("zzz" . "Z!") ("zzz" . "Z!")
("AAA" . "A!")) ("AAA" . "A!"))
#:inputs `((,%bash) (,builder)))) #:sources `(,%bash ,builder)))
(succeeded? (succeeded?
(build-derivations %store (list drv)))) (build-derivations %store (list drv))))
(and succeeded? (and succeeded?
@ -146,36 +146,13 @@
(string=? (call-with-input-file path read-line) (string=? (call-with-input-file path read-line)
"hello, world")))))) "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" (test-assert "derivation fails but keep going"
;; In keep-going mode, 'build-derivations' should fail because of D1, but it ;; In keep-going mode, 'build-derivations' should fail because of D1, but it
;; must return only after D2 has succeeded. ;; must return only after D2 has succeeded.
(with-store store (with-store store
(let* ((d1 (derivation %store "fails" (let* ((d1 (derivation %store "fails"
%bash `("-c" "false") %bash `("-c" "false")
#:inputs `((,%bash)))) #:sources (list %bash)))
(d2 (build-expression->derivation %store "sleep-then-succeed" (d2 (build-expression->derivation %store "sleep-then-succeed"
`(begin `(begin
,(random-text) ,(random-text)
@ -205,10 +182,10 @@
'())) '()))
(drv1 (derivation %store "foo" (drv1 (derivation %store "foo"
%bash `(,build1) %bash `(,build1)
#:inputs `((,%bash) (,build1)))) #:sources `(,%bash ,build1)))
(drv2 (derivation %store "bar" (drv2 (derivation %store "bar"
%bash `(,build2) %bash `(,build2)
#:inputs `((,%bash) (,build2))))) #:sources `(,%bash ,build2))))
(and (build-derivations %store (list drv1 drv2)) (and (build-derivations %store (list drv1 drv2))
(let ((file1 (derivation->output-path drv1)) (let ((file1 (derivation->output-path drv1))
(file2 (derivation->output-path drv2))) (file2 (derivation->output-path drv2)))
@ -344,7 +321,7 @@
(hash (sha256 (string->utf8 "hello"))) (hash (sha256 (string->utf8 "hello")))
(drv (derivation %store "fixed" (drv (derivation %store "fixed"
%bash `(,builder) %bash `(,builder)
#:inputs `((,builder)) #:sources (list builder)
#:hash hash #:hash-algo 'sha256))) #:hash hash #:hash-algo 'sha256)))
(fixed-output-derivation? drv))) (fixed-output-derivation? drv)))
@ -354,7 +331,7 @@
(hash (sha256 (string->utf8 "hello"))) (hash (sha256 (string->utf8 "hello")))
(drv (derivation %store "fixed" (drv (derivation %store "fixed"
%bash `(,builder) %bash `(,builder)
#:inputs `((,builder)) ; optional #:sources `(,builder) ;optional
#:hash hash #:hash-algo 'sha256)) #:hash hash #:hash-algo 'sha256))
(succeeded? (build-derivations %store (list drv)))) (succeeded? (build-derivations %store (list drv))))
(and succeeded? (and succeeded?
@ -386,7 +363,7 @@
(hash (sha256 (string->utf8 "hello"))) (hash (sha256 (string->utf8 "hello")))
(drv (derivation %store "fixed-rec" (drv (derivation %store "fixed-rec"
%bash `(,builder) %bash `(,builder)
#:inputs `((,builder)) #:sources (list builder)
#:hash (base32 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa") #:hash (base32 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
#:hash-algo 'sha256 #:hash-algo 'sha256
#:recursive? #t)) #:recursive? #t))
@ -420,11 +397,13 @@
(final1 (derivation %store "final" (final1 (derivation %store "final"
%bash `(,builder3) %bash `(,builder3)
#:env-vars `(("in" . ,fixed-out)) #:env-vars `(("in" . ,fixed-out))
#:inputs `((,%bash) (,builder3) (,fixed1)))) #:sources (list %bash builder3)
#:inputs (list (derivation-input fixed1))))
(final2 (derivation %store "final" (final2 (derivation %store "final"
%bash `(,builder3) %bash `(,builder3)
#:env-vars `(("in" . ,fixed-out)) #:env-vars `(("in" . ,fixed-out))
#:inputs `((,%bash) (,builder3) (,fixed2)))) #:sources (list %bash builder3)
#:inputs (list (derivation-input fixed2))))
(succeeded? (build-derivations %store (succeeded? (build-derivations %store
(list final1 final2)))) (list final1 final2))))
(and succeeded? (and succeeded?
@ -440,7 +419,7 @@
#:env-vars '(("HOME" . "/homeless") #:env-vars '(("HOME" . "/homeless")
("zzz" . "Z!") ("zzz" . "Z!")
("AAA" . "A!")) ("AAA" . "A!"))
#:inputs `((,%bash) (,builder)) #:sources `(,%bash ,builder)
#:outputs '("out" "second"))) #:outputs '("out" "second")))
(succeeded? (build-derivations %store (list drv)))) (succeeded? (build-derivations %store (list drv))))
(and succeeded? (and succeeded?
@ -460,7 +439,7 @@
'())) '()))
(drv (derivation %store "fixed" (drv (derivation %store "fixed"
%bash `(,builder) %bash `(,builder)
#:inputs `((,%bash) (,builder)) #:sources `(,%bash ,builder)
#:outputs '("out" "AAA"))) #:outputs '("out" "AAA")))
(succeeded? (build-derivations %store (list drv)))) (succeeded? (build-derivations %store (list drv))))
(and succeeded? (and succeeded?
@ -482,15 +461,15 @@
(inputs (map (lambda (file) (inputs (map (lambda (file)
(derivation %store "derivation-input" (derivation %store "derivation-input"
%bash '() %bash '()
#:inputs `((,%bash) (,file)))) #:sources `(,%bash ,file)))
sources)) sources))
(builder (add-text-to-store %store "builder.sh" (builder (add-text-to-store %store "builder.sh"
"echo one > $one ; echo two > $two" "echo one > $one ; echo two > $two"
'())) '()))
(drv (derivation %store "derivation" (drv (derivation %store "derivation"
%bash `(,builder) %bash `(,builder)
#:inputs `((,%bash) (,builder) #:sources `(,%bash ,builder ,@sources)
,@(map list (append sources inputs))) #:inputs (map derivation-input inputs)
#:outputs '("two" "one"))) #:outputs '("two" "one")))
(drv* (call-with-input-file (derivation-file-name drv) (drv* (call-with-input-file (derivation-file-name drv)
read-derivation))) read-derivation)))
@ -521,7 +500,7 @@
'())) '()))
(mdrv (derivation %store "multiple-output" (mdrv (derivation %store "multiple-output"
%bash `(,builder1) %bash `(,builder1)
#:inputs `((,%bash) (,builder1)) #:sources (list %bash builder1)
#:outputs '("out" "two"))) #:outputs '("out" "two")))
(builder2 (add-text-to-store %store "my-mo-user-builder.sh" (builder2 (add-text-to-store %store "my-mo-user-builder.sh"
"read x < $one; "read x < $one;
@ -536,11 +515,11 @@
("two" ("two"
. ,(derivation->output-path . ,(derivation->output-path
mdrv "two"))) mdrv "two")))
#:inputs `((,%bash) #:sources (list %bash builder2)
(,builder2) ;; two occurrences of MDRV:
;; two occurrences of MDRV: #:inputs
(,mdrv) (list (derivation-input mdrv)
(,mdrv "two"))))) (derivation-input mdrv '("two"))))))
(and (build-derivations %store (list (pk 'udrv udrv))) (and (build-derivations %store (list (pk 'udrv udrv)))
(let ((p (derivation->output-path udrv))) (let ((p (derivation->output-path udrv)))
(and (valid-path? %store p) (and (valid-path? %store p)
@ -566,7 +545,7 @@
`(("bash" . ,%bash) `(("bash" . ,%bash)
("input1" . ,input1) ("input1" . ,input1)
("input2" . ,input2)) ("input2" . ,input2))
#:inputs `((,%bash) (,builder)))) #:sources (list %bash builder)))
(out (derivation->output-path drv))) (out (derivation->output-path drv)))
(define (deps path . deps) (define (deps path . deps)
(let ((count (length deps))) (let ((count (length deps)))
@ -599,7 +578,7 @@
(test-assert "derivation #:allowed-references, ok" (test-assert "derivation #:allowed-references, ok"
(let ((drv (derivation %store "allowed" %bash (let ((drv (derivation %store "allowed" %bash
'("-c" "echo hello > $out") '("-c" "echo hello > $out")
#:inputs `((,%bash)) #:sources (list %bash)
#:allowed-references '()))) #:allowed-references '())))
(build-derivations %store (list drv)))) (build-derivations %store (list drv))))
@ -607,7 +586,7 @@
(let* ((txt (add-text-to-store %store "foo" "Hello, world.")) (let* ((txt (add-text-to-store %store "foo" "Hello, world."))
(drv (derivation %store "disallowed" %bash (drv (derivation %store "disallowed" %bash
`("-c" ,(string-append "echo " txt "> $out")) `("-c" ,(string-append "echo " txt "> $out"))
#:inputs `((,%bash) (,txt)) #:sources (list %bash txt)
#:allowed-references '()))) #:allowed-references '())))
(guard (c ((store-protocol-error? c) (guard (c ((store-protocol-error? c)
;; There's no specific error message to check for. ;; There's no specific error message to check for.
@ -618,14 +597,14 @@
(test-assert "derivation #:allowed-references, self allowed" (test-assert "derivation #:allowed-references, self allowed"
(let ((drv (derivation %store "allowed" %bash (let ((drv (derivation %store "allowed" %bash
'("-c" "echo $out > $out") '("-c" "echo $out > $out")
#:inputs `((,%bash)) #:sources (list %bash)
#:allowed-references '("out")))) #:allowed-references '("out"))))
(build-derivations %store (list drv)))) (build-derivations %store (list drv))))
(test-assert "derivation #:allowed-references, self not allowed" (test-assert "derivation #:allowed-references, self not allowed"
(let ((drv (derivation %store "disallowed" %bash (let ((drv (derivation %store "disallowed" %bash
`("-c" ,"echo $out > $out") `("-c" ,"echo $out > $out")
#:inputs `((,%bash)) #:sources (list %bash)
#:allowed-references '()))) #:allowed-references '())))
(guard (c ((store-protocol-error? c) (guard (c ((store-protocol-error? c)
;; There's no specific error message to check for. ;; There's no specific error message to check for.
@ -636,7 +615,7 @@
(test-assert "derivation #:disallowed-references, ok" (test-assert "derivation #:disallowed-references, ok"
(let ((drv (derivation %store "disallowed" %bash (let ((drv (derivation %store "disallowed" %bash
'("-c" "echo hello > $out") '("-c" "echo hello > $out")
#:inputs `((,%bash)) #:sources (list %bash)
#:disallowed-references '("out")))) #:disallowed-references '("out"))))
(build-derivations %store (list drv)))) (build-derivations %store (list drv))))
@ -644,7 +623,7 @@
(let* ((txt (add-text-to-store %store "foo" "Hello, world.")) (let* ((txt (add-text-to-store %store "foo" "Hello, world."))
(drv (derivation %store "disdisallowed" %bash (drv (derivation %store "disdisallowed" %bash
`("-c" ,(string-append "echo " txt "> $out")) `("-c" ,(string-append "echo " txt "> $out"))
#:inputs `((,%bash) (,txt)) #:sources (list %bash txt)
#:disallowed-references (list txt)))) #:disallowed-references (list txt))))
(guard (c ((store-protocol-error? c) (guard (c ((store-protocol-error? c)
;; There's no specific error message to check for. ;; There's no specific error message to check for.
@ -663,7 +642,7 @@
'("-c" "echo -n $GUIX_STATE_DIRECTORY > $out") '("-c" "echo -n $GUIX_STATE_DIRECTORY > $out")
#:hash (sha256 (string->utf8 value)) #:hash (sha256 (string->utf8 value))
#:hash-algo 'sha256 #:hash-algo 'sha256
#:inputs `((,%bash)) #:sources (list %bash)
#:leaked-env-vars '("GUIX_STATE_DIRECTORY")))) #:leaked-env-vars '("GUIX_STATE_DIRECTORY"))))
(and (build-derivations %store (list drv)) (and (build-derivations %store (list drv))
(call-with-input-file (derivation->output-path drv) (call-with-input-file (derivation->output-path drv)
@ -689,8 +668,8 @@
,(string-append ,(string-append
(derivation->output-path %coreutils) (derivation->output-path %coreutils)
"/bin"))) "/bin")))
#:inputs `((,builder) #:sources (list builder)
(,%coreutils)))) #:inputs (list (derivation-input %coreutils))))
(succeeded? (succeeded?
(build-derivations %store (list drv)))) (build-derivations %store (list drv))))
(and succeeded? (and succeeded?
@ -1240,7 +1219,9 @@
(derivation->output-path bash-full) (derivation->output-path bash-full)
`("-e" ,script1) `("-e" ,script1)
#:inputs `((,bash-full) (,script1)))) #:sources (list script1)
#:inputs
(list (derivation-input bash-full '("out")))))
(drv2 (map-derivation %store drv1 (drv2 (map-derivation %store drv1
`((,bash-full . ,%bash) `((,bash-full . ,%bash)
(,script1 . ,script2)))) (,script1 . ,script2))))