mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
gexp: Add 'ungexp-native' and 'ungexp-native-splicing'.
* guix/gexp.scm (<gexp>)[natives]: New field.
(write-gexp): Use both 'gexp-references' and
'gexp-native-references'.
(gexp->derivation): Use both 'gexp-inputs' and 'gexp-native-inputs',
and append them.
(gexp-inputs): Add 'references' parameter and honor it.
(gexp-native-inputs): New procedure.
(gexp->sexp)[reference->sexp]: Add 'native?' parameter and honor it.
Use it, and use 'gexp-native-references'.
(gexp)[collect-native-escapes]: New procedure.
[escape->ref]: Handle 'ungexp-native' and 'ungexp-native-splicing'.
[substitute-ungexp, substitute-ungexp-splicing]: New procedures.
[substitute-references]: Use them, and handle 'ungexp-native' and
'ungexp-native-splicing'.
Adjust generated 'make-gexp' call to provide both normal references
and native references.
[read-ungexp]: Support 'ungexp-native' and
'ungexp-native-splicing'.
Add reader extension for #+.
* tests/gexp.scm (gexp-native-inputs): New procedure.
(gexp->sexp*): Add 'target' parameter.
("ungexp + ungexp-native",
"input list + ungexp-native",
"input list splicing + ungexp-native-splicing",
"gexp->derivation, ungexp-native",
"gexp->derivation, ungexp + ungexp-native"): New tests.
("sugar"): Add tests for #+ and #+@.
* doc/guix.texi (G-Expressions): Document 'ungexp-native' et al.
This commit is contained in:
Ludovic Courtès
parent
68a61e9ffb
commit
667b250846
4 changed files with 246 additions and 50 deletions
|
|
@ -40,11 +40,12 @@
|
|||
(eval . (put 'mlet 'scheme-indent-function 2))
|
||||
(eval . (put 'run-with-store 'scheme-indent-function 1))
|
||||
|
||||
;; Recognize '~' and '$', as used for gexps, as quotation symbols. This
|
||||
;; notably allows '(' in Paredit to not insert a space when the preceding
|
||||
;; symbol is one of these.
|
||||
;; Recognize '~', '+', and '$', as used for gexps, as quotation symbols.
|
||||
;; This notably allows '(' in Paredit to not insert a space when the
|
||||
;; preceding symbol is one of these.
|
||||
(eval . (modify-syntax-entry ?~ "'"))
|
||||
(eval . (modify-syntax-entry ?$ "'"))))
|
||||
(eval . (modify-syntax-entry ?$ "'"))
|
||||
(eval . (modify-syntax-entry ?+ "'"))))
|
||||
(emacs-lisp-mode . ((indent-tabs-mode . nil)))
|
||||
(texinfo-mode . ((indent-tabs-mode . nil)
|
||||
(fill-column . 72))))
|
||||
|
|
|
|||
|
|
@ -2160,8 +2160,32 @@ substituted to the reference to the @var{coreutils} package in the
|
|||
actual build code, and @var{coreutils} is automatically made an input to
|
||||
the derivation. Likewise, @code{#$output} (equivalent to @code{(ungexp
|
||||
output)}) is replaced by a string containing the derivation's output
|
||||
directory name. The syntactic form to construct gexps is summarized
|
||||
below.
|
||||
directory name.
|
||||
|
||||
@cindex cross compilation
|
||||
In a cross-compilation context, it is useful to distinguish between
|
||||
references to the @emph{native} build of a package---that can run on the
|
||||
host---versus references to cross builds of a package. To that end, the
|
||||
@code{#+} plays the same role as @code{#$}, but is a reference to a
|
||||
native package build:
|
||||
|
||||
@example
|
||||
(gexp->derivation "vi"
|
||||
#~(begin
|
||||
(mkdir #$output)
|
||||
(system* (string-append #+coreutils "/bin/ln")
|
||||
"-s"
|
||||
(string-append #$emacs "/bin/emacs")
|
||||
(string-append #$output "/bin/vi")))
|
||||
#:target "mips64el-linux")
|
||||
@end example
|
||||
|
||||
@noindent
|
||||
In the example above, the native build of @var{coreutils} is used, so
|
||||
that @command{ln} can actually run on the host; but then the
|
||||
cross-compiled build of @var{emacs} is referenced.
|
||||
|
||||
The syntactic form to construct gexps is summarized below.
|
||||
|
||||
@deffn {Scheme Syntax} #~@var{exp}
|
||||
@deffnx {Scheme Syntax} (gexp @var{exp})
|
||||
|
|
@ -2190,6 +2214,13 @@ This is like the form above, but referring explicitly to the
|
|||
@var{package-or-derivation} produces multiple outputs (@pxref{Packages
|
||||
with Multiple Outputs}).
|
||||
|
||||
@item #+@var{obj}
|
||||
@itemx #+@var{obj}:output
|
||||
@itemx (ungexp-native @var{obj})
|
||||
@itemx (ungexp-native @var{obj} @var{output})
|
||||
Same as @code{ungexp}, but produces a reference to the @emph{native}
|
||||
build of @var{obj} when used in a cross compilation context.
|
||||
|
||||
@item #$output[:@var{output}]
|
||||
@itemx (ungexp output [@var{output}])
|
||||
Insert a reference to derivation output @var{output}, or to the main
|
||||
|
|
@ -2202,6 +2233,11 @@ This only makes sense for gexps passed to @code{gexp->derivation}.
|
|||
Like the above, but splices the contents of @var{lst} inside the
|
||||
containing list.
|
||||
|
||||
@item #+@@@var{lst}
|
||||
@itemx (ungexp-native-splicing @var{lst})
|
||||
Like the above, but refers to native builds of the objects listed in
|
||||
@var{lst}.
|
||||
|
||||
@end table
|
||||
|
||||
G-expressions created by @code{gexp} or @code{#~} are run-time objects
|
||||
|
|
|
|||
144
guix/gexp.scm
144
guix/gexp.scm
|
|
@ -41,7 +41,9 @@ (define-module (guix gexp)
|
|||
;;; S-expressions (sexps), with two differences:
|
||||
;;;
|
||||
;;; 1. References (un-quotations) to derivations or packages in a gexp are
|
||||
;;; replaced by the corresponding output file name;
|
||||
;;; replaced by the corresponding output file name; in addition, the
|
||||
;;; 'ungexp-native' unquote-like form allows code to explicitly refer to
|
||||
;;; the native code of a given package, in case of cross-compilation;
|
||||
;;;
|
||||
;;; 2. Gexps embed information about the derivations they refer to.
|
||||
;;;
|
||||
|
|
@ -52,9 +54,10 @@ (define-module (guix gexp)
|
|||
|
||||
;; "G expressions".
|
||||
(define-record-type <gexp>
|
||||
(make-gexp references proc)
|
||||
(make-gexp references natives proc)
|
||||
gexp?
|
||||
(references gexp-references) ; ((DRV-OR-PKG OUTPUT) ...)
|
||||
(natives gexp-native-references) ; ((DRV-OR-PKG OUTPUT) ...)
|
||||
(proc gexp-proc)) ; procedure
|
||||
|
||||
(define (write-gexp gexp port)
|
||||
|
|
@ -65,7 +68,10 @@ (define (write-gexp gexp port)
|
|||
;; doing things like (ungexp-splicing (gexp ())) because GEXP's procedure
|
||||
;; tries to use 'append' on that, which fails with wrong-type-arg.
|
||||
(false-if-exception
|
||||
(write (apply (gexp-proc gexp) (gexp-references gexp)) port))
|
||||
(write (apply (gexp-proc gexp)
|
||||
(append (gexp-references gexp)
|
||||
(gexp-native-references gexp)))
|
||||
port))
|
||||
(format port " ~a>"
|
||||
(number->string (object-address gexp) 16)))
|
||||
|
||||
|
|
@ -134,9 +140,13 @@ (define outputs (gexp-outputs exp))
|
|||
(target -> (if (eq? target 'current)
|
||||
(%current-target-system)
|
||||
target))
|
||||
(inputs (lower-inputs (gexp-inputs exp)
|
||||
(normals (lower-inputs (gexp-inputs exp)
|
||||
#:system system
|
||||
#:target target))
|
||||
(natives (lower-inputs (gexp-native-inputs exp)
|
||||
#:system system
|
||||
#:target #f))
|
||||
(inputs -> (append normals natives))
|
||||
(sexp (gexp->sexp exp
|
||||
#:system system
|
||||
#:target target))
|
||||
|
|
@ -177,8 +187,9 @@ (define outputs (gexp-outputs exp))
|
|||
#:references-graphs references-graphs
|
||||
#:local-build? local-build?)))
|
||||
|
||||
(define (gexp-inputs exp)
|
||||
"Return the input list for EXP."
|
||||
(define* (gexp-inputs exp #:optional (references gexp-references))
|
||||
"Return the input list for EXP, using REFERENCES to get its list of
|
||||
references."
|
||||
(define (add-reference-inputs ref result)
|
||||
(match ref
|
||||
(((? derivation?) (? string?))
|
||||
|
|
@ -188,7 +199,7 @@ (define (add-reference-inputs ref result)
|
|||
(((? origin?) (? string?))
|
||||
(cons ref result))
|
||||
((? gexp? exp)
|
||||
(append (gexp-inputs exp) result))
|
||||
(append (gexp-inputs exp references) result))
|
||||
(((? string? file))
|
||||
(if (direct-store-path? file)
|
||||
(cons ref result)
|
||||
|
|
@ -201,7 +212,10 @@ (define (add-reference-inputs ref result)
|
|||
|
||||
(fold-right add-reference-inputs
|
||||
'()
|
||||
(gexp-references exp)))
|
||||
(references exp)))
|
||||
|
||||
(define gexp-native-inputs
|
||||
(cut gexp-inputs <> gexp-native-references))
|
||||
|
||||
(define (gexp-outputs exp)
|
||||
"Return the outputs referred to by EXP as a list of strings."
|
||||
|
|
@ -223,7 +237,7 @@ (define* (gexp->sexp exp #:key
|
|||
(target (%current-target-system)))
|
||||
"Return (monadically) the sexp corresponding to EXP for the given OUTPUT,
|
||||
and in the current monad setting (system type, etc.)"
|
||||
(define (reference->sexp ref)
|
||||
(define* (reference->sexp ref #:optional native?)
|
||||
(with-monad %store-monad
|
||||
(match ref
|
||||
(((? derivation? drv) (? string? output))
|
||||
|
|
@ -232,7 +246,7 @@ (define (reference->sexp ref)
|
|||
(package-file p
|
||||
#:output output
|
||||
#:system system
|
||||
#:target target))
|
||||
#:target (if native? #f target)))
|
||||
(((? origin? o) (? string? output))
|
||||
(mlet %store-monad ((drv (origin->derivation o)))
|
||||
(return (derivation->output-path drv output))))
|
||||
|
|
@ -242,17 +256,22 @@ (define (reference->sexp ref)
|
|||
;; that trick.
|
||||
(return `((@ (guile) getenv) ,output)))
|
||||
((? gexp? exp)
|
||||
(gexp->sexp exp #:system system #:target target))
|
||||
(gexp->sexp exp
|
||||
#:system system
|
||||
#:target (if native? #f target)))
|
||||
(((? string? str))
|
||||
(return (if (direct-store-path? str) str ref)))
|
||||
((refs ...)
|
||||
(sequence %store-monad (map reference->sexp refs)))
|
||||
(sequence %store-monad
|
||||
(map (cut reference->sexp <> native?) refs)))
|
||||
(x
|
||||
(return x)))))
|
||||
|
||||
(mlet %store-monad
|
||||
((args (sequence %store-monad
|
||||
(map reference->sexp (gexp-references exp)))))
|
||||
(append (map reference->sexp (gexp-references exp))
|
||||
(map (cut reference->sexp <> #t)
|
||||
(gexp-native-references exp))))))
|
||||
(return (apply (gexp-proc exp) args))))
|
||||
|
||||
(define (canonicalize-reference ref)
|
||||
|
|
@ -309,9 +328,28 @@ (define (collect-escapes exp)
|
|||
(_
|
||||
result))))
|
||||
|
||||
(define (collect-native-escapes exp)
|
||||
;; Return all the 'ungexp-native' forms present in EXP.
|
||||
(let loop ((exp exp)
|
||||
(result '()))
|
||||
(syntax-case exp (ungexp-native ungexp-native-splicing)
|
||||
((ungexp-native _)
|
||||
(cons exp result))
|
||||
((ungexp-native _ _)
|
||||
(cons exp result))
|
||||
((ungexp-native-splicing _ ...)
|
||||
(cons exp result))
|
||||
((exp0 exp ...)
|
||||
(let ((result (loop #'exp0 result)))
|
||||
(fold loop result #'(exp ...))))
|
||||
(_
|
||||
result))))
|
||||
|
||||
(define (escape->ref exp)
|
||||
;; Turn 'ungexp' form EXP into a "reference".
|
||||
(syntax-case exp (ungexp ungexp-splicing output)
|
||||
(syntax-case exp (ungexp ungexp-splicing
|
||||
ungexp-native ungexp-native-splicing
|
||||
output)
|
||||
((ungexp output)
|
||||
#'(output-ref "out"))
|
||||
((ungexp output name)
|
||||
|
|
@ -321,30 +359,49 @@ (define (escape->ref exp)
|
|||
((ungexp drv-or-pkg out)
|
||||
#'(list drv-or-pkg out))
|
||||
((ungexp-splicing lst)
|
||||
#'lst)
|
||||
((ungexp-native thing)
|
||||
#'thing)
|
||||
((ungexp-native drv-or-pkg out)
|
||||
#'(list drv-or-pkg out))
|
||||
((ungexp-native-splicing lst)
|
||||
#'lst)))
|
||||
|
||||
(define (substitute-ungexp exp substs)
|
||||
;; Given EXP, an 'ungexp' or 'ungexp-native' form, substitute it with
|
||||
;; the corresponding form in SUBSTS.
|
||||
(match (assoc exp substs)
|
||||
((_ id)
|
||||
id)
|
||||
(_
|
||||
#'(syntax-error "error: no 'ungexp' substitution"
|
||||
#'ref))))
|
||||
|
||||
(define (substitute-ungexp-splicing exp substs)
|
||||
(syntax-case exp ()
|
||||
((exp rest ...)
|
||||
(match (assoc #'exp substs)
|
||||
((_ id)
|
||||
(with-syntax ((id id))
|
||||
#`(append id
|
||||
#,(substitute-references #'(rest ...) substs))))
|
||||
(_
|
||||
#'(syntax-error "error: no 'ungexp-splicing' substitution"
|
||||
#'ref))))))
|
||||
|
||||
(define (substitute-references exp substs)
|
||||
;; Return a variant of EXP where all the cars of SUBSTS have been
|
||||
;; replaced by the corresponding cdr.
|
||||
(syntax-case exp (ungexp ungexp-splicing)
|
||||
(syntax-case exp (ungexp ungexp-native
|
||||
ungexp-splicing ungexp-native-splicing)
|
||||
((ungexp _ ...)
|
||||
(match (assoc exp substs)
|
||||
((_ id)
|
||||
id)
|
||||
(_
|
||||
#'(syntax-error "error: no 'ungexp' substitution"
|
||||
#'ref))))
|
||||
(substitute-ungexp exp substs))
|
||||
((ungexp-native _ ...)
|
||||
(substitute-ungexp exp substs))
|
||||
(((ungexp-splicing _ ...) rest ...)
|
||||
(syntax-case exp ()
|
||||
((exp rest ...)
|
||||
(match (assoc #'exp substs)
|
||||
((_ id)
|
||||
(with-syntax ((id id))
|
||||
#`(append id
|
||||
#,(substitute-references #'(rest ...) substs))))
|
||||
(_
|
||||
#'(syntax-error "error: no 'ungexp-splicing' substitution"
|
||||
#'ref))))))
|
||||
(substitute-ungexp-splicing exp substs))
|
||||
(((ungexp-native-splicing _ ...) rest ...)
|
||||
(substitute-ungexp-splicing exp substs))
|
||||
((exp0 exp ...)
|
||||
#`(cons #,(substitute-references #'exp0 substs)
|
||||
#,(substitute-references #'(exp ...) substs)))
|
||||
|
|
@ -352,11 +409,15 @@ (define (substitute-references exp substs)
|
|||
|
||||
(syntax-case s (ungexp output)
|
||||
((_ exp)
|
||||
(let* ((escapes (delete-duplicates (collect-escapes #'exp)))
|
||||
(let* ((normals (delete-duplicates (collect-escapes #'exp)))
|
||||
(natives (delete-duplicates (collect-native-escapes #'exp)))
|
||||
(escapes (append normals natives))
|
||||
(formals (generate-temporaries escapes))
|
||||
(sexp (substitute-references #'exp (zip escapes formals)))
|
||||
(refs (map escape->ref escapes)))
|
||||
(refs (map escape->ref normals))
|
||||
(nrefs (map escape->ref natives)))
|
||||
#`(make-gexp (map canonicalize-reference (list #,@refs))
|
||||
(map canonicalize-reference (list #,@nrefs))
|
||||
(lambda #,formals
|
||||
#,sexp)))))))
|
||||
|
||||
|
|
@ -409,22 +470,26 @@ (define (gexp->file name exp)
|
|||
(write '(ungexp exp) port))))
|
||||
#:local-build? #t))
|
||||
|
||||
|
||||
|
||||
;;;
|
||||
;;; Syntactic sugar.
|
||||
;;;
|
||||
|
||||
(eval-when (expand load eval)
|
||||
(define (read-ungexp chr port)
|
||||
"Read an 'ungexp' or 'ungexp-splicing' form from PORT."
|
||||
(define* (read-ungexp chr port #:optional native?)
|
||||
"Read an 'ungexp' or 'ungexp-splicing' form from PORT. When NATIVE? is
|
||||
true, use 'ungexp-native' and 'ungexp-native-splicing' instead."
|
||||
(define unquote-symbol
|
||||
(match (peek-char port)
|
||||
(#\@
|
||||
(read-char port)
|
||||
'ungexp-splicing)
|
||||
(if native?
|
||||
'ungexp-native-splicing
|
||||
'ungexp-splicing))
|
||||
(_
|
||||
'ungexp)))
|
||||
(if native?
|
||||
'ungexp-native
|
||||
'ungexp))))
|
||||
|
||||
(match (read port)
|
||||
((? symbol? symbol)
|
||||
|
|
@ -445,6 +510,7 @@ (define (read-gexp chr port)
|
|||
|
||||
;; Extend the reader
|
||||
(read-hash-extend #\~ read-gexp)
|
||||
(read-hash-extend #\$ read-ungexp))
|
||||
(read-hash-extend #\$ read-ungexp)
|
||||
(read-hash-extend #\+ (cut read-ungexp <> <> #t)))
|
||||
|
||||
;;; gexp.scm ends here
|
||||
|
|
|
|||
103
tests/gexp.scm
103
tests/gexp.scm
|
|
@ -39,6 +39,7 @@ (define %store
|
|||
|
||||
;; For white-box testing.
|
||||
(define gexp-inputs (@@ (guix gexp) gexp-inputs))
|
||||
(define gexp-native-inputs (@@ (guix gexp) gexp-native-inputs))
|
||||
(define gexp->sexp (@@ (guix gexp) gexp->sexp))
|
||||
|
||||
(define guile-for-build
|
||||
|
|
@ -47,10 +48,8 @@ (define guile-for-build
|
|||
;; Make it the default.
|
||||
(%guile-for-build guile-for-build)
|
||||
|
||||
(define* (gexp->sexp* exp #:optional
|
||||
(system (%current-system)) target)
|
||||
(define* (gexp->sexp* exp #:optional target)
|
||||
(run-with-store %store (gexp->sexp exp
|
||||
#:system system
|
||||
#:target target)
|
||||
#:guile-for-build guile-for-build))
|
||||
|
||||
|
|
@ -137,6 +136,29 @@ (define (match-input thing)
|
|||
(e3 `(display ,txt)))
|
||||
(equal? `(begin ,e0 ,e1 ,e2 ,e3) (gexp->sexp* exp))))))
|
||||
|
||||
(test-assert "ungexp + ungexp-native"
|
||||
(let* ((exp (gexp (list (ungexp-native %bootstrap-guile)
|
||||
(ungexp coreutils)
|
||||
(ungexp-native glibc)
|
||||
(ungexp binutils))))
|
||||
(target "mips64el-linux")
|
||||
(guile (derivation->output-path
|
||||
(package-derivation %store %bootstrap-guile)))
|
||||
(cu (derivation->output-path
|
||||
(package-cross-derivation %store coreutils target)))
|
||||
(libc (derivation->output-path
|
||||
(package-derivation %store glibc)))
|
||||
(bu (derivation->output-path
|
||||
(package-cross-derivation %store binutils target))))
|
||||
(and (lset= equal?
|
||||
`((,%bootstrap-guile "out") (,glibc "out"))
|
||||
(gexp-native-inputs exp))
|
||||
(lset= equal?
|
||||
`((,coreutils "out") (,binutils "out"))
|
||||
(gexp-inputs exp))
|
||||
(equal? `(list ,guile ,cu ,libc ,bu)
|
||||
(gexp->sexp* exp target)))))
|
||||
|
||||
(test-assert "input list"
|
||||
(let ((exp (gexp (display
|
||||
'(ungexp (list %bootstrap-guile coreutils)))))
|
||||
|
|
@ -150,6 +172,28 @@ (define (match-input thing)
|
|||
(equal? `(display '(,guile ,cu))
|
||||
(gexp->sexp* exp)))))
|
||||
|
||||
(test-assert "input list + ungexp-native"
|
||||
(let* ((target "mips64el-linux")
|
||||
(exp (gexp (display
|
||||
(cons '(ungexp-native (list %bootstrap-guile coreutils))
|
||||
'(ungexp (list glibc binutils))))))
|
||||
(guile (derivation->output-path
|
||||
(package-derivation %store %bootstrap-guile)))
|
||||
(cu (derivation->output-path
|
||||
(package-derivation %store coreutils)))
|
||||
(xlibc (derivation->output-path
|
||||
(package-cross-derivation %store glibc target)))
|
||||
(xbu (derivation->output-path
|
||||
(package-cross-derivation %store binutils target))))
|
||||
(and (lset= equal?
|
||||
`((,%bootstrap-guile "out") (,coreutils "out"))
|
||||
(gexp-native-inputs exp))
|
||||
(lset= equal?
|
||||
`((,glibc "out") (,binutils "out"))
|
||||
(gexp-inputs exp))
|
||||
(equal? `(display (cons '(,guile ,cu) '(,xlibc ,xbu)))
|
||||
(gexp->sexp* exp target)))))
|
||||
|
||||
(test-assert "input list splicing"
|
||||
(let* ((inputs (list (list glibc "debug") %bootstrap-guile))
|
||||
(outputs (list (derivation->output-path
|
||||
|
|
@ -164,6 +208,16 @@ (define (match-input thing)
|
|||
(equal? (gexp->sexp* exp)
|
||||
`(list ,@(cons 5 outputs))))))
|
||||
|
||||
(test-assert "input list splicing + ungexp-native-splicing"
|
||||
(let* ((inputs (list (list glibc "debug") %bootstrap-guile))
|
||||
(exp (gexp (list (ungexp-native-splicing (cons (+ 2 3) inputs))))))
|
||||
(and (lset= equal?
|
||||
`((,glibc "debug") (,%bootstrap-guile "out"))
|
||||
(gexp-native-inputs exp))
|
||||
(null? (gexp-inputs exp))
|
||||
(equal? (gexp->sexp* exp) ;native
|
||||
(gexp->sexp* exp "mips64el-linux")))))
|
||||
|
||||
(test-assertm "gexp->file"
|
||||
(mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile))))
|
||||
(guile (package-file %bootstrap-guile))
|
||||
|
|
@ -240,6 +294,41 @@ (define (match-input thing)
|
|||
(return (and (member (derivation-file-name xcu) refs)
|
||||
(not (member (derivation-file-name cu) refs))))))
|
||||
|
||||
(test-assertm "gexp->derivation, ungexp-native"
|
||||
(mlet* %store-monad ((target -> "mips64el-linux")
|
||||
(exp -> (gexp (list (ungexp-native coreutils)
|
||||
(ungexp output))))
|
||||
(xdrv (gexp->derivation "foo" exp
|
||||
#:target target))
|
||||
(drv (gexp->derivation "foo" exp)))
|
||||
(return (string=? (derivation-file-name drv)
|
||||
(derivation-file-name xdrv)))))
|
||||
|
||||
(test-assertm "gexp->derivation, ungexp + ungexp-native"
|
||||
(mlet* %store-monad ((target -> "mips64el-linux")
|
||||
(exp -> (gexp (list (ungexp-native coreutils)
|
||||
(ungexp glibc)
|
||||
(ungexp output))))
|
||||
(xdrv (gexp->derivation "foo" exp
|
||||
#:target target))
|
||||
(refs ((store-lift references)
|
||||
(derivation-file-name xdrv)))
|
||||
(xglibc (package->cross-derivation glibc target))
|
||||
(cu (package->derivation coreutils)))
|
||||
(return (and (member (derivation-file-name cu) refs)
|
||||
(member (derivation-file-name xglibc) refs)))))
|
||||
|
||||
(test-assertm "gexp->derivation, ungexp-native + composed gexps"
|
||||
(mlet* %store-monad ((target -> "mips64el-linux")
|
||||
(exp0 -> (gexp (list 1 2
|
||||
(ungexp coreutils))))
|
||||
(exp -> (gexp (list 0 (ungexp-native exp0))))
|
||||
(xdrv (gexp->derivation "foo" exp
|
||||
#:target target))
|
||||
(drv (gexp->derivation "foo" exp)))
|
||||
(return (string=? (derivation-file-name drv)
|
||||
(derivation-file-name xdrv)))))
|
||||
|
||||
(define shebang
|
||||
(string-append "#!" (derivation->output-path guile-for-build)
|
||||
"/bin/guile --no-auto-compile"))
|
||||
|
|
@ -285,8 +374,12 @@ (define shebang
|
|||
(test-equal "sugar"
|
||||
'(gexp (foo (ungexp bar) (ungexp baz "out")
|
||||
(ungexp (chbouib 42))
|
||||
(ungexp-splicing (list x y z))))
|
||||
'#~(foo #$bar #$baz:out #$(chbouib 42) #$@(list x y z)))
|
||||
(ungexp-splicing (list x y z))
|
||||
(ungexp-native foo) (ungexp-native foo "out")
|
||||
(ungexp-native (chbouib 42))
|
||||
(ungexp-native-splicing (list x y z))))
|
||||
'#~(foo #$bar #$baz:out #$(chbouib 42) #$@(list x y z)
|
||||
#+foo #+foo:out #+(chbouib 42) #+@(list x y z)))
|
||||
|
||||
(test-end "gexp")
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue