Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Tue, 18 Sep 2018 12:05:02 UTC
Severity: normal
Tags: patch
Done: ludo <at> gnu.org (Ludovic Courtès)
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Ludovic Courtès <ludo <at> gnu.org> To: 32759 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [bug#32759] [PATCH 3/8] inferior: Add 'inferior-package-inputs' & co. Date: Tue, 18 Sep 2018 14:06:35 +0200
* 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.