* [bug#36578] [PATCH 2/9] gexp: <lowered-gexp> separates sources from derivation inputs.
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 ` 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
` (6 subsequent siblings)
7 siblings, 0 replies; 11+ messages in thread
From: Ludovic Courtès @ 2019-07-10 17:11 UTC (permalink / raw)
To: 36578
* guix/gexp.scm (lower-inputs): Return either <derivation-input> records
or store items.
(lower-reference-graphs): Return file/input pairs.
(<lowered-gexp>)[sources]: New field.
(lower-gexp): Adjust accordingly.
(gexp->input-tuple): Remove.
(gexp->derivation)[graphs-file-names]: Handle only the
'derivation-input?' and 'string?' cases.
Pass #:sources to 'raw-derivation'; ensure #:inputs contains only
<derivation-input> records.
* guix/remote.scm (remote-eval): Adjust to the new <lowered-gexp>
interface.
* tests/gexp.scm ("lower-gexp"): Adjust to expect <derivation-input>
records instead of <gexp-input>
---
guix/gexp.scm | 86 ++++++++++++++++++++++++++-----------------------
guix/remote.scm | 36 +++++++--------------
tests/gexp.scm | 5 +--
3 files changed, 60 insertions(+), 67 deletions(-)
diff --git a/guix/gexp.scm b/guix/gexp.scm
index ce48d8d001..52643bd684 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -85,6 +85,7 @@
lowered-gexp?
lowered-gexp-sexp
lowered-gexp-inputs
+ lowered-gexp-sources
lowered-gexp-guile
lowered-gexp-load-path
lowered-gexp-load-compiled-path
@@ -574,9 +575,9 @@ list."
(define* (lower-inputs inputs
#:key system target)
- "Turn any package from INPUTS into a derivation for SYSTEM; return the
-corresponding input list as a monadic value. When TARGET is true, use it as
-the cross-compilation target triplet."
+ "Turn any object from INPUTS into a derivation input for SYSTEM or a store
+item (a \"source\"); return the corresponding input list as a monadic value.
+When TARGET is true, use it as the cross-compilation target triplet."
(define (store-item? obj)
(and (string? obj) (store-path? obj)))
@@ -584,27 +585,30 @@ the cross-compilation target triplet."
(mapm %store-monad
(match-lambda
(((? struct? thing) sub-drv ...)
- (mlet %store-monad ((drv (lower-object
+ (mlet %store-monad ((obj (lower-object
thing system #:target target)))
- (return (apply gexp-input drv sub-drv))))
+ (return (match obj
+ ((? derivation? drv)
+ (let ((outputs (if (null? sub-drv)
+ '("out")
+ sub-drv)))
+ (derivation-input drv outputs)))
+ ((? store-item? item)
+ item)))))
(((? store-item? item))
- (return (gexp-input item)))
- (input
- (return (gexp-input input))))
+ (return item)))
inputs)))
(define* (lower-reference-graphs graphs #:key system target)
"Given GRAPHS, a list of (FILE-NAME INPUT ...) lists for use as a
#:reference-graphs argument, lower it such that each INPUT is replaced by the
-corresponding derivation."
+corresponding <derivation-input> or store item."
(match graphs
(((file-names . inputs) ...)
(mlet %store-monad ((inputs (lower-inputs inputs
#:system system
#:target target)))
- (return (map (lambda (file input)
- (cons file (gexp-input->tuple input)))
- file-names inputs))))))
+ (return (map cons file-names inputs))))))
(define* (lower-references lst #:key system target)
"Based on LST, a list of output names and packages, return a list of output
@@ -637,11 +641,13 @@ names and file names suitable for the #:allowed-references argument to
((force proc) system))))
;; Representation of a gexp instantiated for a given target and system.
+;; It's an intermediate representation between <gexp> and <derivation>.
(define-record-type <lowered-gexp>
- (lowered-gexp sexp inputs guile load-path load-compiled-path)
+ (lowered-gexp sexp inputs sources guile load-path load-compiled-path)
lowered-gexp?
(sexp lowered-gexp-sexp) ;sexp
- (inputs lowered-gexp-inputs) ;list of <gexp-input>
+ (inputs lowered-gexp-inputs) ;list of <derivation-input>
+ (sources lowered-gexp-sources) ;list of store items
(guile lowered-gexp-guile) ;<derivation> | #f
(load-path lowered-gexp-load-path) ;list of store items
(load-compiled-path lowered-gexp-load-compiled-path)) ;list of store items
@@ -740,26 +746,19 @@ derivations--e.g., code evaluated for its side effects."
(mbegin %store-monad
(set-grafting graft?) ;restore the initial setting
(return (lowered-gexp sexp
- `(,@(if modules
- (list (gexp-input modules))
+ `(,@(if (derivation? modules)
+ (list (derivation-input modules))
'())
,@(if compiled
- (list (gexp-input compiled))
+ (list (derivation-input compiled))
'())
- ,@(map gexp-input exts)
- ,@inputs)
+ ,@(map derivation-input exts)
+ ,@(filter derivation-input? inputs))
+ (filter string? (cons modules inputs))
guile
load-path
load-compiled-path)))))
-(define (gexp-input->tuple input)
- "Given INPUT, a <gexp-input> record, return the corresponding input tuple
-suitable for the 'derivation' procedure."
- (match (gexp-input-output input)
- ("out" `(,(gexp-input-thing input)))
- (output `(,(gexp-input-thing input)
- ,(gexp-input-output input)))))
-
(define* (gexp->derivation name exp
#:key
system (target 'current)
@@ -830,13 +829,10 @@ The other arguments are as for 'derivation'."
(define (graphs-file-names graphs)
;; Return a list of (FILE-NAME . STORE-PATH) pairs made from GRAPHS.
(map (match-lambda
- ;; TODO: Remove 'derivation?' special cases.
- ((file-name (? derivation? drv))
- (cons file-name (derivation->output-path drv)))
- ((file-name (? derivation? drv) sub-drv)
- (cons file-name (derivation->output-path drv sub-drv)))
- ((file-name thing)
- (cons file-name thing)))
+ ((file-name . (? derivation-input? input))
+ (cons file-name (first (derivation-input-output-paths input))))
+ ((file-name . (? string? item))
+ (cons file-name item)))
graphs))
(define (add-modules exp modules)
@@ -906,13 +902,23 @@ The other arguments are as for 'derivation'."
#:outputs outputs
#:env-vars env-vars
#:system system
- #:inputs `((,guile)
- (,builder)
- ,@(map gexp-input->tuple
- (lowered-gexp-inputs lowered))
+ #:inputs `(,(derivation-input guile '("out"))
+ ,@(lowered-gexp-inputs lowered)
,@(match graphs
- (((_ . inputs) ...) inputs)
- (_ '())))
+ (((_ . inputs) ...)
+ (filter derivation-input? inputs))
+ (#f '())))
+ #:sources `(,builder
+ ,@(if (and (string? modules)
+ (store-path? modules))
+ (list modules)
+ '())
+ ,@(lowered-gexp-sources lowered)
+ ,@(match graphs
+ (((_ . inputs) ...)
+ (filter string? inputs))
+ (#f '())))
+
#:hash hash #:hash-algo hash-algo #:recursive? recursive?
#:references-graphs (and=> graphs graphs-file-names)
#:allowed-references allowed
diff --git a/guix/remote.scm b/guix/remote.scm
index e503c76167..52ced16871 100644
--- a/guix/remote.scm
+++ b/guix/remote.scm
@@ -95,40 +95,26 @@ remote store."
(remote -> (connect-to-remote-daemon session
socket-name)))
(define inputs
- (cons (gexp-input (lowered-gexp-guile lowered))
+ (cons (derivation-input (lowered-gexp-guile lowered))
(lowered-gexp-inputs lowered)))
- (define to-build
- (map (lambda (input)
- (if (derivation? (gexp-input-thing input))
- (cons (gexp-input-thing input)
- (gexp-input-output input))
- (gexp-input-thing input)))
- inputs))
+ (define sources
+ (lowered-gexp-sources lowered))
(if build-locally?
- (let ((to-send (map (lambda (input)
- (match (gexp-input-thing input)
- ((? derivation? drv)
- (derivation->output-path
- drv (gexp-input-output input)))
- ((? store-path? item)
- item)))
- inputs)))
+ (let ((to-send (append (map derivation-input-output-paths inputs)
+ sources)))
(mbegin %store-monad
- (built-derivations to-build)
+ (built-derivations inputs)
((store-lift send-files) to-send remote #:recursive? #t)
(return (close-connection remote))
(return (%remote-eval lowered session))))
- (let ((to-send (map (lambda (input)
- (match (gexp-input-thing input)
- ((? derivation? drv)
- (derivation-file-name drv))
- ((? store-path? item)
- item)))
- inputs)))
+ (let ((to-send (append (map (compose derivation-file-name
+ derivation-input-derivation)
+ inputs)
+ sources)))
(mbegin %store-monad
((store-lift send-files) to-send remote #:recursive? #t)
- (return (build-derivations remote to-build))
+ (return (build-derivations remote inputs))
(return (close-connection remote))
(return (%remote-eval lowered session)))))))
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 23904fce2e..a1f79e3435 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -849,8 +849,9 @@
#:effective-version "2.0")))
(define (matching-input drv output)
(lambda (input)
- (and (eq? (gexp-input-thing input) drv)
- (string=? (gexp-input-output input) output))))
+ (and (eq? (derivation-input-derivation input) drv)
+ (equal? (derivation-input-sub-derivations input)
+ (list output)))))
(mbegin %store-monad
(return (and (find (matching-input extension-drv "out")
--
2.22.0
^ permalink raw reply related [flat|nested] 11+ messages in thread* [bug#36578] [PATCH 3/9] gnu: guile-bootstrap: Use the new 'derivation' calling convention.
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 ` Ludovic Courtès
2019-07-10 17:11 ` [bug#36578] [PATCH 4/9] download: " Ludovic Courtès
` (5 subsequent siblings)
7 siblings, 0 replies; 11+ messages in thread
From: Ludovic Courtès @ 2019-07-10 17:11 UTC (permalink / raw)
To: 36578
* gnu/packages/bootstrap.scm (raw-build): In 'derivation' call,
distinguish #:inputs from #:sources, passing a list of
<derivation-input> as #:inputs.
---
gnu/packages/bootstrap.scm | 7 ++++---
1 file changed, 4 insertions(+), 3 deletions(-)
diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index e8b2120551..5030b815b9 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -1,5 +1,5 @@
;;; 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>
;;; Copyright © 2014, 2015, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
;;;
@@ -29,7 +29,7 @@
#:use-module ((guix store)
#:select (run-with-store add-to-store add-text-to-store))
#:use-module ((guix derivations)
- #:select (derivation derivation->output-path))
+ #:select (derivation derivation-input derivation->output-path))
#:use-module ((guix utils) #:select (gnu-triplet->nix-system))
#:use-module (guix memoization)
#:use-module (srfi srfi-1)
@@ -312,7 +312,8 @@ $out/bin/guile --version~%"
(derivation store name
bash `(,builder)
#:system system
- #:inputs `((,bash) (,builder) (,guile))
+ #:inputs (list (derivation-input guile))
+ #:sources (list bash builder)
#:env-vars `(("GUILE_TARBALL"
. ,(derivation->output-path guile))))))
--
2.22.0
^ permalink raw reply related [flat|nested] 11+ messages in thread* [bug#36578] [PATCH 4/9] download: Use the new 'derivation' calling convention.
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 ` Ludovic Courtès
2019-07-10 17:11 ` [bug#36578] [PATCH 5/9] derivations: 'map-derivation' uses " Ludovic Courtès
` (4 subsequent siblings)
7 siblings, 0 replies; 11+ messages in thread
From: Ludovic Courtès @ 2019-07-10 17:11 UTC (permalink / raw)
To: 36578
* guix/download.scm (built-in-download): Pass MIRRORS and
CONTENT-ADDRESSED-MIRRORS as #:sources, not #:inputs.
---
guix/download.scm | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/guix/download.scm b/guix/download.scm
index fe680be4a2..b24aaa0a86 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -432,8 +432,7 @@ download by itself using its own dependencies."
#:system system
#:hash-algo hash-algo
#:hash hash
- #:inputs `((,mirrors)
- (,content-addressed-mirrors))
+ #:sources (list mirrors content-addressed-mirrors)
;; Honor the user's proxy and locale settings.
#:leaked-env-vars '("http_proxy" "https_proxy"
--
2.22.0
^ permalink raw reply related [flat|nested] 11+ messages in thread* [bug#36578] [PATCH 5/9] derivations: 'map-derivation' uses the new 'derivation' calling convention.
2019-07-10 17:11 ` [bug#36578] [PATCH 1/9] derivations: 'derivation' primitive accepts <derivation> and #:sources Ludovic Courtès
` (2 preceding siblings ...)
2019-07-10 17:11 ` [bug#36578] [PATCH 4/9] download: " Ludovic Courtès
@ 2019-07-10 17:11 ` Ludovic Courtès
2019-07-10 17:11 ` [bug#36578] [PATCH 6/9] derivations: Update tests to use new " Ludovic Courtès
` (3 subsequent siblings)
7 siblings, 0 replies; 11+ messages in thread
From: Ludovic Courtès @ 2019-07-10 17:11 UTC (permalink / raw)
To: 36578
* guix/derivations.scm (map-derivation)[input->output-paths]: Adjust to
deal with an argument that's either 'derivation-input?' or a string.
[rewritten-input]: Return a <derivation-input> or a string.
Pass #:inputs and #:sources to 'derivation'.
---
guix/derivations.scm | 22 ++++++++++------------
1 file changed, 10 insertions(+), 12 deletions(-)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index bd0af320c4..a18478502d 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -933,13 +933,10 @@ recursively."
(define input->output-paths
(match-lambda
- (((? derivation? drv))
- (list (derivation->output-path drv)))
- (((? derivation? drv) sub-drvs ...)
- (map (cut derivation->output-path drv <>)
- sub-drvs))
- ((file)
- (list file))))
+ ((? derivation-input? input)
+ (derivation-input-output-paths input))
+ ((? string? file)
+ (list file))))
(let ((mapping (fold (lambda (pair result)
(match pair
@@ -958,11 +955,11 @@ recursively."
(($ <derivation-input> drv (sub-drvs ...))
(match (vhash-assoc (derivation-file-name drv) mapping)
((_ . (? derivation? replacement))
- (cons replacement sub-drvs))
- ((_ . replacement)
- (list replacement))
+ (derivation-input replacement sub-drvs))
+ ((_ . (? string? source))
+ source)
(#f
- (cons (loop drv) sub-drvs)))))))
+ (derivation-input (loop drv) sub-drvs)))))))
(let loop ((drv drv))
(let* ((inputs (map (cut rewritten-input <> loop)
@@ -1001,7 +998,8 @@ recursively."
. ,(substitute value initial
replacements))))
(derivation-builder-environment-vars drv))
- #:inputs (append (map list sources) inputs)
+ #:inputs (filter derivation-input? inputs)
+ #:sources (append sources (filter string? inputs))
#:outputs (derivation-output-names drv)
#:hash (match (derivation-outputs drv)
((($ <derivation-output> _ algo hash))
--
2.22.0
^ permalink raw reply related [flat|nested] 11+ messages in thread* [bug#36578] [PATCH 6/9] derivations: Update tests to use new calling convention.
2019-07-10 17:11 ` [bug#36578] [PATCH 1/9] derivations: 'derivation' primitive accepts <derivation> and #:sources Ludovic Courtès
` (3 preceding siblings ...)
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
2019-07-10 17:11 ` [bug#36578] [PATCH 7/9] derivations: Deprecate the previous " Ludovic Courtès
` (2 subsequent siblings)
7 siblings, 0 replies; 11+ messages in thread
From: Ludovic Courtès @ 2019-07-10 17:11 UTC (permalink / raw)
To: 36578
* 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
^ permalink raw reply related [flat|nested] 11+ messages in thread* [bug#36578] [PATCH 7/9] derivations: Deprecate the previous calling convention.
2019-07-10 17:11 ` [bug#36578] [PATCH 1/9] derivations: 'derivation' primitive accepts <derivation> and #:sources Ludovic Courtès
` (4 preceding siblings ...)
2019-07-10 17:11 ` [bug#36578] [PATCH 6/9] derivations: Update tests to use new " Ludovic Courtès
@ 2019-07-10 17:11 ` 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
7 siblings, 0 replies; 11+ messages in thread
From: Ludovic Courtès @ 2019-07-10 17:11 UTC (permalink / raw)
To: 36578
We will eventually require #:inputs to be a list of <derivation-input>;
store items will have to be passed as #:sources, already interned.
* guix/derivations.scm (warn-about-derivation-deprecation): New procedure.
(derivation): Add #:%deprecation-warning? parameter.
[warn-deprecation]: New macro.
[input->derivation-input, input->source]: Use it.
(build-expression->derivation): Pass #:%deprecation-warning?.
* po/guix/POTFILES.in: Add guix/derivations.scm.
---
guix/derivations.scm | 27 +++++++++++++++++++++++++--
po/guix/POTFILES.in | 1 +
2 files changed, 26 insertions(+), 2 deletions(-)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index a18478502d..23d058e832 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -36,6 +36,8 @@
#:use-module (guix memoization)
#:use-module (guix combinators)
#:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
#:use-module (guix monads)
#:use-module (gcrypt hash)
#:use-module (guix base32)
@@ -705,6 +707,13 @@ name of each input with that input's hash."
;; character.
(sha256 (derivation->bytevector (derivation/masked-inputs drv)))))))
+
+(define (warn-about-derivation-deprecation name)
+ ;; TRANSLATORS: 'derivation' must not be translated; it refers to the
+ ;; 'derivation' procedure.
+ (warning (G_ "in '~a': deprecated 'derivation' calling convention used~%")
+ name))
+
(define* (derivation store name builder args
#:key
(system (%current-system)) (env-vars '())
@@ -715,7 +724,8 @@ name of each input with that input's hash."
allowed-references disallowed-references
leaked-env-vars local-build?
(substitutable? #t)
- (properties '()))
+ (properties '())
+ (%deprecation-warning? #t))
"Build a derivation with the given arguments, and return the resulting
<derivation> object. When HASH and HASH-ALGO are given, a
fixed-output derivation is created---i.e., one whose result is known in
@@ -832,19 +842,28 @@ derivation. It is kept as-is, uninterpreted, in the derivation."
e
outputs)))
+ (define-syntax-rule (warn-deprecation name)
+ (when %deprecation-warning?
+ (warn-about-derivation-deprecation name)))
+
(define input->derivation-input
(match-lambda
((? derivation-input? input)
input)
(((? derivation? drv))
+ (warn-deprecation name)
(make-derivation-input drv '("out")))
(((? derivation? drv) sub-drvs ...)
+ (warn-deprecation name)
(make-derivation-input drv sub-drvs))
- (_ #f)))
+ (_
+ (warn-deprecation name)
+ #f)))
(define input->source
(match-lambda
(((? string? input) . _)
+ (warn-deprecation name)
(if (direct-store-path? input)
input
(add-to-store store (basename input)
@@ -1320,6 +1339,10 @@ and PROPERTIES."
,@(if mod-dir `("-L" ,mod-dir) '())
,builder)
+ ;; 'build-expression->derivation' is somewhat deprecated so
+ ;; don't bother warning here.
+ #:%deprecation-warning? #f
+
#:system system
#:inputs `((,(or guile-for-build (%guile-for-build)))
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index f5fc4956b4..ad06ebce95 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -80,6 +80,7 @@ guix/channels.scm
guix/profiles.scm
guix/git.scm
guix/deprecation.scm
+guix/derivations.scm
gnu/build/bootloader.scm
nix/nix-daemon/guix-daemon.cc
--
2.22.0
^ permalink raw reply related [flat|nested] 11+ messages in thread* [bug#36578] [PATCH 8/9] gexp: 'lowered-gexp-guile' now returns a <derivation-input>.
2019-07-10 17:11 ` [bug#36578] [PATCH 1/9] derivations: 'derivation' primitive accepts <derivation> and #:sources Ludovic Courtès
` (5 preceding siblings ...)
2019-07-10 17:11 ` [bug#36578] [PATCH 7/9] derivations: Deprecate the previous " Ludovic Courtès
@ 2019-07-10 17:11 ` Ludovic Courtès
2019-07-10 17:11 ` [bug#36578] [PATCH 9/9] channels: Avoid use of 'derivation-input-path' Ludovic Courtès
7 siblings, 0 replies; 11+ messages in thread
From: Ludovic Courtès @ 2019-07-10 17:11 UTC (permalink / raw)
To: 36578
* guix/derivations.scm (derivation-input-output-path): New procedure.
* guix/gexp.scm (lower-gexp): Wrap GUILE in a <derivation-input>.
(gexp->derivation): Adjust accordingly.
* guix/remote.scm (remote-pipe-for-gexp, remote-eval): Adjust
accordingly.
* tests/gexp.scm ("lower-gexp"): Adjust accordingly.
---
guix/derivations.scm | 8 ++++++++
guix/gexp.scm | 8 ++++----
guix/remote.scm | 4 ++--
tests/gexp.scm | 3 ++-
4 files changed, 16 insertions(+), 7 deletions(-)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 23d058e832..92d50503ce 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -71,6 +71,7 @@
derivation-input-derivation
derivation-input-sub-derivations
derivation-input-output-paths
+ derivation-input-output-path
valid-derivation-input?
&derivation-error
@@ -221,6 +222,13 @@ download with a fixed hash (aka. `fetchurl')."
(map (cut derivation->output-path drv <>)
sub-drvs))))
+(define (derivation-input-output-path input)
+ "Return the output file name of INPUT. If INPUT has more than one outputs,
+an error is raised."
+ (match input
+ (($ <derivation-input> drv (output))
+ (derivation->output-path drv output))))
+
(define (valid-derivation-input? store input)
"Return true if INPUT is valid--i.e., if all the outputs it requests are in
the store."
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 52643bd684..eef308b000 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -648,7 +648,7 @@ names and file names suitable for the #:allowed-references argument to
(sexp lowered-gexp-sexp) ;sexp
(inputs lowered-gexp-inputs) ;list of <derivation-input>
(sources lowered-gexp-sources) ;list of store items
- (guile lowered-gexp-guile) ;<derivation> | #f
+ (guile lowered-gexp-guile) ;<derivation-input> | #f
(load-path lowered-gexp-load-path) ;list of store items
(load-compiled-path lowered-gexp-load-compiled-path)) ;list of store items
@@ -755,7 +755,7 @@ derivations--e.g., code evaluated for its side effects."
,@(map derivation-input exts)
,@(filter derivation-input? inputs))
(filter string? (cons modules inputs))
- guile
+ (derivation-input guile '("out"))
load-path
load-compiled-path)))))
@@ -889,7 +889,7 @@ The other arguments are as for 'derivation'."
(mbegin %store-monad
(set-grafting graft?) ;restore the initial setting
(raw-derivation name
- (string-append (derivation->output-path guile)
+ (string-append (derivation-input-output-path guile)
"/bin/guile")
`("--no-auto-compile"
,@(append-map (lambda (directory)
@@ -902,7 +902,7 @@ The other arguments are as for 'derivation'."
#:outputs outputs
#:env-vars env-vars
#:system system
- #:inputs `(,(derivation-input guile '("out"))
+ #:inputs `(,guile
,@(lowered-gexp-inputs lowered)
,@(match graphs
(((_ . inputs) ...)
diff --git a/guix/remote.scm b/guix/remote.scm
index 52ced16871..d49ee91b38 100644
--- a/guix/remote.scm
+++ b/guix/remote.scm
@@ -46,7 +46,7 @@
(compose object->string object->string))
(apply open-remote-pipe* session OPEN_READ
- (string-append (derivation->output-path
+ (string-append (derivation-input-output-path
(lowered-gexp-guile lowered))
"/bin/guile")
"--no-auto-compile"
@@ -95,7 +95,7 @@ remote store."
(remote -> (connect-to-remote-daemon session
socket-name)))
(define inputs
- (cons (derivation-input (lowered-gexp-guile lowered))
+ (cons (lowered-gexp-guile lowered)
(lowered-gexp-inputs lowered)))
(define sources
diff --git a/tests/gexp.scm b/tests/gexp.scm
index a1f79e3435..460afe7f59 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -868,7 +868,8 @@
"/lib/guile/2.0/site-ccache")
(lowered-gexp-load-compiled-path lexp))
(= 2 (length (lowered-gexp-load-compiled-path lexp)))
- (eq? (lowered-gexp-guile lexp) (%guile-for-build)))))))
+ (eq? (derivation-input-derivation (lowered-gexp-guile lexp))
+ (%guile-for-build)))))))
(test-assertm "gexp->derivation #:references-graphs"
(mlet* %store-monad
--
2.22.0
^ permalink raw reply related [flat|nested] 11+ messages in thread* [bug#36578] [PATCH 9/9] channels: Avoid use of 'derivation-input-path'.
2019-07-10 17:11 ` [bug#36578] [PATCH 1/9] derivations: 'derivation' primitive accepts <derivation> and #:sources Ludovic Courtès
` (6 preceding siblings ...)
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 ` Ludovic Courtès
7 siblings, 0 replies; 11+ messages in thread
From: Ludovic Courtès @ 2019-07-10 17:11 UTC (permalink / raw)
To: 36578
* guix/channels.scm (old-style-guix?): Use 'derivation-name' rather than
'derivation-input-path'.
---
guix/channels.scm | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/guix/channels.scm b/guix/channels.scm
index e6bb9b891b..a8c8f43276 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -424,8 +424,9 @@ derivation."
;; "old style" (before commit 8a0d9bc8a3f153159d9e239a151c0fa98f1e12d8,
;; dated May 30, 2018) did not depend on "guix-command.drv".
(not (find (lambda (input)
- (string-suffix? "-guix-command.drv"
- (derivation-input-path input)))
+ (string=? "guix-command"
+ (derivation-name
+ (derivation-input-derivation input))))
(derivation-inputs drv))))
(define (channel-instances->manifest instances)
--
2.22.0
^ permalink raw reply related [flat|nested] 11+ messages in thread