tribes/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-04-06 21:20:33 +02:00
Code Activity

channels: 'latest-channel-instances' guards against non-forward updates.

Browse Source 
* guix/channels.scm (latest-channel-instance): Add #:starting-commit and
pass it to 'update-cached-checkout'.  Return the commit relation as a
second value.
(ensure-forward-channel-update): New procedure.
(latest-channel-instances): Add #:current-channels and #:validate-pull.
[current-commit]: New procedure.
Pass #:starting-commit to 'latest-channel-instance'.  When the returned
relation is true, call VALIDATE-PULL.
(latest-channel-derivation): Add #:current-channels and #:validate-pull.
Pass them to 'latest-channel-instances*'.
* tests/channels.scm ("latest-channel-instances #:validate-pull"): New
test.
This commit is contained in:
Ludovic Courtès
2020-05-20 22:15:54 +02:00
parent 8d1d56578a
commit 872898f768
2 changed files with 114 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
tests/channels.scm
View File

@@ -37,6 +37,7 @@
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-64)
#:use-module (ice-9 control)
#:use-module (ice-9 match))
(test-begin "channels")
@@ -178,6 +179,40 @@
"abc1234")))
instances)))))))
(unless (which (git-command)) (test-skip 1))
(test-equal "latest-channel-instances #:validate-pull"
'descendant
;; Make sure the #:validate-pull procedure receives the right values.
(let/ec return
(with-temporary-git-repository directory
'((add "a.txt" "A")
(commit "first commit")
(add "b.scm" "#t")
(commit "second commit"))
(with-repository directory repository
(let* ((commit1 (find-commit repository "first"))
(commit2 (find-commit repository "second"))
(spec (channel (url (string-append "file://" directory))
(name 'foo)))
(new (channel (inherit spec)
(commit (oid->string (commit-id commit2)))))
(old (channel (inherit spec)
(commit (oid->string (commit-id commit1))))))
(define (validate-pull channel current instance relation)
(return (and (eq? channel old)
(string=? (oid->string (commit-id commit2))
current)
(string=? (oid->string (commit-id commit1))
(channel-instance-commit instance))
relation)))
(with-store store
;; Attempt a downgrade from NEW to OLD.
(latest-channel-instances store (list old)
#:current-channels (list new)
#:validate-pull validate-pull)))))))
(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