mirror of
https://codeberg.org/guix/guix.git
synced 2026-09-04 12:51:45 +00:00
* tests/git.scm (git): New procedure.
("update-cached-checkout, tag",
"update-cached-checkout, recursive submodules follow ref",
"update-cached-checkout, symref tag",
"update-cached-checkout, symref pull-request"): Use it.
Change-Id: I85aa14e729be1efe691418e74e37d6ae1fd3e633
384 lines
16 KiB
Scheme
384 lines
16 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
|
;;; Copyright © 2019-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org>
|
|
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
|
|
;;; Copyright © 2026 Simon Tournier <zimon.toutoune@gmail.com>
|
|
;;;
|
|
;;; This file is part of GNU Guix.
|
|
;;;
|
|
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
|
;;; under the terms of the GNU General Public License as published by
|
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
|
;;; your option) any later version.
|
|
;;;
|
|
;;; GNU Guix is distributed in the hope that it will be useful, but
|
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;;; GNU General Public License for more details.
|
|
;;;
|
|
;;; You should have received a copy of the GNU General Public License
|
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
(define-module (test-git)
|
|
#:use-module (git)
|
|
#:use-module (guix git)
|
|
#:use-module (guix tests git)
|
|
#:use-module ((guix utils) #:select (call-with-temporary-directory))
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-64)
|
|
#:use-module (srfi srfi-71)
|
|
#:use-module (ice-9 popen)
|
|
#:use-module (ice-9 textual-ports))
|
|
|
|
;; Test the (guix git) tools.
|
|
|
|
(define (git . args)
|
|
(let* ((pipe (apply open-pipe* OPEN_READ (git-command) args))
|
|
(str (string-trim-right (get-string-all pipe))))
|
|
(close-pipe pipe)
|
|
str))
|
|
|
|
(test-begin "git")
|
|
|
|
(test-assert "commit-difference, linear history"
|
|
(with-temporary-git-repository directory
|
|
'((add "a.txt" "A")
|
|
(commit "first commit")
|
|
(add "b.txt" "B")
|
|
(commit "second commit")
|
|
(add "c.txt" "C")
|
|
(commit "third commit")
|
|
(add "d.txt" "D")
|
|
(commit "fourth commit"))
|
|
(with-repository directory repository
|
|
(let ((commit1 (find-commit repository "first"))
|
|
(commit2 (find-commit repository "second"))
|
|
(commit3 (find-commit repository "third"))
|
|
(commit4 (find-commit repository "fourth")))
|
|
(and (lset= eq? (commit-difference commit4 commit1)
|
|
(list commit2 commit3 commit4))
|
|
(lset= eq? (commit-difference commit4 commit2)
|
|
(list commit3 commit4))
|
|
(equal? (commit-difference commit3 commit2)
|
|
(list commit3))
|
|
|
|
;; COMMIT4 is not an ancestor of COMMIT1 so we should get the
|
|
;; empty list.
|
|
(null? (commit-difference commit1 commit4)))))))
|
|
|
|
(test-assert "commit-difference, fork"
|
|
(with-temporary-git-repository directory
|
|
'((add "a.txt" "A")
|
|
(commit "first commit")
|
|
(branch "devel")
|
|
(checkout "devel")
|
|
(add "devel/1.txt" "1")
|
|
(commit "first devel commit")
|
|
(add "devel/2.txt" "2")
|
|
(commit "second devel commit")
|
|
(checkout "master")
|
|
(add "b.txt" "B")
|
|
(commit "second commit")
|
|
(add "c.txt" "C")
|
|
(commit "third commit")
|
|
(merge "devel" "merge")
|
|
(add "d.txt" "D")
|
|
(commit "fourth commit"))
|
|
(with-repository directory repository
|
|
(let ((master1 (find-commit repository "first commit"))
|
|
(master2 (find-commit repository "second commit"))
|
|
(master3 (find-commit repository "third commit"))
|
|
(master4 (find-commit repository "fourth commit"))
|
|
(devel1 (find-commit repository "first devel"))
|
|
(devel2 (find-commit repository "second devel"))
|
|
(merge (find-commit repository "merge")))
|
|
(and (equal? (commit-difference master4 merge)
|
|
(list master4))
|
|
(lset= eq? (commit-difference master3 master1)
|
|
(list master3 master2))
|
|
(lset= eq? (commit-difference devel2 master1)
|
|
(list devel2 devel1))
|
|
|
|
;; The merge occurred between MASTER2 and MASTER4 so here we
|
|
;; expect to see all the commits from the "devel" branch in
|
|
;; addition to those on "master".
|
|
(lset= eq? (commit-difference master4 master2)
|
|
(list master4 merge master3 devel1 devel2)))))))
|
|
|
|
(test-assert "commit-difference, excluded commits"
|
|
(with-temporary-git-repository directory
|
|
'((add "a.txt" "A")
|
|
(commit "first commit")
|
|
(add "b.txt" "B")
|
|
(commit "second commit")
|
|
(add "c.txt" "C")
|
|
(commit "third commit")
|
|
(add "d.txt" "D")
|
|
(commit "fourth commit")
|
|
(add "e.txt" "E")
|
|
(commit "fifth commit"))
|
|
(with-repository directory repository
|
|
(let ((commit1 (find-commit repository "first"))
|
|
(commit2 (find-commit repository "second"))
|
|
(commit3 (find-commit repository "third"))
|
|
(commit4 (find-commit repository "fourth"))
|
|
(commit5 (find-commit repository "fifth")))
|
|
(and (lset= eq? (commit-difference commit4 commit1 (list commit2))
|
|
(list commit3 commit4))
|
|
(lset= eq? (commit-difference commit4 commit1 (list commit3))
|
|
(list commit4))
|
|
(null? (commit-difference commit4 commit1 (list commit5))))))))
|
|
|
|
(test-equal "commit-relation"
|
|
'(self ;master3 master3
|
|
ancestor ;master1 master3
|
|
descendant ;master3 master1
|
|
unrelated ;master2 branch1
|
|
unrelated ;branch1 master2
|
|
ancestor ;branch1 merge
|
|
descendant ;merge branch1
|
|
ancestor ;master1 merge
|
|
descendant) ;merge master1
|
|
(with-temporary-git-repository directory
|
|
'((add "a.txt" "A")
|
|
(commit "first commit")
|
|
(branch "hack")
|
|
(checkout "hack")
|
|
(add "1.txt" "1")
|
|
(commit "branch commit")
|
|
(checkout "master")
|
|
(add "b.txt" "B")
|
|
(commit "second commit")
|
|
(add "c.txt" "C")
|
|
(commit "third commit")
|
|
(merge "hack" "merge"))
|
|
(with-repository directory repository
|
|
(let ((master1 (find-commit repository "first"))
|
|
(master2 (find-commit repository "second"))
|
|
(master3 (find-commit repository "third"))
|
|
(branch1 (find-commit repository "branch"))
|
|
(merge (find-commit repository "merge")))
|
|
(list (commit-relation master3 master3)
|
|
(commit-relation master1 master3)
|
|
(commit-relation master3 master1)
|
|
(commit-relation master2 branch1)
|
|
(commit-relation branch1 master2)
|
|
(commit-relation branch1 merge)
|
|
(commit-relation merge branch1)
|
|
(commit-relation master1 merge)
|
|
(commit-relation merge master1))))))
|
|
|
|
(test-equal "commit-descendant?"
|
|
'((master3 master3 => #t)
|
|
(master1 master3 => #f)
|
|
(master3 master1 => #t)
|
|
(master2 branch1 => #f)
|
|
(master2 branch1 master1 => #t)
|
|
(branch1 master2 => #f)
|
|
(branch1 merge => #f)
|
|
(merge branch1 => #t)
|
|
(master1 merge => #f)
|
|
(merge master1 => #t))
|
|
(with-temporary-git-repository directory
|
|
'((add "a.txt" "A")
|
|
(commit "first commit")
|
|
(branch "hack")
|
|
(checkout "hack")
|
|
(add "1.txt" "1")
|
|
(commit "branch commit")
|
|
(checkout "master")
|
|
(add "b.txt" "B")
|
|
(commit "second commit")
|
|
(add "c.txt" "C")
|
|
(commit "third commit")
|
|
(merge "hack" "merge"))
|
|
(with-repository directory repository
|
|
(let ((master1 (find-commit repository "first"))
|
|
(master2 (find-commit repository "second"))
|
|
(master3 (find-commit repository "third"))
|
|
(branch1 (find-commit repository "branch"))
|
|
(merge (find-commit repository "merge")))
|
|
(letrec-syntax ((verify
|
|
(syntax-rules ()
|
|
((_) '())
|
|
((_ (new old ...) rest ...)
|
|
(cons `(new old ... =>
|
|
,(commit-descendant? new
|
|
(list old ...)))
|
|
(verify rest ...))))))
|
|
(verify (master3 master3)
|
|
(master1 master3)
|
|
(master3 master1)
|
|
(master2 branch1)
|
|
(master2 branch1 master1)
|
|
(branch1 master2)
|
|
(branch1 merge)
|
|
(merge branch1)
|
|
(master1 merge)
|
|
(merge master1)))))))
|
|
|
|
(test-equal "remote-refs"
|
|
'("refs/heads/develop" "refs/heads/master"
|
|
"refs/tags/v1.0" "refs/tags/v1.1")
|
|
(with-temporary-git-repository directory
|
|
'((add "a.txt" "A")
|
|
(commit "First commit")
|
|
(tag "v1.0" "release-1.0")
|
|
(branch "develop")
|
|
(checkout "develop")
|
|
(add "b.txt" "B")
|
|
(commit "Second commit")
|
|
(tag "v1.1" "release-1.1"))
|
|
(remote-refs directory)))
|
|
|
|
(test-equal "remote-refs: only tags"
|
|
'("refs/tags/v1.0" "refs/tags/v1.1")
|
|
(with-temporary-git-repository directory
|
|
'((add "a.txt" "A")
|
|
(commit "First commit")
|
|
(tag "v1.0" "Release 1.0")
|
|
(add "b.txt" "B")
|
|
(commit "Second commit")
|
|
(tag "v1.1" "Release 1.1"))
|
|
(remote-refs directory #:tags? #t)))
|
|
|
|
(test-assert "update-cached-checkout, tag"
|
|
(call-with-temporary-directory
|
|
(lambda (cache)
|
|
(with-temporary-git-repository directory
|
|
'((add "a.txt" "A")
|
|
(commit "First commit")
|
|
(tag "v1.0" "release-1.0")
|
|
(branch "develop")
|
|
(checkout "develop")
|
|
(add "b.txt" "B")
|
|
(commit "Second commit")
|
|
(tag "v1.1" "release-1.1")
|
|
(checkout "master"))
|
|
(let* ((tag (git "-C" directory
|
|
"rev-parse" "v1.1^{}"))
|
|
(cached-directory commit relation
|
|
(update-cached-checkout directory
|
|
#:ref '(tag . "v1.1")
|
|
#:cache-directory cache))
|
|
(head (git "-C" cached-directory
|
|
"rev-parse" "HEAD")))
|
|
(and (string=? commit head)
|
|
(string=? tag head)))))))
|
|
|
|
(test-assert "update-cached-checkout, recursive submodules follow ref"
|
|
(call-with-temporary-directory
|
|
(lambda (cache)
|
|
(with-temporary-git-repository sub
|
|
'((add "file.txt" "v1\n")
|
|
(commit "submodule v1")
|
|
(add "file.txt" "v2\n")
|
|
(commit "submodule v2"))
|
|
(let ((sub-v1 (git "-C" sub "rev-parse" "HEAD~1"))
|
|
(sub-v2 (git "-C" sub "rev-parse" "HEAD")))
|
|
(with-temporary-git-repository main
|
|
`((add "root.txt" "root\n")
|
|
(commit "root")
|
|
(branch "primary")
|
|
(checkout "primary")
|
|
(submodule ,sub "modules/sub")
|
|
(submodule-checkout "modules/sub" ,sub-v1)
|
|
(commit "primary uses submodule v1")
|
|
(branch "release")
|
|
(checkout "release")
|
|
(submodule-checkout "modules/sub" ,sub-v2)
|
|
(commit "release uses submodule v2")
|
|
(checkout "primary"))
|
|
(let* ((checkout1 commit1 relation1
|
|
(update-cached-checkout main
|
|
#:recursive? #t
|
|
#:cache-directory cache))
|
|
(head-cached1 (git "-C" (in-vicinity checkout1 "modules/sub")
|
|
"rev-parse" "HEAD"))
|
|
(checkout2 commit2 relation2
|
|
(update-cached-checkout main
|
|
#:recursive? #t
|
|
#:ref '(branch . "release")
|
|
#:cache-directory cache))
|
|
(head-cached2 (git "-C" (in-vicinity checkout2 "modules/sub")
|
|
"rev-parse" "HEAD")))
|
|
(and
|
|
(string=? sub-v1 head-cached1)
|
|
(string=? sub-v2 head-cached2)))))))))
|
|
|
|
(test-assert "update-cached-checkout, untracked files removed"
|
|
(call-with-temporary-directory
|
|
(lambda (cache)
|
|
(with-temporary-git-repository directory
|
|
'((add "a.txt" "A")
|
|
(add ".gitignore" ".~\n")
|
|
(commit "First commit"))
|
|
(let ((directory commit relation
|
|
(update-cached-checkout directory
|
|
#:ref '()
|
|
#:cache-directory cache)))
|
|
(close-port
|
|
(open-output-file (in-vicinity cache "stale-untracked-file")))
|
|
(let ((directory2 commit2 relation2
|
|
(update-cached-checkout directory
|
|
#:ref '()
|
|
#:cache-directory cache)))
|
|
(not (file-exists?
|
|
(in-vicinity cache "stale-untracked-file")))))))))
|
|
|
|
(test-assert "update-cached-checkout, symref tag"
|
|
(call-with-temporary-directory
|
|
(lambda (cache)
|
|
(with-temporary-git-repository directory
|
|
'((add "a.txt" "A")
|
|
(commit "First commit")
|
|
(tag "v1.0" "release-1.0")
|
|
(branch "develop")
|
|
(checkout "develop")
|
|
(add "b.txt" "B")
|
|
(commit "Second commit")
|
|
(tag "v1.1" "release-1.1")
|
|
(checkout "master"))
|
|
(let* ((tag-directory (git "-C" directory
|
|
"rev-parse" "v1.1"))
|
|
(cached-directory commit relation
|
|
(update-cached-checkout directory
|
|
#:ref '(symref . "refs/tags/v1.1")
|
|
#:cache-directory cache))
|
|
(head-cached (git "-C" cached-directory
|
|
;; switch-to-ref doesn't dereference the Git object,
|
|
;; thus it points to a Git tag object.
|
|
;; And HEAD points to a Git commit object.
|
|
;; Hence, the check is against Git tag objects.
|
|
;; For the difference see:
|
|
;; git show-ref --dereference v1.1
|
|
"rev-parse" "v1.1")))
|
|
(and (string=? commit head-cached)
|
|
(string=? tag-directory head-cached)))))))
|
|
|
|
(test-assert "update-cached-checkout, symref pull-request"
|
|
(call-with-temporary-directory
|
|
(lambda (cache)
|
|
(with-temporary-git-repository directory
|
|
'((add "a.txt" "A")
|
|
(commit "First commit")
|
|
(tag "v1.0" "release-1.0")
|
|
(branch "develop")
|
|
(checkout "develop")
|
|
(add "b.txt" "B")
|
|
(commit "Second commit")
|
|
(tag "v1.1" "release-1.1")
|
|
(symbolic-ref "refs/pull/1/head" "refs/heads/develop")
|
|
(checkout "master"))
|
|
(let* ((head-directory (git "-C" directory
|
|
"rev-parse" "refs/pull/1/head"))
|
|
(cached-directory commit relation
|
|
(update-cached-checkout directory
|
|
#:ref '(symref . "refs/pull/1/head")
|
|
#:cache-directory cache))
|
|
(head-cached (git "-C" cached-directory
|
|
"rev-parse" "HEAD")))
|
|
(and (string=? commit head-directory)
|
|
(string=? head-cached head-directory)))))))
|
|
|
|
(test-end "git")
|