mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 05:48:07 -05:00
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
2 changed files with 56 additions and 4 deletions
|
@ -33,6 +33,7 @@ (define-module (guix inferior)
|
|||
#: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 @@ (define-module (guix inferior)
|
|||
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 @@ (define-module (guix inferior)
|
|||
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 @@ (define-gexp-compiler (package-compiler (package <inferior-package>) system
|
|||
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))
|
||||
|
|
|
@ -21,6 +21,7 @@ (define-module (test-inferior)
|
|||
#: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 %top-builddir
|
|||
(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 @@ (define result
|
|||
(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")
|
||||
|
|
Loading…
Reference in a new issue