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/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