mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
Add `package-transitive-inputs'; use it to honor propagated inputs.
* guix/packages.scm (package-transitive-inputs): New procedure. (package-derivation): Use it to compute INPUTS. * tests/packages.scm (dummy-package): New macro. ("package-transitive-inputs"): New test.
This commit is contained in:
parent
d5f0c7cc62
commit
a3d73f59e3
2 changed files with 51 additions and 2 deletions
|
@ -57,6 +57,7 @@ (define-module (guix packages)
|
||||||
package-properties
|
package-properties
|
||||||
package-location
|
package-location
|
||||||
|
|
||||||
|
package-transitive-inputs
|
||||||
package-source-derivation
|
package-source-derivation
|
||||||
package-derivation
|
package-derivation
|
||||||
package-cross-derivation))
|
package-cross-derivation))
|
||||||
|
@ -161,6 +162,27 @@ (define (package-source-derivation store source)
|
||||||
(($ <origin> uri method sha256 name)
|
(($ <origin> uri method sha256 name)
|
||||||
(method store uri 'sha256 sha256 name))))
|
(method store uri 'sha256 sha256 name))))
|
||||||
|
|
||||||
|
(define (package-transitive-inputs package)
|
||||||
|
"Return the transitive inputs of PACKAGE---i.e., its direct inputs along
|
||||||
|
with their propagated inputs, recursively."
|
||||||
|
(let loop ((inputs (concatenate (list (package-native-inputs package)
|
||||||
|
(package-inputs package)
|
||||||
|
(package-propagated-inputs package))))
|
||||||
|
(result '()))
|
||||||
|
(match inputs
|
||||||
|
(()
|
||||||
|
(delete-duplicates (reverse result))) ; XXX: efficiency
|
||||||
|
(((and i (name (? package? p) sub ...)) rest ...)
|
||||||
|
(let ((t (map (match-lambda
|
||||||
|
((dep-name derivation ...)
|
||||||
|
(cons (string-append name "/" dep-name)
|
||||||
|
derivation)))
|
||||||
|
(package-propagated-inputs p))))
|
||||||
|
(loop (append t rest)
|
||||||
|
(append t (cons i result)))))
|
||||||
|
((input rest ...)
|
||||||
|
(loop rest (cons input result))))))
|
||||||
|
|
||||||
(define* (package-derivation store package
|
(define* (package-derivation store package
|
||||||
#:optional (system (%current-system)))
|
#:optional (system (%current-system)))
|
||||||
"Return the derivation of PACKAGE for SYSTEM."
|
"Return the derivation of PACKAGE for SYSTEM."
|
||||||
|
@ -186,8 +208,7 @@ (define* (package-derivation store package
|
||||||
(list name
|
(list name
|
||||||
(add-to-store store (basename file)
|
(add-to-store store (basename file)
|
||||||
#t #f "sha256" file))))
|
#t #f "sha256" file))))
|
||||||
(concatenate (list native-inputs inputs
|
(package-transitive-inputs package))))
|
||||||
propagated-inputs)))))
|
|
||||||
(apply builder
|
(apply builder
|
||||||
store (string-append name "-" version)
|
store (string-append name "-" version)
|
||||||
(package-source-derivation store source)
|
(package-source-derivation store source)
|
||||||
|
|
|
@ -22,6 +22,7 @@ (define-module (test-packages)
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
|
#:use-module (guix build-system gnu)
|
||||||
#:use-module (distro)
|
#:use-module (distro)
|
||||||
#:use-module (distro base)
|
#:use-module (distro base)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
|
@ -35,6 +36,32 @@ (define %store
|
||||||
|
|
||||||
(test-begin "packages")
|
(test-begin "packages")
|
||||||
|
|
||||||
|
(define-syntax-rule (dummy-package name* extra-fields ...)
|
||||||
|
(package (name name*) (version "0") (source #f)
|
||||||
|
(build-system gnu-build-system)
|
||||||
|
(description #f) (long-description #f)
|
||||||
|
(home-page #f)
|
||||||
|
extra-fields ...))
|
||||||
|
|
||||||
|
(test-assert "package-transitive-inputs"
|
||||||
|
(let* ((a (dummy-package "a"))
|
||||||
|
(b (dummy-package "b"
|
||||||
|
(propagated-inputs `(("a" ,a)))))
|
||||||
|
(c (dummy-package "c"
|
||||||
|
(inputs `(("a" ,a)))))
|
||||||
|
(d (dummy-package "d"
|
||||||
|
(propagated-inputs `(("x" "something.drv")))))
|
||||||
|
(e (dummy-package "e"
|
||||||
|
(inputs `(("b" ,b) ("c" ,c) ("d" ,d))))))
|
||||||
|
(and (null? (package-transitive-inputs a))
|
||||||
|
(equal? `(("a" ,a)) (package-transitive-inputs b))
|
||||||
|
(equal? `(("a" ,a)) (package-transitive-inputs c))
|
||||||
|
(equal? (package-propagated-inputs d)
|
||||||
|
(package-transitive-inputs d))
|
||||||
|
(equal? `(("b" ,b) ("b/a" ,a) ("c" ,c)
|
||||||
|
("d" ,d) ("d/x" "something.drv"))
|
||||||
|
(pk 'x (package-transitive-inputs e))))))
|
||||||
|
|
||||||
(test-skip (if (not %store) 1 0))
|
(test-skip (if (not %store) 1 0))
|
||||||
|
|
||||||
(test-assert "GNU Hello"
|
(test-assert "GNU Hello"
|
||||||
|
@ -63,4 +90,5 @@ (define %store
|
||||||
|
|
||||||
;;; Local Variables:
|
;;; Local Variables:
|
||||||
;;; eval: (put 'test-assert 'scheme-indent-function 1)
|
;;; eval: (put 'test-assert 'scheme-indent-function 1)
|
||||||
|
;;; eval: (put 'dummy-package 'scheme-indent-function 1)
|
||||||
;;; End:
|
;;; End:
|
||||||
|
|
Loading…
Reference in a new issue