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))))
,@(append-map
(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
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 ccss-id
(symbol->string (gensym 'changes)))
`((tr
`(,@(if branch
(list `(tr ([class "branch"]) (td "Branch:") (td ,branch)))
empty)
(tr
([class "hash"])
(td "Commit:")
(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.}
@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?}
@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-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)
(let loop ()
(let ([l (read-line in-p)])
@ -94,7 +98,7 @@
[else
(list* (regexp-replace #rx"^ +" l "") (loop))]))))
(define (read-commit in-p)
(define (read-commit branch in-p)
(match (read-line in-p)
[(? eof-object?)
#f]
@ -105,24 +109,24 @@
(match-define (regexp #rx"^Date: +(.+)$" (list _ date)) (read-line in-p))
(define _1 (read-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))
(match-define (regexp #rx"^Date: +(.+)$" (list _ date)) (read-line in-p))
(define _1 (read-line in-p))
(define msg (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 (read-commits in-p)
(define (read-commits branch in-p)
(cond
[(port-empty? in-p)
empty]
[(read-commit in-p)
[(read-commit branch in-p)
=> (lambda (c)
(printf "~S\n" c)
(list* c (read-commits in-p)))]
(list* c (read-commits branch in-p)))]
[else
empty]))
@ -137,7 +141,7 @@
(parameterize
([current-directory repo])
(system/output-port
#:k read-commits
#:k (curry read-commits branch)
(git-path)
"--no-pager" "log" "--date=iso" "--name-only" "--no-merges"
(format "~a..~a" start-commit end-commit)))))))
@ -164,6 +168,27 @@
[msg (listof string?)]
[from 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?)])
(define (git-push-previous-commit gp)