From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:42331) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1g2Enf-0007CC-Ic for guix-patches@gnu.org; Tue, 18 Sep 2018 08:08:17 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1g2EnZ-00067o-K6 for guix-patches@gnu.org; Tue, 18 Sep 2018 08:08:15 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:39490) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1g2EnV-00064H-JQ for guix-patches@gnu.org; Tue, 18 Sep 2018 08:08:05 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1g2EnV-0007tm-Bc for guix-patches@gnu.org; Tue, 18 Sep 2018 08:08:05 -0400 Subject: [bug#32759] [PATCH 5/8] inferior: Add 'inferior-package->manifest-entry'. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Tue, 18 Sep 2018 14:06:37 +0200 Message-Id: <20180918120640.27863-5-ludo@gnu.org> In-Reply-To: <20180918120640.27863-1-ludo@gnu.org> References: <20180918120640.27863-1-ludo@gnu.org> List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 32759@debbugs.gnu.org * guix/inferior.scm (inferior-package->manifest-entry): New procedure. * tests/inferior.scm (manifest-entry->list): New procedure. ("inferior-package->manifest-entry"): New test. --- guix/inferior.scm | 42 ++++++++++++++++++++++++++++++++++++++---- tests/inferior.scm | 18 ++++++++++++++++++ 2 files changed, 56 insertions(+), 4 deletions(-) diff --git a/guix/inferior.scm b/guix/inferior.scm index 3fa493009..c86fdd3ec 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -33,6 +33,7 @@ #:select (read-derivation-from-file)) #:use-module (guix gexp) #:use-module (guix search-paths) + #:use-module (guix profiles) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) @@ -45,12 +46,12 @@ inferior-eval inferior-object? + inferior-packages + lookup-inferior-packages + inferior-package? inferior-package-name inferior-package-version - - inferior-packages - lookup-inferior-packages inferior-package-synopsis inferior-package-description inferior-package-home-page @@ -62,7 +63,9 @@ inferior-package-native-search-paths inferior-package-transitive-native-search-paths inferior-package-search-paths - inferior-package-derivation)) + inferior-package-derivation + + inferior-package->manifest-entry)) ;;; Commentary: ;;; @@ -441,3 +444,34 @@ PACKAGE must be live." target) ;; Compile PACKAGE for SYSTEM, optionally cross-building for TARGET. (inferior-package->derivation package system #:target target)) + + +;;; +;;; Manifest entries. +;;; + +(define* (inferior-package->manifest-entry package + #:optional (output "out") + #:key (parent (delay #f)) + (properties '())) + "Return a manifest entry for the OUTPUT of package PACKAGE." + ;; For each dependency, keep a promise pointing to its "parent" entry. + (letrec* ((deps (map (match-lambda + ((label package) + (inferior-package->manifest-entry package + #:parent (delay entry))) + ((label package output) + (inferior-package->manifest-entry package output + #:parent (delay entry)))) + (inferior-package-propagated-inputs package))) + (entry (manifest-entry + (name (inferior-package-name package)) + (version (inferior-package-version package)) + (output output) + (item package) + (dependencies (delete-duplicates deps)) + (search-paths + (inferior-package-transitive-native-search-paths package)) + (parent parent) + (properties properties)))) + entry)) diff --git a/tests/inferior.scm b/tests/inferior.scm index 99d736bd4..6f6abd28a 100644 --- a/tests/inferior.scm +++ b/tests/inferior.scm @@ -21,6 +21,7 @@ #:use-module (guix inferior) #:use-module (guix packages) #:use-module (guix store) + #:use-module (guix profiles) #:use-module (guix derivations) #:use-module (gnu packages) #:use-module (gnu packages bootstrap) @@ -38,6 +39,13 @@ (define %store (open-connection-for-tests)) +(define (manifest-entry->list entry) + (list (manifest-entry-name entry) + (manifest-entry-version entry) + (manifest-entry-output entry) + (manifest-entry-search-paths entry) + (map manifest-entry->list (manifest-entry-dependencies entry)))) + (test-begin "inferior") @@ -164,4 +172,14 @@ (list (inferior-package-derivation %store guile "x86_64-linux") (inferior-package-derivation %store guile "armhf-linux"))))) +(test-equal "inferior-package->manifest-entry" + (manifest-entry->list (package->manifest-entry + (first (find-best-packages-by-name "guile" #f)))) + (let* ((inferior (open-inferior %top-builddir + #:command "scripts/guix")) + (guile (first (lookup-inferior-packages inferior "guile"))) + (entry (inferior-package->manifest-entry guile))) + (close-inferior inferior) + (manifest-entry->list entry))) + (test-end "inferior") -- 2.18.0