diff --git a/doc/guix.texi b/doc/guix.texi index 917a3e9d57..c040a8531a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5060,7 +5060,7 @@ a derivation is the @code{derivation} procedure: [#:system (%current-system)] [#:references-graphs #f] @ [#:allowed-references #f] [#:disallowed-references #f] @ [#:leaked-env-vars #f] [#:local-build? #f] @ - [#:substitutable? #t] + [#:substitutable? #t] [#:properties '()] Build a derivation with the given arguments, and return the resulting @code{} 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 useful, for instance, when building packages that capture details of the 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 @noindent @@ -5790,7 +5793,8 @@ information about monads.) [#:leaked-env-vars #f] @ [#:script-name (string-append @var{name} "-builder")] @ [#: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 @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, diff --git a/guix/derivations.scm b/guix/derivations.scm index 7afecb10cc..f6176a78fd 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -80,6 +80,7 @@ (define-module (guix derivations) substitutable-derivation? substitution-oracle derivation-hash + derivation-properties read-derivation read-derivation-from-file @@ -681,7 +682,8 @@ (define* (derivation store name builder args references-graphs allowed-references disallowed-references leaked-env-vars local-build? - (substitutable? #t)) + (substitutable? #t) + (properties '())) "Build a derivation with the given arguments, and return the resulting object. When HASH and HASH-ALGO are given, a 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. 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) ;; Return DRV with an actual store path for each of its output and the ;; corresponding environment variable. @@ -763,6 +768,10 @@ (define (user+system-env-vars) `(("impureEnvVars" . ,(string-join leaked-env-vars))) '()) + ,@(match properties + (() '()) + (lst `(("guix properties" + . ,(object->string properties))))) ,@env-vars))) (match references-graphs (((file . path) ...) @@ -851,6 +860,14 @@ (define (invalidate-derivation-caches!) (invalidate-memoization! derivation-path->base16-hash) (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 #:key (system (%current-system))) "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 allowed-references disallowed-references - local-build? (substitutable? #t)) + local-build? (substitutable? #t) + (properties '())) "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) 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. 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 (or guile-for-build (%guile-for-build))) @@ -1277,7 +1296,8 @@ (define %build-inputs #:allowed-references allowed-references #:disallowed-references disallowed-references #:local-build? local-build? - #:substitutable? substitutable?))) + #:substitutable? substitutable? + #:properties properties))) ;;; diff --git a/guix/gexp.scm b/guix/gexp.scm index f33fb198e4..786e378308 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -631,6 +631,7 @@ (define* (gexp->derivation name exp allowed-references disallowed-references leaked-env-vars local-build? (substitutable? #t) + (properties '()) ;; TODO: This parameter is transitional; it's here ;; to avoid a full rebuild. Remove it on the next @@ -800,7 +801,8 @@ (define (extension-flags extension) #:disallowed-references disallowed #:leaked-env-vars leaked-env-vars #:local-build? local-build? - #:substitutable? substitutable?)))) + #:substitutable? substitutable? + #:properties properties)))) (define* (gexp-inputs exp #:key native?) "Return the input list for EXP. When NATIVE? is true, return only native diff --git a/tests/derivations.scm b/tests/derivations.scm index 159a6971b3..5f294c1827 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -1132,6 +1132,16 @@ (define (deps path . deps) ((p2 . _) (stringderivation %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" "hello" (let* ((joke (package-derivation %store guile-1.8)) diff --git a/tests/gexp.scm b/tests/gexp.scm index ab60bdab68..7ae9201c81 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -476,7 +476,15 @@ (define guile ,guile) (return (and (string=? (readlink (string-append out "/foo")) guile) (string=? (readlink out2) file) (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" (mlet* %store-monad ((graft? (set-grafting #f))