From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:42234) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1g2End-0007Bc-2A for guix-patches@gnu.org; Tue, 18 Sep 2018 08:08:14 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1g2EnZ-00067q-JX for guix-patches@gnu.org; Tue, 18 Sep 2018 08:08:12 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:39485) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1g2EnT-00060g-6H 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 1g2EnS-0007tB-VC for guix-patches@gnu.org; Tue, 18 Sep 2018 08:08:02 -0400 Subject: [bug#32759] [PATCH 3/8] inferior: Add 'inferior-package-inputs' & co. Resent-Message-ID: From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Tue, 18 Sep 2018 14:06:35 +0200 Message-Id: <20180918120640.27863-3-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 (open-inferior): Use (ice-9 match). (inferior-package-input-field, inferior-package-inputs): (inferior-package-native-inputs) (inferior-package-propagated-inputs) (inferior-package-transitive-propagated-inputs): New procedures. * tests/inferior.scm ("inferior-package-inputs"): New test. inputs fixlet --- guix/inferior.scm | 51 ++++++++++++++++++++++++++++++++++++++++++++++ tests/inferior.scm | 34 ++++++++++++++++++++++++++++++- 2 files changed, 84 insertions(+), 1 deletion(-) diff --git a/guix/inferior.scm b/guix/inferior.scm index 81b71d0c7..ca819c6ef 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -33,6 +33,7 @@ #:select (read-derivation-from-file)) #:use-module (guix gexp) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:use-module (ice-9 popen) #:use-module (ice-9 vlist) @@ -53,6 +54,10 @@ inferior-package-description inferior-package-home-page inferior-package-location + inferior-package-inputs + inferior-package-native-inputs + inferior-package-propagated-inputs + inferior-package-transitive-propagated-inputs inferior-package-derivation)) ;;; Commentary: @@ -120,6 +125,7 @@ equivalent. Return #f if the inferior could not be launched." (delay (%inferior-package-table result))))) (inferior-eval '(use-modules (guix)) result) (inferior-eval '(use-modules (gnu)) result) + (inferior-eval '(use-modules (ice-9 match)) result) (inferior-eval '(define %package-table (make-hash-table)) result) result)) @@ -271,6 +277,51 @@ record." loc))) package-location)))) +(define (inferior-package-input-field package field) + "Return the input field FIELD (e.g., 'native-inputs') of PACKAGE, an +inferior package." + (define field* + `(compose (lambda (inputs) + (map (match-lambda + ;; XXX: Origins are not handled. + ((label (? package? package) rest ...) + (let ((id (object-address package))) + (hashv-set! %package-table id package) + `(,label (package ,id + ,(package-name package) + ,(package-version package)) + ,@rest))) + (x + x)) + inputs)) + ,field)) + + (define inputs + (inferior-package-field package field*)) + + (define inferior + (inferior-package-inferior package)) + + (map (match-lambda + ((label ('package id name version) . rest) + ;; XXX: eq?-ness of inferior packages is not preserved here. + `(,label ,(inferior-package inferior name version id) + ,@rest)) + (x x)) + inputs)) + +(define inferior-package-inputs + (cut inferior-package-input-field <> 'package-inputs)) + +(define inferior-package-native-inputs + (cut inferior-package-input-field <> 'package-native-inputs)) + +(define inferior-package-propagated-inputs + (cut inferior-package-input-field <> 'package-propagated-inputs)) + +(define inferior-package-transitive-propagated-inputs + (cut inferior-package-input-field <> 'package-transitive-propagated-inputs)) + (define (proxy client backend) ;adapted from (guix ssh) "Proxy communication between CLIENT and BACKEND until CLIENT closes the connection, at which point CLIENT is closed (both CLIENT and BACKEND must be diff --git a/tests/inferior.scm b/tests/inferior.scm index 791e30b17..03170a19c 100644 --- a/tests/inferior.scm +++ b/tests/inferior.scm @@ -24,8 +24,10 @@ #:use-module (guix derivations) #:use-module (gnu packages) #:use-module (gnu packages bootstrap) + #:use-module (gnu packages guile) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-64)) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) (define %top-srcdir (dirname (search-path %load-path "guix.scm"))) @@ -108,6 +110,36 @@ (close-inferior inferior) (every eq? lst1 lst2))) +(test-equal "inferior-package-inputs" + (let ((->list (match-lambda + ((label (? package? package) . rest) + `(,label + (package ,(package-name package) + ,(package-version package) + ,(package-location package)) + ,@rest))))) + (list (map ->list (package-inputs guile-2.2)) + (map ->list (package-native-inputs guile-2.2)) + (map ->list (package-propagated-inputs guile-2.2)))) + (let* ((inferior (open-inferior %top-builddir + #:command "scripts/guix")) + (guile (first (lookup-inferior-packages inferior "guile"))) + (->list (match-lambda + ((label (? inferior-package? package) . rest) + `(,label + (package ,(inferior-package-name package) + ,(inferior-package-version package) + ,(inferior-package-location package)) + ,@rest)))) + (result (list (map ->list (inferior-package-inputs guile)) + (map ->list + (inferior-package-native-inputs guile)) + (map ->list + (inferior-package-propagated-inputs + guile))))) + (close-inferior inferior) + result)) + (test-equal "inferior-package-derivation" (map derivation-file-name (list (package-derivation %store %bootstrap-guile "x86_64-linux") -- 2.18.0