#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 c (build-path tmp "c")) (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)) (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) (define push-text (get-output-string push-out)) (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 ;; records state. A normal Racket thread performs the output. (check-true (regexp-match? #rx"100%" push-text)) (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") (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") (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") (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")) (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 (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))) ;; HTTPS push without configured credentials must fail before entering libgit2. (let ([tmp2 (make-temporary-file "racket-git-https-test~a" 'directory)]) (dynamic-wind void (lambda () (parameterize ([current-directory tmp2]) (git 'init) (configure!) (call-with-output-file "x.txt" #:exists 'truncate/replace (lambda (out) (displayln "x" out))) (git 'add "x.txt") (git 'commit "x") (git 'remote 'add "origin" "https://example.invalid/private/repo.git") (check-exn #rx"no HTTPS credentials are stored" (lambda () (git 'push))))) (lambda () (delete-directory/files tmp2))))