diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-05-20 22:15:54 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-05-25 00:00:28 +0200 |
| commit | 872898f768ae6d3b41eb93c5e183624bd1d157ff (patch) | |
| tree | d88d5ff215bedffeba951ddf35b8cc0e4489a253 /tests/channels.scm | |
| parent | 8d1d56578aa95118650ed2197bfb7fac40f4218a (diff) | |
| download | guix-872898f768ae6d3b41eb93c5e183624bd1d157ff.tar guix-872898f768ae6d3b41eb93c5e183624bd1d157ff.tar.gz | |
channels: 'latest-channel-instances' guards against non-forward updates.
* 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.
Diffstat (limited to 'tests/channels.scm')
| -rw-r--r-- | tests/channels.scm | 35 |
1 files changed, 35 insertions, 0 deletions
diff --git a/tests/channels.scm b/tests/channels.scm index 3578b57204..3b141428c8 100644 --- a/tests/channels.scm +++ b/tests/channels.scm @@ -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 |