derivations: Add properties.

* guix/derivations.scm (derivation): Add #:properties parameter.
[user+system-env-vars]: Honor it.
(derivation-properties): New procedure.
(build-expression->derivation): Add #:properties and pass it to
'derivation'.
* guix/gexp.scm (gexp->derivation): Likewise.
* tests/derivations.scm ("derivation-properties"): New test.
* tests/gexp.scm ("gexp->derivation properties"): New test.
* doc/guix.texi (Derivations, G-Expressions): Adjust accordingly.
This commit is contained in:
Ludovic Courtès 2018-11-26 22:14:11 +01:00
parent 01e7ca5410
commit 8856f409d1
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
5 changed files with 53 additions and 9 deletions

View file

@ -5060,7 +5060,7 @@ a derivation is the @code{derivation} procedure:
[#:system (%current-system)] [#:references-graphs #f] @ [#:system (%current-system)] [#:references-graphs #f] @
[#:allowed-references #f] [#:disallowed-references #f] @ [#:allowed-references #f] [#:disallowed-references #f] @
[#:leaked-env-vars #f] [#:local-build? #f] @ [#:leaked-env-vars #f] [#:local-build? #f] @
[#:substitutable? #t] [#:substitutable? #t] [#:properties '()]
Build a derivation with the given arguments, and return the resulting Build a derivation with the given arguments, and return the resulting
@code{<derivation>} object. @code{<derivation>} object.
@ -5097,6 +5097,9 @@ When @var{substitutable?} is false, declare that substitutes of the
derivation's output should not be used (@pxref{Substitutes}). This is derivation's output should not be used (@pxref{Substitutes}). This is
useful, for instance, when building packages that capture details of the useful, for instance, when building packages that capture details of the
host CPU instruction set. host CPU instruction set.
@var{properties} must be an association list describing ``properties'' of the
derivation. It is kept as-is, uninterpreted, in the derivation.
@end deffn @end deffn
@noindent @noindent
@ -5790,7 +5793,8 @@ information about monads.)
[#:leaked-env-vars #f] @ [#:leaked-env-vars #f] @
[#:script-name (string-append @var{name} "-builder")] @ [#:script-name (string-append @var{name} "-builder")] @
[#:deprecation-warnings #f] @ [#:deprecation-warnings #f] @
[#:local-build? #f] [#:substitutable? #t] [#:guile-for-build #f] [#:local-build? #f] [#:substitutable? #t] @
[#:properties '()] [#:guile-for-build #f]
Return a derivation @var{name} that runs @var{exp} (a gexp) with Return a derivation @var{name} that runs @var{exp} (a gexp) with
@var{guile-for-build} (a derivation) on @var{system}; @var{exp} is @var{guile-for-build} (a derivation) on @var{system}; @var{exp} is
stored in a file called @var{script-name}. When @var{target} is true, stored in a file called @var{script-name}. When @var{target} is true,

View file

@ -80,6 +80,7 @@ (define-module (guix derivations)
substitutable-derivation? substitutable-derivation?
substitution-oracle substitution-oracle
derivation-hash derivation-hash
derivation-properties
read-derivation read-derivation
read-derivation-from-file read-derivation-from-file
@ -681,7 +682,8 @@ (define* (derivation store name builder args
references-graphs references-graphs
allowed-references disallowed-references allowed-references disallowed-references
leaked-env-vars local-build? leaked-env-vars local-build?
(substitutable? #t)) (substitutable? #t)
(properties '()))
"Build a derivation with the given arguments, and return the resulting "Build a derivation with the given arguments, and return the resulting
<derivation> object. When HASH and HASH-ALGO are given, a <derivation> object. When HASH and HASH-ALGO are given, a
fixed-output derivation is created---i.e., one whose result is known in fixed-output derivation is created---i.e., one whose result is known in
@ -708,7 +710,10 @@ (define* (derivation store name builder args
derivations where the costs of data transfers would outweigh the benefits. derivations where the costs of data transfers would outweigh the benefits.
When SUBSTITUTABLE? is false, declare that substitutes of the derivation's When SUBSTITUTABLE? is false, declare that substitutes of the derivation's
output should not be used." output should not be used.
PROPERTIES must be an association list describing \"properties\" of the
derivation. It is kept as-is, uninterpreted, in the derivation."
(define (add-output-paths drv) (define (add-output-paths drv)
;; Return DRV with an actual store path for each of its output and the ;; Return DRV with an actual store path for each of its output and the
;; corresponding environment variable. ;; corresponding environment variable.
@ -763,6 +768,10 @@ (define (user+system-env-vars)
`(("impureEnvVars" `(("impureEnvVars"
. ,(string-join leaked-env-vars))) . ,(string-join leaked-env-vars)))
'()) '())
,@(match properties
(() '())
(lst `(("guix properties"
. ,(object->string properties)))))
,@env-vars))) ,@env-vars)))
(match references-graphs (match references-graphs
(((file . path) ...) (((file . path) ...)
@ -851,6 +860,14 @@ (define (invalidate-derivation-caches!)
(invalidate-memoization! derivation-path->base16-hash) (invalidate-memoization! derivation-path->base16-hash)
(hash-clear! %derivation-cache)) (hash-clear! %derivation-cache))
(define derivation-properties
(mlambdaq (drv)
"Return the property alist associated with DRV."
(match (assoc "guix properties"
(derivation-builder-environment-vars drv))
((_ . str) (call-with-input-string str read))
(#f '()))))
(define* (map-derivation store drv mapping (define* (map-derivation store drv mapping
#:key (system (%current-system))) #:key (system (%current-system)))
"Given MAPPING, a list of pairs of derivations, return a derivation based on "Given MAPPING, a list of pairs of derivations, return a derivation based on
@ -1129,7 +1146,8 @@ (define* (build-expression->derivation store name exp ;deprecated
references-graphs references-graphs
allowed-references allowed-references
disallowed-references disallowed-references
local-build? (substitutable? #t)) local-build? (substitutable? #t)
(properties '()))
"Return a derivation that executes Scheme expression EXP as a builder "Return a derivation that executes Scheme expression EXP as a builder
for derivation NAME. INPUTS must be a list of (NAME DRV-PATH SUB-DRV) for derivation NAME. INPUTS must be a list of (NAME DRV-PATH SUB-DRV)
tuples; when SUB-DRV is omitted, \"out\" is assumed. MODULES is a list tuples; when SUB-DRV is omitted, \"out\" is assumed. MODULES is a list
@ -1149,7 +1167,8 @@ (define* (build-expression->derivation store name exp ;deprecated
omitted or is #f, the value of the `%guile-for-build' fluid is used instead. omitted or is #f, the value of the `%guile-for-build' fluid is used instead.
See the `derivation' procedure for the meaning of REFERENCES-GRAPHS, See the `derivation' procedure for the meaning of REFERENCES-GRAPHS,
ALLOWED-REFERENCES, DISALLOWED-REFERENCES, LOCAL-BUILD?, and SUBSTITUTABLE?." ALLOWED-REFERENCES, DISALLOWED-REFERENCES, LOCAL-BUILD?, SUBSTITUTABLE?,
and PROPERTIES."
(define guile-drv (define guile-drv
(or guile-for-build (%guile-for-build))) (or guile-for-build (%guile-for-build)))
@ -1277,7 +1296,8 @@ (define %build-inputs
#:allowed-references allowed-references #:allowed-references allowed-references
#:disallowed-references disallowed-references #:disallowed-references disallowed-references
#:local-build? local-build? #:local-build? local-build?
#:substitutable? substitutable?))) #:substitutable? substitutable?
#:properties properties)))
;;; ;;;

View file

@ -631,6 +631,7 @@ (define* (gexp->derivation name exp
allowed-references disallowed-references allowed-references disallowed-references
leaked-env-vars leaked-env-vars
local-build? (substitutable? #t) local-build? (substitutable? #t)
(properties '())
;; TODO: This parameter is transitional; it's here ;; TODO: This parameter is transitional; it's here
;; to avoid a full rebuild. Remove it on the next ;; to avoid a full rebuild. Remove it on the next
@ -800,7 +801,8 @@ (define (extension-flags extension)
#:disallowed-references disallowed #:disallowed-references disallowed
#:leaked-env-vars leaked-env-vars #:leaked-env-vars leaked-env-vars
#:local-build? local-build? #:local-build? local-build?
#:substitutable? substitutable?)))) #:substitutable? substitutable?
#:properties properties))))
(define* (gexp-inputs exp #:key native?) (define* (gexp-inputs exp #:key native?)
"Return the input list for EXP. When NATIVE? is true, return only native "Return the input list for EXP. When NATIVE? is true, return only native

View file

@ -1132,6 +1132,16 @@ (define (deps path . deps)
((p2 . _) ((p2 . _)
(string<? p1 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" (test-equal "map-derivation"
"hello" "hello"
(let* ((joke (package-derivation %store guile-1.8)) (let* ((joke (package-derivation %store guile-1.8))

View file

@ -476,7 +476,15 @@ (define guile ,guile)
(return (and (string=? (readlink (string-append out "/foo")) guile) (return (and (string=? (readlink (string-append out "/foo")) guile)
(string=? (readlink out2) file) (string=? (readlink out2) file)
(equal? refs (list (dirname (dirname guile)))) (equal? refs (list (dirname (dirname guile))))
(equal? refs2 (list file)))))) (equal? refs2 (list file))
(null? (derivation-properties drv))))))
(test-assertm "gexp->derivation properties"
(mlet %store-monad ((drv (gexp->derivation "foo"
#~(mkdir #$output)
#:properties '((type . test)))))
(return (equal? '((type . test))
(derivation-properties drv)))))
(test-assertm "gexp->derivation vs. grafts" (test-assertm "gexp->derivation vs. grafts"
(mlet* %store-monad ((graft? (set-grafting #f)) (mlet* %store-monad ((graft? (set-grafting #f))