summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-05-20 22:15:54 +0200
committerLudovic Courtès <ludo@gnu.org>2020-05-25 00:00:28 +0200
commit872898f768ae6d3b41eb93c5e183624bd1d157ff (patch)
treed88d5ff215bedffeba951ddf35b8cc0e4489a253 /tests
parent8d1d56578aa95118650ed2197bfb7fac40f4218a (diff)
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')
-rw-r--r--tests/channels.scm35
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