01/02: tests: Smarten up git repository testing framework.

[guix-commits]

mothacehe pushed a commit to branch master
in repository guix.

commit 07145c8a8cef3860a6c522d81e387bd0485c83ce
Author: Attila Lendvai <attila@lendvai.name>
AuthorDate: Wed Dec 22 11:28:55 2021 +0100

    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>
---
 guix/tests/git.scm | 23 +++++++++++++++++++++--
 1 file changed, 21 insertions(+), 2 deletions(-)

diff --git a/guix/tests/git.scm b/guix/tests/git.scm
index 6996028..76f5a8b 100644
--- a/guix/tests/git.scm
+++ b/guix/tests/git.scm
@@ -26,6 +26,7 @@
   #:use-module (ice-9 control)
   #:export (git-command
             with-temporary-git-repository
+            with-git-repository
             find-commit))
 
 (define git-command
@@ -59,8 +60,9 @@ Return DIRECTORY on success."
         (apply invoke (git-command) "-C" directory
                command args)))))
 
-  (mkdir-p directory)
-  (git "init")
+  (unless (directory-exists? (string-append directory "/.git"))
+    (mkdir-p directory)
+    (git "init"))
 
   (let loop ((directives directives))
     (match directives
@@ -78,6 +80,9 @@ Return DIRECTORY on success."
                       port)))
          (git "add" file)
          (loop rest)))
+      ((('add file-name-and-content) rest ...)
+       (loop (cons `(add ,file-name-and-content ,file-name-and-content)
+                   rest)))
       ((('remove file) rest ...)
        (git "rm" "-f" file)
        (loop rest))
@@ -99,12 +104,18 @@ Return DIRECTORY on success."
       ((('checkout branch) rest ...)
        (git "checkout" branch)
        (loop rest))
+      ((('checkout branch 'orphan) rest ...)
+       (git "checkout" "--orphan" branch)
+       (loop rest))
       ((('merge branch message) rest ...)
        (git "merge" branch "-m" message)
        (loop rest))
       ((('merge branch message ('signer fingerprint)) rest ...)
        (git "merge" branch "-m" message
             (string-append "--gpg-sign=" fingerprint))
+       (loop rest))
+      ((('reset to) rest ...)
+       (git "reset" "--hard" to)
        (loop rest)))))
 
 (define (call-with-temporary-git-repository directives proc)
@@ -121,6 +132,14 @@ per DIRECTIVES."
                                       (lambda (directory)
                                         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)
   "Return the commit in REPOSITORY whose message includes MESSAGE, a string."
   (let/ec return