From: Eric Bavier <bavier@member.fsf.org>
To: guix-devel@gnu.org
Subject: [PATCH 1/2] guix: packages: Add package-direct-sources and package-transitive-sources.
Date: Fri, 24 Apr 2015 08:19:21 -0500 [thread overview]
Message-ID: <1429881562-19456-2-git-send-email-bavier@member.fsf.org> (raw)
In-Reply-To: <1429881562-19456-1-git-send-email-bavier@member.fsf.org>
* guix/tests.scm (dummy-origin): New syntax.
* guix/packages.scm (package-direct-sources)
(package-transitive-sources): New procedures.
* tests/packages.scm: Test them.
---
guix/packages.scm | 24 ++++++++++++++++++++++++
guix/tests.scm | 10 +++++++++-
tests/packages.scm | 30 ++++++++++++++++++++++++++++++
3 files changed, 63 insertions(+), 1 deletion(-)
diff --git a/guix/packages.scm b/guix/packages.scm
index fde46d5..ff0a466 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -82,6 +82,8 @@
package-location
package-field-location
+ package-direct-sources
+ package-transitive-sources
package-direct-inputs
package-transitive-inputs
package-transitive-target-inputs
@@ -519,6 +521,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."
diff --git a/guix/tests.scm b/guix/tests.scm
index 080ee9c..87e6cc2 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -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)
diff --git a/tests/packages.scm b/tests/packages.scm
index 9191032..c1bd697 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -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
--
1.7.9.5
next prev parent reply other threads:[~2015-04-24 13:18 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2015-04-24 13:19 [PATCH 2/2] guix: build: Add transitive source building Eric Bavier
2015-04-24 13:19 ` Eric Bavier [this message]
2015-05-01 20:12 ` [PATCH 1/2] guix: packages: Add package-direct-sources and package-transitive-sources Ludovic Courtès
2015-04-24 13:19 ` [PATCH 2/2] guix: build: Add transitive source building Eric Bavier
2015-05-01 20:14 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1429881562-19456-2-git-send-email-bavier@member.fsf.org \
--to=bavier@member.fsf.org \
--cc=guix-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.