summaryrefslogtreecommitdiff
path: root/tests/channels.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-01-17 16:57:53 +0100
committerLudovic Courtès <ludo@gnu.org>2019-01-20 17:57:14 +0100
commited75bdf35ca494496cdbc7a06b414e1f08e70cac (patch)
tree2da19cc839aa471f841e85bf67c1ae1c15dee91f /tests/channels.scm
parentff8a66bc611d62280d6882d44dd7ee3bd9955983 (diff)
channels: Don't pull from the same channel more than once.
Previous 'channel-instance->manifest' would call 'latest-channel-derivation', which could trigger another round of 'latest-repository-commit' for no good reason. * guix/channels.scm (resolve-dependencies): New procedure. (channel-instance-derivations)[edges]: New variable. [instance->derivation]: New procedure. * tests/channels.scm (make-instance): Use 'checkout->channel-instance' instead of 'channel-instance'. ("channel-instances->manifest"): New test.
Diffstat (limited to 'tests/channels.scm')
-rw-r--r--tests/channels.scm84
1 files changed, 82 insertions, 2 deletions
diff --git a/tests/channels.scm b/tests/channels.scm
index f3fc383ac3..7df1b8c5fe 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -18,9 +18,15 @@
(define-module (test-channels)
#:use-module (guix channels)
+ #:use-module (guix profiles)
#:use-module ((guix build syscalls) #:select (mkdtemp!))
#:use-module (guix tests)
+ #:use-module (guix store)
+ #:use-module ((guix grafts) #:select (%graft?))
+ #:use-module (guix derivations)
+ #:use-module (guix gexp)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
#:use-module (ice-9 match))
@@ -34,8 +40,9 @@
(and spec
(with-output-to-file (string-append instance-dir "/.guix-channel")
(lambda _ (format #t "~a" spec))))
- ((@@ (guix channels) channel-instance)
- name commit instance-dir))
+ (checkout->channel-instance instance-dir
+ #:commit commit
+ #:name name))
(define instance--boring (make-instance))
(define instance--no-deps
@@ -136,4 +143,77 @@
'abc1234)))
instances))))))
+(test-assert "channel-instances->manifest"
+ ;; Compute the manifest for a graph of instances and make sure we get a
+ ;; derivation graph that mirrors the instance graph. This test also ensures
+ ;; we don't try to access Git repositores at all at this stage.
+ (let* ((spec (lambda deps
+ `(channel (version 0)
+ (dependencies
+ ,@(map (lambda (dep)
+ `(channel
+ (name ,dep)
+ (url "http://example.org")))
+ deps)))))
+ (guix (make-instance #:name 'guix))
+ (instance0 (make-instance #:name 'a))
+ (instance1 (make-instance #:name 'b #:spec (spec 'a)))
+ (instance2 (make-instance #:name 'c #:spec (spec 'b)))
+ (instance3 (make-instance #:name 'd #:spec (spec 'c 'a))))
+ (%graft? #f) ;don't try to build stuff
+
+ ;; Create 'build-self.scm' so that GUIX is recognized as the 'guix' channel.
+ (let ((source (channel-instance-checkout guix)))
+ (mkdir (string-append source "/build-aux"))
+ (call-with-output-file (string-append source
+ "/build-aux/build-self.scm")
+ (lambda (port)
+ (write '(begin
+ (use-modules (guix) (gnu packages bootstrap))
+
+ (lambda _
+ (package->derivation %bootstrap-guile)))
+ port))))
+
+ (with-store store
+ (let ()
+ (define manifest
+ (run-with-store store
+ (channel-instances->manifest (list guix
+ instance0 instance1
+ instance2 instance3))))
+
+ (define entries
+ (manifest-entries manifest))
+
+ (define (depends? drv in out)
+ ;; Return true if DRV depends on all of IN and none of OUT.
+ (let ((lst (map derivation-input-path (derivation-inputs drv)))
+ (in (map derivation-file-name in))
+ (out (map derivation-file-name out)))
+ (and (every (cut member <> lst) in)
+ (not (any (cut member <> lst) out)))))
+
+ (define (lookup name)
+ (run-with-store store
+ (lower-object
+ (manifest-entry-item
+ (manifest-lookup manifest
+ (manifest-pattern (name name)))))))
+
+ (let ((drv-guix (lookup "guix"))
+ (drv0 (lookup "a"))
+ (drv1 (lookup "b"))
+ (drv2 (lookup "c"))
+ (drv3 (lookup "d")))
+ (and (depends? drv-guix '() (list drv0 drv1 drv2 drv3))
+ (depends? drv0
+ (list) (list drv1 drv2 drv3))
+ (depends? drv1
+ (list drv0) (list drv2 drv3))
+ (depends? drv2
+ (list drv1) (list drv0 drv3))
+ (depends? drv3
+ (list drv2 drv0) (list drv1))))))))
+
(test-end "channels")