hans/git-cli
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial import

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-09 14:41:59 +02:00
parent ad5200d58d
commit 43516e7715
9 changed files with 1257 additions and 67 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tests/basic.rkt
+73
View File
@@ -0,0 +1,73 @@
#lang racket/base
(require rackunit
racket/file
git)
(define tmp (make-temporary-file "racket-git-test~a" 'directory))
(dynamic-wind
void
(lambda ()
(make-directory (build-path tmp "sub"))
(parameterize ([current-directory tmp])
(git init)
(check-true (git-repository?))
(check-equal? (git-current-branch) "master")
(check-true (git-clean?))
(git config "user.name" "Racket Git Test")
(git config "user.email" "racket-git-test@example.invalid")
(check-equal? (git-config "user.name") "Racket Git Test")
(call-with-output-file ".gitignore"
#:exists 'truncate/replace
(lambda (out) (displayln "ignored.txt" out)))
(call-with-output-file "ignored.txt"
#:exists 'truncate/replace
(lambda (out) (displayln "ignored" out)))
(call-with-output-file (build-path "sub" "hello.txt")
#:exists 'truncate/replace
(lambda (out) (displayln "hello" out)))
(check-equal? (git-status-lines)
'("?? .gitignore" "?? sub/hello.txt"))
(parameterize ([current-directory (build-path tmp "sub")])
(git add "hello.txt"))
(check-equal? (git-status-lines)
'("?? .gitignore" "A sub/hello.txt"))
(git add ".gitignore")
(define first (git-commit "initial commit"))
(check-equal? (string-length first) 40)
(check-true (git-clean?))
(git checkout -b "work")
(call-with-output-file (build-path "sub" "hello.txt")
#:exists 'truncate/replace
(lambda (out) (displayln "work" out)))
(git add)
(git commit "work change")
(check-equal? (file->string (build-path "sub" "hello.txt")) "work\n")
(git checkout "master")
(check-equal? (file->string (build-path "sub" "hello.txt")) "hello\n")
(check-equal? (git-current-branch) "master")
(check-not-false (member "work" (git branch)))
(git branch -d "work")
(check-false (member "work" (git branch)))
(define tag-id (git tag "v0.1"))
(check-equal? (string-length tag-id) 40)
(check-equal? (git tag) '("v0.1"))
(git checkout "v0.1")
(check-false (git-current-branch))
(git checkout "master")
(git tag -d "v0.1")
(check-equal? (git tag) '())
(check-equal? (length (git log 10)) 1)))
(lambda ()
(delete-directory/files tmp)))
tests/credentials.rkt
+30
View File
@@ -0,0 +1,30 @@
#lang racket/base
(require rackunit
"../credentials.rkt")
;; Never touch the real racket-git preferences from the test suite.
(parameterize ([current-git-credentials-store 'racket-git-test]
[current-git-credentials-unlock-store 'racket-git-test-unlock])
(with-handlers ([exn:fail? (lambda (_) (void))])
(git-credentials-lock!))
(with-handlers ([exn:fail? (lambda (_) (void))])
(git-credentials-init! "test-password" #:unlock-for 60))
(unless (git-credentials-unlocked?)
(git-credentials-unlock! "test-password" #:for 60))
(check-true (git-credentials-unlocked?))
(git-credentials-set! "https://credentials-test.invalid"
"tester" "secret-token")
(check-equal?
(git-credentials-ref "https://credentials-test.invalid")
'("tester" . "secret-token"))
(check-equal?
(git-credentials-ref "https://credentials-test.invalid/a/b.git")
'("tester" . "secret-token"))
(git-credentials-remove! "https://credentials-test.invalid")
(check-false (git-credentials-ref "https://credentials-test.invalid"))
(git-credentials-lock!)
(check-false (git-credentials-unlocked?)))
tests/remote.rkt
+78
View File
@@ -0,0 +1,78 @@
#lang racket/base
(require rackunit
racket/file
git)
(define tmp (make-temporary-file "racket-git-remote-test~a" 'directory))
(define origin (build-path tmp "origin.git"))
(define a (build-path tmp "a"))
(define b (build-path tmp "b"))
(define (configure!)
(git config "user.name" "Racket Git Test")
(git config "user.email" "racket-git-test@example.invalid"))
(dynamic-wind
void
(lambda ()
(git-init origin #:bare? #t)
(make-directory a)
(parameterize ([current-directory a])
(git init)
(configure!)
(call-with-output-file "value.txt"
#:exists 'truncate/replace
(lambda (out) (displayln "one" out)))
(git add "value.txt")
(git commit "one")
(git remote add "origin" (path->string origin))
(check-equal? (git remote) '("origin"))
(check-equal? (git remote get-url "origin") (path->string origin))
(git push))
(git-clone (path->string origin) b)
(parameterize ([current-directory b])
(configure!)
(check-equal? (git-current-branch) "master")
(call-with-output-file "value.txt"
#:exists 'truncate/replace
(lambda (out) (displayln "two" out)))
(git add "value.txt")
(git commit "two")
(git push)
(git tag "v2")
(git push-tag "v2"))
(parameterize ([current-directory a])
(check-equal? (file->string "value.txt") "one\n")
(check-equal? (string-length (git pull)) 40)
(check-equal? (file->string "value.txt") "two\n")
(check-true (git-clean?))
(git fetch)
(check-equal? (git tag) '("v2"))
(call-with-output-file "local.txt"
#:exists 'truncate/replace
(lambda (out) (displayln "local" out)))
(git add "local.txt")
(git commit "local change"))
(parameterize ([current-directory b])
(call-with-output-file "remote.txt"
#:exists 'truncate/replace
(lambda (out) (displayln "remote" out)))
(git add "remote.txt")
(git commit "remote change")
(git push))
(parameterize ([current-directory a])
(define before (git-head))
(check-exn #rx"non-fast-forward"
(lambda () (git pull)))
(check-equal? (git-head) before)
(check-true (file-exists? "local.txt"))
(check-false (file-exists? "remote.txt"))))
(lambda ()
(delete-directory/files tmp)))