mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 13:28:12 -05:00
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:
parent
01e7ca5410
commit
8856f409d1
5 changed files with 53 additions and 9 deletions
|
@ -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,
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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))
|
||||||
|
|
Loading…
Reference in a new issue