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
|
@ -314,12 +314,31 @@ file name."
|
||||||
"Return a list of manifest entries, one for each item listed in 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
|
Elements of PACKAGES can be either package objects or package/string tuples
|
||||||
denoting a specific output of a package."
|
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
|
(manifest
|
||||||
(map (match-lambda
|
(map (match-lambda
|
||||||
((package output)
|
((package output)
|
||||||
(package->manifest-entry package output))
|
(package->manifest-entry package output))
|
||||||
((? package? package)
|
((? package? package)
|
||||||
(package->manifest-entry 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)))
|
packages)))
|
||||||
|
|
||||||
(define (manifest->gexp manifest)
|
(define (manifest->gexp manifest)
|
||||||
|
|
|
@ -358,6 +358,21 @@ EOF
|
||||||
guix package --bootstrap -m "$module_dir/manifest.scm"
|
guix package --bootstrap -m "$module_dir/manifest.scm"
|
||||||
guix package -I | grep guile
|
guix package -I | grep guile
|
||||||
test `guix package -I | wc -l` -eq 1
|
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.
|
# Error reporting.
|
||||||
cat > "$module_dir/manifest.scm"<<EOF
|
cat > "$module_dir/manifest.scm"<<EOF
|
||||||
|
|
|
@ -182,4 +182,15 @@
|
||||||
(close-inferior inferior)
|
(close-inferior inferior)
|
||||||
(manifest-entry->list entry)))
|
(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")
|
(test-end "inferior")
|
||||||
|
|
Loading…
Reference in New Issue