From: "Ludovic Courtès" <ludo@gnu.org>
To: 36578@debbugs.gnu.org
Subject: [bug#36578] [PATCH 6/9] derivations: Update tests to use new calling convention.
Date: Wed, 10 Jul 2019 19:11:25 +0200 [thread overview]
Message-ID: <20190710171128.21568-6-ludo@gnu.org> (raw)
In-Reply-To: <20190710171128.21568-1-ludo@gnu.org>
* 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.
---
tests/derivations.scm | 89 +++++++++++++++++--------------------------
1 file changed, 35 insertions(+), 54 deletions(-)
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 7be7726163..368012d2b2 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -137,7 +137,7 @@
#:env-vars '(("HOME" . "/homeless")
("zzz" . "Z!")
("AAA" . "A!"))
- #:inputs `((,%bash) (,builder))))
+ #:sources `(,%bash ,builder)))
(succeeded?
(build-derivations %store (list drv))))
(and succeeded?
@@ -146,36 +146,13 @@
(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)
@@ -205,10 +182,10 @@
'()))
(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)))
@@ -344,7 +321,7 @@
(hash (sha256 (string->utf8 "hello")))
(drv (derivation %store "fixed"
%bash `(,builder)
- #:inputs `((,builder))
+ #:sources (list builder)
#:hash hash #:hash-algo 'sha256)))
(fixed-output-derivation? drv)))
@@ -354,7 +331,7 @@
(hash (sha256 (string->utf8 "hello")))
(drv (derivation %store "fixed"
%bash `(,builder)
- #:inputs `((,builder)) ; optional
+ #:sources `(,builder) ;optional
#:hash hash #:hash-algo 'sha256))
(succeeded? (build-derivations %store (list drv))))
(and succeeded?
@@ -386,7 +363,7 @@
(hash (sha256 (string->utf8 "hello")))
(drv (derivation %store "fixed-rec"
%bash `(,builder)
- #:inputs `((,builder))
+ #:sources (list builder)
#:hash (base32 "0sg9f58l1jj88w6pdrfdpj5x9b1zrwszk84j81zvby36q9whhhqa")
#:hash-algo 'sha256
#:recursive? #t))
@@ -420,11 +397,13 @@
(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?
@@ -440,7 +419,7 @@
#: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?
@@ -460,7 +439,7 @@
'()))
(drv (derivation %store "fixed"
%bash `(,builder)
- #:inputs `((,%bash) (,builder))
+ #:sources `(,%bash ,builder)
#:outputs '("out" "AAA")))
(succeeded? (build-derivations %store (list drv))))
(and succeeded?
@@ -482,15 +461,15 @@
(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)))
@@ -521,7 +500,7 @@
'()))
(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;
@@ -536,11 +515,11 @@
("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)
@@ -566,7 +545,7 @@
`(("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)))
@@ -599,7 +578,7 @@
(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))))
@@ -607,7 +586,7 @@
(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.
@@ -618,14 +597,14 @@
(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.
@@ -636,7 +615,7 @@
(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))))
@@ -644,7 +623,7 @@
(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.
@@ -663,7 +642,7 @@
'("-c" "echo -n $GUIX_STATE_DIRECTORY > $out")
#:hash (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)
@@ -689,8 +668,8 @@
,(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?
@@ -1240,7 +1219,9 @@
(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))))
--
2.22.0
next prev parent reply other threads:[~2019-07-10 17:13 UTC|newest]
Thread overview: 11+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-07-10 17:04 [bug#36578] [PATCH 0/9] Modernize the API of the 'derivation' primitive Ludovic Courtès
2019-07-10 17:11 ` [bug#36578] [PATCH 1/9] derivations: 'derivation' primitive accepts <derivation> and #:sources Ludovic Courtès
2019-07-10 17:11 ` [bug#36578] [PATCH 2/9] gexp: <lowered-gexp> separates sources from derivation inputs Ludovic Courtès
2019-07-10 17:11 ` [bug#36578] [PATCH 3/9] gnu: guile-bootstrap: Use the new 'derivation' calling convention Ludovic Courtès
2019-07-10 17:11 ` [bug#36578] [PATCH 4/9] download: " Ludovic Courtès
2019-07-10 17:11 ` [bug#36578] [PATCH 5/9] derivations: 'map-derivation' uses " Ludovic Courtès
2019-07-10 17:11 ` Ludovic Courtès [this message]
2019-07-10 17:11 ` [bug#36578] [PATCH 7/9] derivations: Deprecate the previous " Ludovic Courtès
2019-07-10 17:11 ` [bug#36578] [PATCH 8/9] gexp: 'lowered-gexp-guile' now returns a <derivation-input> Ludovic Courtès
2019-07-10 17:11 ` [bug#36578] [PATCH 9/9] channels: Avoid use of 'derivation-input-path' Ludovic Courtès
2019-07-15 8:46 ` bug#36578: [PATCH 0/9] Modernize the API of the 'derivation' primitive Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20190710171128.21568-6-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=36578@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).