1
0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-05-24 18:11:51 +02:00

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.
This commit is contained in:
Ludovic Courtès
2019-01-17 16:57:53 +01:00
parent ff8a66bc61
commit ed75bdf35c
2 changed files with 126 additions and 22 deletions
+82 -2
View File
@@ -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")