mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 05:48:07 -05:00
gexp: Add support for 'origin?' objects in 'ungexp' forms.
* guix/gexp.scm (lower-inputs, gexp-inputs, gexp->sexp, canonicalize-reference): Add 'origin?' case. * guix/monads.scm (origin->derivation): New procedure. * tests/gexp.scm ("one input origin"): New test.
This commit is contained in:
parent
696893801c
commit
79c0c8cdf7
3 changed files with 28 additions and 2 deletions
|
@ -85,6 +85,9 @@ (define (lower-inputs inputs)
|
|||
(((? package? package) sub-drv ...)
|
||||
(mlet %store-monad ((drv (package->derivation package)))
|
||||
(return `(,drv ,@sub-drv))))
|
||||
(((? origin? origin) sub-drv ...)
|
||||
(mlet %store-monad ((drv (origin->derivation origin)))
|
||||
(return `(,drv ,@sub-drv))))
|
||||
(input
|
||||
(return input)))
|
||||
inputs))))
|
||||
|
@ -158,6 +161,8 @@ (define (add-reference-inputs ref result)
|
|||
(cons ref result))
|
||||
(((? package?) (? string?))
|
||||
(cons ref result))
|
||||
(((? origin?) (? string?))
|
||||
(cons ref result))
|
||||
((? gexp? exp)
|
||||
(append (gexp-inputs exp) result))
|
||||
(((? string? file))
|
||||
|
@ -199,6 +204,9 @@ (define (reference->sexp ref)
|
|||
(return (derivation->output-path drv output)))
|
||||
(((? package? p) (? string? output))
|
||||
(package-file p #:output output))
|
||||
(((? origin? o) (? string? output))
|
||||
(mlet %store-monad ((drv (origin->derivation o)))
|
||||
(return (derivation->output-path drv output))))
|
||||
(($ <output-ref> output)
|
||||
;; Output file names are not known in advance but the daemon defines
|
||||
;; an environment variable for each of them at build time, so use
|
||||
|
@ -224,10 +232,14 @@ (define (canonicalize-reference ref)
|
|||
(match ref
|
||||
((? package? p)
|
||||
`(,p "out"))
|
||||
((? origin? o)
|
||||
`(,o "out"))
|
||||
((? derivation? d)
|
||||
`(,d "out"))
|
||||
(((? package?) (? string?))
|
||||
ref)
|
||||
(((? origin?) (? string?))
|
||||
ref)
|
||||
(((? derivation?) (? string?))
|
||||
ref)
|
||||
((? string? s)
|
||||
|
|
|
@ -56,6 +56,7 @@ (define-module (guix monads)
|
|||
text-file
|
||||
text-file*
|
||||
package-file
|
||||
origin->derivation
|
||||
package->derivation
|
||||
built-derivations)
|
||||
#:replace (imported-modules
|
||||
|
@ -395,6 +396,9 @@ (define derivation-expression
|
|||
(define package->derivation
|
||||
(store-lift package-derivation))
|
||||
|
||||
(define origin->derivation
|
||||
(store-lift package-source-derivation))
|
||||
|
||||
(define imported-modules
|
||||
(store-lift (@ (guix derivations) imported-modules)))
|
||||
|
||||
|
|
|
@ -21,8 +21,7 @@ (define-module (test-gexp)
|
|||
#:use-module (guix monads)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module ((guix packages)
|
||||
#:select (package-derivation %current-system))
|
||||
#:use-module (guix packages)
|
||||
#:use-module (gnu packages)
|
||||
#:use-module (gnu packages base)
|
||||
#:use-module (gnu packages bootstrap)
|
||||
|
@ -83,6 +82,17 @@ (define-syntax-rule (test-assertm name exp)
|
|||
(package-derivation %store coreutils)))
|
||||
(gexp->sexp* exp)))))
|
||||
|
||||
(test-assert "one input origin"
|
||||
(let ((exp (gexp (display (ungexp (package-source coreutils))))))
|
||||
(and (gexp? exp)
|
||||
(match (gexp-inputs exp)
|
||||
(((o "out"))
|
||||
(eq? o (package-source coreutils))))
|
||||
(equal? `(display ,(derivation->output-path
|
||||
(package-source-derivation
|
||||
%store (package-source coreutils))))
|
||||
(gexp->sexp* exp)))))
|
||||
|
||||
(test-assert "same input twice"
|
||||
(let ((exp (gexp (begin
|
||||
(display (ungexp coreutils))
|
||||
|
|
Loading…
Reference in a new issue