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

better progress information for git commands

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-11 09:36:14 +02:00
parent a72604e290
commit daa1891967
15 changed files with 2994 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tests/basic.rkt
+14 -3
View File
@@ -60,7 +60,7 @@
(lambda (out) (displayln "changed" out)))
(define worktree-diff (git 'diff))
(check-true (regexp-match? #rx"-hello" worktree-diff))
(check-true (regexp-match? #rx"\+changed" worktree-diff))
(check-true (regexp-match? #rx"[+]changed" worktree-diff))
(check-equal? (git 'diff '--cached) "")
(define diff-output (open-output-string))
@@ -72,7 +72,7 @@
(check-equal? (git 'diff) "")
(define cached-diff (git 'diff '--cached))
(check-true (regexp-match? #rx"-hello" cached-diff))
(check-true (regexp-match? #rx"\+changed" cached-diff))
(check-true (regexp-match? #rx"[+]changed" cached-diff))
(git 'commit "prepare branches")
(git 'checkout '-b "work")
@@ -84,10 +84,21 @@
(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? (file->string (build-path "sub" "hello.txt")) "changed\n")
(check-equal? (git-current-branch) "master")
(check-not-false (member "work" (git 'branch)))
;; Safe checkout must not overwrite an uncommitted tracked change.
(call-with-output-file (build-path "sub" "hello.txt")
#:exists 'truncate/replace
(lambda (out) (displayln "dirty" out)))
(check-exn exn:fail? (lambda () (git 'checkout "work")))
(check-equal? (git-current-branch) "master")
(check-equal? (file->string (build-path "sub" "hello.txt")) "dirty\n")
(call-with-output-file (build-path "sub" "hello.txt")
#:exists 'truncate/replace
(lambda (out) (displayln "changed" out)))
(git 'branch '-d "work")
(check-false (member "work" (git 'branch)))
tests/remote.rkt
+34 -2
View File
@@ -8,6 +8,7 @@
(define origin (build-path tmp "origin.git"))
(define a (build-path tmp "a"))
(define b (build-path tmp "b"))
(define c (build-path tmp "c"))
(define (configure!)
(git 'config "user.name" "Racket Git Test")
@@ -30,9 +31,27 @@
(git 'remote 'add "origin" (path->string origin))
(check-equal? (git 'remote) '("origin"))
(check-equal? (git 'remote 'get-url "origin") (path->string origin))
(git 'push))
(define push-out (open-output-string))
(parameterize ([current-output-port push-out])
(git 'push))
;; A successful push must remain safe when the returned credentials,
;; callbacks and options become eligible for collection.
(collect-garbage)
(collect-garbage)
(collect-garbage)
(check-true (regexp-match? #rx"\\[git\\] push origin/master"
(get-output-string push-out)))
(define quiet-out (open-output-string))
(parameterize ([current-output-port quiet-out])
(git 'push #:quiet #t))
(check-equal? (get-output-string quiet-out) ""))
(git-clone (path->string origin) b)
(define clone-quiet-out (open-output-string))
(parameterize ([current-output-port clone-quiet-out])
(git-clone (path->string origin) c #:quiet #t))
(check-equal? (get-output-string clone-quiet-out) "")
(parameterize ([current-directory b])
(configure!)
(check-equal? (git-current-branch) "master")
@@ -43,7 +62,11 @@
(git 'commit "two")
(git 'push)
(git 'tag "v2")
(git 'push-tag "v2"))
(git 'push-tag "v2")
(define push-tag-quiet-out (open-output-string))
(parameterize ([current-output-port push-tag-quiet-out])
(git 'push-tag "v2" #:quiet #t))
(check-equal? (get-output-string push-tag-quiet-out) ""))
(parameterize ([current-directory a])
(check-equal? (file->string "value.txt") "one\n")
@@ -52,6 +75,15 @@
(check-true (git-clean?))
(git 'fetch)
(check-equal? (git 'tag) '("v2"))
(define fetch-quiet-out (open-output-string))
(parameterize ([current-output-port fetch-quiet-out])
(git 'fetch #:quiet #t))
(check-equal? (get-output-string fetch-quiet-out) "")
(define pull-quiet-out (open-output-string))
(check-false
(parameterize ([current-output-port pull-quiet-out])
(git 'pull #:quiet #t)))
(check-equal? (get-output-string pull-quiet-out) "")
(call-with-output-file "local.txt"
#:exists 'truncate/replace