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:
Ludovic Courtès 2018-09-18 10:21:28 +02:00 committed by Ludovic Courtès
parent 2e6d64e122
commit 811b21fb15
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 49 additions and 4 deletions

View File

@ -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)

View File

@ -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

View File

@ -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")