mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
profiles: 'packages->manifest' now accepts inferior packages.
* guix/profiles.scm (packages->manifest)[inferiors-loaded?]: New variable. [inferior->entry]: New procedure. Accept inferior packages when INFERIORS-LOADED? is true. * tests/guix-package.sh: Add test using a manifest with an inferior. * tests/inferior.scm ("packages->manifest"): New test.
This commit is contained in:
parent
2e6d64e122
commit
811b21fb15
3 changed files with 49 additions and 4 deletions
|
@ -314,12 +314,31 @@ (define (packages->manifest packages)
|
|||
"Return a list of manifest entries, one for each item listed in PACKAGES.
|
||||
Elements of PACKAGES can be either package objects or package/string tuples
|
||||
denoting a specific output of a package."
|
||||
(define inferiors-loaded?
|
||||
;; This hack allows us to provide seamless integration for inferior
|
||||
;; packages while not having a hard dependency on (guix inferior).
|
||||
(resolve-module '(guix inferior) #f #f #:ensure #f))
|
||||
|
||||
(define (inferior->entry)
|
||||
(module-ref (resolve-interface '(guix inferior))
|
||||
'inferior-package->manifest-entry))
|
||||
|
||||
(manifest
|
||||
(map (match-lambda
|
||||
((package output)
|
||||
(package->manifest-entry package output))
|
||||
((? package? package)
|
||||
(package->manifest-entry package)))
|
||||
((package output)
|
||||
(package->manifest-entry package output))
|
||||
((? package? package)
|
||||
(package->manifest-entry package))
|
||||
((thing output)
|
||||
(if inferiors-loaded?
|
||||
((inferior->entry) thing output)
|
||||
(throw 'wrong-type-arg 'packages->manifest
|
||||
"Wrong package object: ~S" (list thing) (list thing))))
|
||||
(thing
|
||||
(if inferiors-loaded?
|
||||
((inferior->entry) thing)
|
||||
(throw 'wrong-type-arg 'packages->manifest
|
||||
"Wrong package object: ~S" (list thing) (list thing)))))
|
||||
packages)))
|
||||
|
||||
(define (manifest->gexp manifest)
|
||||
|
|
|
@ -358,6 +358,21 @@ EOF
|
|||
guix package --bootstrap -m "$module_dir/manifest.scm"
|
||||
guix package -I | grep guile
|
||||
test `guix package -I | wc -l` -eq 1
|
||||
guix package --rollback --bootstrap
|
||||
|
||||
# Applying a manifest file with inferior packages.
|
||||
cat > "$module_dir/manifest.scm"<<EOF
|
||||
(use-modules (guix inferior))
|
||||
|
||||
(define i
|
||||
(open-inferior "$abs_top_srcdir" #:command "scripts/guix"))
|
||||
|
||||
(let ((guile (car (lookup-inferior-packages i "guile-bootstrap"))))
|
||||
(packages->manifest (list guile)))
|
||||
EOF
|
||||
guix package --bootstrap -m "$module_dir/manifest.scm"
|
||||
guix package -I | grep guile
|
||||
test `guix package -I | wc -l` -eq 1
|
||||
|
||||
# Error reporting.
|
||||
cat > "$module_dir/manifest.scm"<<EOF
|
||||
|
|
|
@ -182,4 +182,15 @@ (define result
|
|||
(close-inferior inferior)
|
||||
(manifest-entry->list entry)))
|
||||
|
||||
(test-equal "packages->manifest"
|
||||
(map manifest-entry->list
|
||||
(manifest-entries (packages->manifest
|
||||
(find-best-packages-by-name "guile" #f))))
|
||||
(let* ((inferior (open-inferior %top-builddir
|
||||
#:command "scripts/guix"))
|
||||
(guile (first (lookup-inferior-packages inferior "guile")))
|
||||
(manifest (packages->manifest (list guile))))
|
||||
(close-inferior inferior)
|
||||
(map manifest-entry->list (manifest-entries manifest))))
|
||||
|
||||
(test-end "inferior")
|
||||
|
|
Loading…
Reference in a new issue