inferior: Add 'inferior-package->manifest-entry'.

* guix/inferior.scm (inferior-package->manifest-entry): New procedure.
* tests/inferior.scm (manifest-entry->list): New procedure.
("inferior-package->manifest-entry"): New test.
This commit is contained in:
Ludovic Courtès 2018-09-18 09:56:34 +02:00
parent eee8b303f6
commit 2e6d64e122
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 56 additions and 4 deletions

View File

@ -33,6 +33,7 @@
#:select (read-derivation-from-file)) #:select (read-derivation-from-file))
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix search-paths) #:use-module (guix search-paths)
#:use-module (guix profiles)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -45,12 +46,12 @@
inferior-eval inferior-eval
inferior-object? inferior-object?
inferior-packages
lookup-inferior-packages
inferior-package? inferior-package?
inferior-package-name inferior-package-name
inferior-package-version inferior-package-version
inferior-packages
lookup-inferior-packages
inferior-package-synopsis inferior-package-synopsis
inferior-package-description inferior-package-description
inferior-package-home-page inferior-package-home-page
@ -62,7 +63,9 @@
inferior-package-native-search-paths inferior-package-native-search-paths
inferior-package-transitive-native-search-paths inferior-package-transitive-native-search-paths
inferior-package-search-paths inferior-package-search-paths
inferior-package-derivation)) inferior-package-derivation
inferior-package->manifest-entry))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -441,3 +444,34 @@ PACKAGE must be live."
target) target)
;; Compile PACKAGE for SYSTEM, optionally cross-building for TARGET. ;; Compile PACKAGE for SYSTEM, optionally cross-building for TARGET.
(inferior-package->derivation package system #:target 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))

View File

@ -21,6 +21,7 @@
#:use-module (guix inferior) #:use-module (guix inferior)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix profiles)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (gnu packages bootstrap) #:use-module (gnu packages bootstrap)
@ -38,6 +39,13 @@
(define %store (define %store
(open-connection-for-tests)) (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") (test-begin "inferior")
@ -164,4 +172,14 @@
(list (inferior-package-derivation %store guile "x86_64-linux") (list (inferior-package-derivation %store guile "x86_64-linux")
(inferior-package-derivation %store guile "armhf-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") (test-end "inferior")