me/guix
Archived
1
0
Fork 0
Code Activity

guix: packages: Add package-direct-sources and package-transitive-sources.

Browse source 
* guix/tests.scm (dummy-origin): New syntax.
* guix/packages.scm (package-direct-sources)
  (package-transitive-sources): New procedures.
* tests/packages.scm ("package-direct-sources, no source")
  ("package-direct-sources, #f source")
  ("package-direct-sources, not input source", "package-direct-sources")
  ("package-transitive-sources"): Test them.
This commit is contained in:
Eric Bavier 2015-04-24 07:57:51 -05:00
parent f4bdfe7381
commit f77bcbc374
3 changed files with 63 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
guix/packages.scm
View file

@ -83,6 +83,8 @@
package-location
package-field-location
package-direct-sources
package-transitive-sources
package-direct-inputs
package-transitive-inputs
package-transitive-target-inputs
@ -540,6 +542,28 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
((input rest ...)
(loop rest (cons input result))))))
(define (package-direct-sources package)
"Return all source origins associated with PACKAGE; including origins in
PACKAGE's inputs."
`(,@(or (and=> (package-source package) list) '())
,@(filter-map (match-lambda
((_ (? origin? orig) _ ...)
orig)
(_ #f))
(package-direct-inputs package))))
(define (package-transitive-sources package)
"Return PACKAGE's direct sources, and their direct sources, recursively."
(delete-duplicates
(concatenate (filter-map (match-lambda
((_ (? origin? orig) _ ...)
(list orig))
((_ (? package? p) _ ...)
(package-direct-sources p))
(_ #f))
(bag-transitive-inputs
(package->bag package))))))
(define (package-direct-inputs package)
"Return all the direct inputs of PACKAGE---i.e, its direct inputs along
with their propagated inputs."

10
guix/tests.scm
View file

@ -37,7 +37,8 @@
%substitute-directory
with-derivation-narinfo
with-derivation-substitute
dummy-package))
dummy-package
dummy-origin))
;;; Commentary:
;;;
@ -219,6 +220,13 @@ initialized with default values, and with EXTRA-FIELDS set as specified."
(synopsis #f) (description #f)
(home-page #f) (license #f)))
(define-syntax-rule (dummy-origin extra-fields ...)
"Return a \"dummy\" origin, with all its compulsory fields initialized with
default values, and with EXTRA-FIELDS set as specified."
(origin extra-fields ...
(method #f) (uri "http://www.example.com")
(sha256 (base32 (make-string 52 #\x)))))
;; Local Variables:
;; eval: (put 'call-with-derivation-narinfo 'scheme-indent-function 1)
;; eval: (put 'call-with-derivation-substitute 'scheme-indent-function 2)

30
tests/packages.scm
View file

@ -155,6 +155,36 @@
(package-transitive-supported-systems d)
(package-transitive-supported-systems e))))
(let* ((o (dummy-origin))
(u (dummy-origin))
(i (dummy-origin))
(a (dummy-package "a"))
(b (dummy-package "b"
(inputs `(("a" ,a) ("i" ,i)))))
(c (package (inherit b) (source o)))
(d (dummy-package "d"
(build-system trivial-build-system)
(source u) (inputs `(("c" ,c))))))
(test-assert "package-direct-sources, no source"
(null? (package-direct-sources a)))
(test-equal "package-direct-sources, #f source"
(list i)
(package-direct-sources b))
(test-equal "package-direct-sources, not input source"
(list u)
(package-direct-sources d))
(test-assert "package-direct-sources"
(let ((s (package-direct-sources c)))
(and (= (length (pk 's-sources s)) 2)
(member o s)
(member i s))))
(test-assert "package-transitive-sources"
(let ((s (package-transitive-sources d)))
(and (= (length (pk 'd-sources s)) 3)
(member o s)
(member i s)
(member u s)))))
(test-equal "package-transitive-supported-systems, implicit inputs"
%supported-systems