[bug#32759] [PATCH 6/8] profiles: 'packages->manifest' now accepts inferior packages.

[Ludovic Courtès]

From: Ludovic Courtès <address@hidden>

* 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.
---
 guix/profiles.scm     | 27 +++++++++++++++++++++++----
 tests/guix-package.sh | 15 +++++++++++++++
 tests/inferior.scm    | 11 +++++++++++
 3 files changed, 49 insertions(+), 4 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 8acfcff8c..669ebe04e 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -314,12 +314,31 @@ file name."
   "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)
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index cef3b3452..f7dfbfad0 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -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
diff --git a/tests/inferior.scm b/tests/inferior.scm
index 6f6abd28a..d1d5c00a7 100644
--- a/tests/inferior.scm
+++ b/tests/inferior.scm
@@ -182,4 +182,15 @@
     (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")
-- 
2.18.0