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:
parent
eee8b303f6
commit
2e6d64e122
|
@ -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))
|
||||||
|
|
|
@ -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")
|
||||||
|
|
Loading…
Reference in New Issue