Adding branch information to commits

This commit is contained in:
Jay McCarthy 2012-01-11 13:05:02 -07:00
parent acc95cbb56
commit 32d1060c33
2 changed files with 43 additions and 11 deletions

View File

@ -153,14 +153,21 @@
".." ,(substring end-commit 0 8)))) ".." ,(substring end-commit 0 8))))
,@(append-map ,@(append-map
(match-lambda (match-lambda
[(struct git-merge (hash author date msg from to)) [(or (and (struct git-merge (hash author date msg from to))
(app (λ (x) #f) branch))
(struct git-merge* (branch hash author date msg from to)))
; Don't display these "meaningless" commits ; Don't display these "meaningless" commits
empty] empty]
[(struct git-diff (hash author date msg mfiles)) [(or (and (struct git-diff (hash author date msg mfiles))
(app (λ (x) #f) branch))
(struct git-diff* (branch hash author date msg mfiles)))
(define cg-id (symbol->string (gensym 'changes))) (define cg-id (symbol->string (gensym 'changes)))
(define ccss-id (define ccss-id
(symbol->string (gensym 'changes))) (symbol->string (gensym 'changes)))
`((tr `(,@(if branch
(list `(tr ([class "branch"]) (td "Branch:") (td ,branch)))
empty)
(tr
([class "hash"]) ([class "hash"])
(td "Commit:") (td "Commit:")
(td (td
@ -649,7 +656,7 @@
@p{The timing files are a list of S-expressions. Their grammar is: @code{(push duration ((cpu real gc) ...))} where @code{push} is an integer, @code{duration} is an inexact millisecond, and @code{cpu}, @code{real}, and @code{gc} are parsed from the @code{time-apply} function.} @p{The timing files are a list of S-expressions. Their grammar is: @code{(push duration ((cpu real gc) ...))} where @code{push} is an integer, @code{duration} is an inexact millisecond, and @code{cpu}, @code{real}, and @code{gc} are parsed from the @code{time-apply} function.}
@h1{Why are some pushes missing?} @h1{Why are some pushes missing?}
@p{Some pushes are missing because they only modify branches. Only pushes that change the @code{master} branch are tested.} @p{Some pushes are missing because they only modify branches. Only pushes that change the @code{master} or @code{release} branch are tested.}
@h1{How do I make the most use of DrDr?} @h1{How do I make the most use of DrDr?}
@p{So DrDr can be effective with all testing packages and untested code, it only pays attention to error output and non-zero exit codes. You can make the most of this strategy by ensuring that when your tests are run successfully they have no STDERR output and exit cleanly, but have both when they fail.} @p{So DrDr can be effective with all testing packages and untested code, it only pays attention to error output and non-zero exit codes. You can make the most of this strategy by ensuring that when your tests are run successfully they have no STDERR output and exit cleanly, but have both when they fail.}

View File

@ -82,6 +82,10 @@
(define-struct (git-diff git-commit) (mfiles) #:prefab) (define-struct (git-diff git-commit) (mfiles) #:prefab)
(define-struct (git-merge git-commit) (from to) #:prefab) (define-struct (git-merge git-commit) (from to) #:prefab)
(define-struct git-commit* (branch hash author date msg) #:prefab)
(define-struct (git-diff* git-commit*) (mfiles) #:prefab)
(define-struct (git-merge* git-commit*) (from to) #:prefab)
(define (read-until-empty-line in-p) (define (read-until-empty-line in-p)
(let loop () (let loop ()
(let ([l (read-line in-p)]) (let ([l (read-line in-p)])
@ -94,7 +98,7 @@
[else [else
(list* (regexp-replace #rx"^ +" l "") (loop))])))) (list* (regexp-replace #rx"^ +" l "") (loop))]))))
(define (read-commit in-p) (define (read-commit branch in-p)
(match (read-line in-p) (match (read-line in-p)
[(? eof-object?) [(? eof-object?)
#f] #f]
@ -105,24 +109,24 @@
(match-define (regexp #rx"^Date: +(.+)$" (list _ date)) (read-line in-p)) (match-define (regexp #rx"^Date: +(.+)$" (list _ date)) (read-line in-p))
(define _1 (read-line in-p)) (define _1 (read-line in-p))
(define msg (read-until-empty-line in-p)) (define msg (read-until-empty-line in-p))
(make-git-merge hash author date msg from to)] (make-git-merge* branch hash author date msg from to)]
[(regexp #rx"^Author: +(.+)$" (list _ author)) [(regexp #rx"^Author: +(.+)$" (list _ author))
(match-define (regexp #rx"^Date: +(.+)$" (list _ date)) (read-line in-p)) (match-define (regexp #rx"^Date: +(.+)$" (list _ date)) (read-line in-p))
(define _1 (read-line in-p)) (define _1 (read-line in-p))
(define msg (read-until-empty-line in-p)) (define msg (read-until-empty-line in-p))
(define mfiles (read-until-empty-line in-p)) (define mfiles (read-until-empty-line in-p))
(make-git-diff hash author date msg mfiles)])])) (make-git-diff* branch hash author date msg mfiles)])]))
(define port-empty? port-closed?) (define port-empty? port-closed?)
(define (read-commits in-p) (define (read-commits branch in-p)
(cond (cond
[(port-empty? in-p) [(port-empty? in-p)
empty] empty]
[(read-commit in-p) [(read-commit branch in-p)
=> (lambda (c) => (lambda (c)
(printf "~S\n" c) (printf "~S\n" c)
(list* c (read-commits in-p)))] (list* c (read-commits branch in-p)))]
[else [else
empty])) empty]))
@ -137,7 +141,7 @@
(parameterize (parameterize
([current-directory repo]) ([current-directory repo])
(system/output-port (system/output-port
#:k read-commits #:k (curry read-commits branch)
(git-path) (git-path)
"--no-pager" "log" "--date=iso" "--name-only" "--no-merges" "--no-pager" "log" "--date=iso" "--name-only" "--no-merges"
(format "~a..~a" start-commit end-commit))))))) (format "~a..~a" start-commit end-commit)))))))
@ -164,6 +168,27 @@
[msg (listof string?)] [msg (listof string?)]
[from string?] [from string?]
[to string?])] [to string?])]
[struct git-commit*
([branch string?]
[hash string?]
[author string?]
[date string?]
[msg (listof string?)])]
[struct git-diff*
([branch string?]
[hash string?]
[author string?]
[date string?]
[msg (listof string?)]
[mfiles (listof string?)])]
[struct git-merge*
([branch string?]
[hash string?]
[author string?]
[date string?]
[msg (listof string?)]
[from string?]
[to string?])]
[get-scm-commit-msg (exact-nonnegative-integer? path-string? . -> . git-push?)]) [get-scm-commit-msg (exact-nonnegative-integer? path-string? . -> . git-push?)])
(define (git-push-previous-commit gp) (define (git-push-previous-commit gp)