me
/
guix
Archived
1
0
Fork 0
Code

tests: Smarten up git repository testing framework. 

* guix/tests/git.scm (with-git-repository): New macro, exported.  It can be used
repeatedly inside a WITH-TEMPORARY-GIT-REPOSITORY.
(populate-git-repository): Extend the DSL with (ADD "some-noise"), (RESET
"[commit hash]"), (CHECKOUT "branch" ORPHAN).

Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
master
Attila Lendvai 2021-12-22 11:28:55 +01:00 committed by Mathieu Othacehe
parent c0a693dfec
commit 07145c8a8c
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
1 changed files with 21 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
guix/tests/git.scm
View File

@ -26,6 +26,7 @@
#:use-module (ice-9 control) #:use-module (ice-9 control)
#:export (git-command #:export (git-command
with-temporary-git-repository with-temporary-git-repository
with-git-repository
find-commit)) find-commit))
(define git-command (define git-command
@ -59,8 +60,9 @@ Return DIRECTORY on success."
(apply invoke (git-command) "-C" directory (apply invoke (git-command) "-C" directory
command args))))) command args)))))
(mkdir-p directory) (unless (directory-exists? (string-append directory "/.git"))
(git "init") (mkdir-p directory)
(git "init"))
(let loop ((directives directives)) (let loop ((directives directives))
(match directives (match directives
@ -78,6 +80,9 @@ Return DIRECTORY on success."
port))) port)))
(git "add" file) (git "add" file)
(loop rest))) (loop rest)))
((('add file-name-and-content) rest ...)
(loop (cons `(add ,file-name-and-content ,file-name-and-content)
rest)))
((('remove file) rest ...) ((('remove file) rest ...)
(git "rm" "-f" file) (git "rm" "-f" file)
(loop rest)) (loop rest))
@ -99,12 +104,18 @@ Return DIRECTORY on success."
((('checkout branch) rest ...) ((('checkout branch) rest ...)
(git "checkout" branch) (git "checkout" branch)
(loop rest)) (loop rest))
((('checkout branch 'orphan) rest ...)
(git "checkout" "--orphan" branch)
(loop rest))
((('merge branch message) rest ...) ((('merge branch message) rest ...)
(git "merge" branch "-m" message) (git "merge" branch "-m" message)
(loop rest)) (loop rest))
((('merge branch message ('signer fingerprint)) rest ...) ((('merge branch message ('signer fingerprint)) rest ...)
(git "merge" branch "-m" message (git "merge" branch "-m" message
(string-append "--gpg-sign=" fingerprint)) (string-append "--gpg-sign=" fingerprint))
(loop rest))
((('reset to) rest ...)
(git "reset" "--hard" to)
(loop rest))))) (loop rest)))))
(define (call-with-temporary-git-repository directives proc) (define (call-with-temporary-git-repository directives proc)
@ -121,6 +132,14 @@ per DIRECTIVES."
(lambda (directory) (lambda (directory)
exp ...))) exp ...)))
(define-syntax-rule (with-git-repository directory
directives exp ...)
"Evaluate EXP in a context where DIRECTORY is (further) populated as
per DIRECTIVES."
(begin
(populate-git-repository directory directives)
exp ...))
(define (find-commit repository message) (define (find-commit repository message)
"Return the commit in REPOSITORY whose message includes MESSAGE, a string." "Return the commit in REPOSITORY whose message includes MESSAGE, a string."
(let/ec return (let/ec return