cleanup temporary information
This commit is contained in:
@@ -2,7 +2,7 @@
|
||||
|
||||
(define collection "git")
|
||||
(define pkg-desc "Command-line-like Git operations for Racket, implemented with libgit2")
|
||||
(define version "0.2.7")
|
||||
(define version "0.2.8")
|
||||
(define pkg-authors '("Hans Dijkema"))
|
||||
(define license 'MIT)
|
||||
|
||||
|
||||
@@ -754,6 +754,12 @@
|
||||
(inexact->exact (floor (current-inexact-milliseconds)))
|
||||
(random 1000000000)))
|
||||
|
||||
(define (remove-temporary-remote-refs! repo temp-name)
|
||||
(define prefix (format "refs/remotes/~a/" temp-name))
|
||||
(for ([ref-name (in-list (git_reference_list repo))]
|
||||
#:when (string-prefix? ref-name prefix))
|
||||
(git_reference_remove repo ref-name)))
|
||||
|
||||
(define (push-refspec remote-name refspec quiet label)
|
||||
(define url (check-remote-credentials 'git-push remote-name))
|
||||
(when (and (http-remote? url)
|
||||
@@ -784,6 +790,12 @@
|
||||
#:bytes? #f
|
||||
#:phase? #t))
|
||||
(lambda ()
|
||||
;; git_remote_create installs a fetch refspec for the temporary remote.
|
||||
;; A successful push can therefore leave a remote-tracking ref such as
|
||||
;; refs/remotes/racket-git-push-.../main behind. Remove all refs owned
|
||||
;; by the temporary remote before deleting its configuration.
|
||||
(with-handlers ([exn:fail? void])
|
||||
(remove-temporary-remote-refs! repo temp-name))
|
||||
(define config (git_repository_config repo))
|
||||
(for ([suffix (in-list '("url" "fetch" "push"))])
|
||||
(with-handlers ([exn:fail? void])
|
||||
|
||||
+10
-1
@@ -2,7 +2,8 @@
|
||||
|
||||
(require rackunit
|
||||
racket/file
|
||||
git)
|
||||
git
|
||||
libgit2)
|
||||
|
||||
(define tmp (make-temporary-file "racket-git-remote-test~a" 'directory))
|
||||
(define origin (build-path tmp "origin.git"))
|
||||
@@ -10,6 +11,11 @@
|
||||
(define b (build-path tmp "b"))
|
||||
(define c (build-path tmp "c"))
|
||||
|
||||
(define (temporary-push-refs)
|
||||
(filter (lambda (name)
|
||||
(regexp-match? #rx"^refs/remotes/racket-git-push-" name))
|
||||
(git_reference_list (git_repository_open (current-directory)))))
|
||||
|
||||
(define (configure!)
|
||||
(git 'config "user.name" "Racket Git Test")
|
||||
(git 'config "user.email" "racket-git-test@example.invalid"))
|
||||
@@ -40,6 +46,7 @@
|
||||
(collect-garbage)
|
||||
(collect-garbage)
|
||||
(define push-text (get-output-string push-out))
|
||||
(check-equal? (temporary-push-refs) '())
|
||||
(check-true (regexp-match? #rx"\\[git\\] push origin/master" push-text))
|
||||
(check-true (regexp-match? #rx"\\[git\\] push origin/master: done" push-text))
|
||||
;; A real push reports transfer progress, but the FFI callback itself only
|
||||
@@ -65,8 +72,10 @@
|
||||
(git 'add "value.txt")
|
||||
(git 'commit "two")
|
||||
(git 'push)
|
||||
(check-equal? (temporary-push-refs) '())
|
||||
(git 'tag "v2")
|
||||
(git 'push-tag "v2")
|
||||
(check-equal? (temporary-push-refs) '())
|
||||
(define push-tag-quiet-out (open-output-string))
|
||||
(parameterize ([current-output-port push-tag-quiet-out])
|
||||
(git 'push-tag "v2" #:quiet #t))
|
||||
|
||||
Reference in New Issue
Block a user