FV: fix drawing code to handle truncated logs, tests
This commit is contained in:
James Swaine
parent
4a64b81562
commit
7c8f0ce093
|
|
@ -32,6 +32,7 @@
|
|||
synchronization-event?
|
||||
runtime-synchronization-event?
|
||||
gc-event?
|
||||
work-event?
|
||||
final-event?
|
||||
relative-time
|
||||
event-or-gc-time
|
||||
|
|
@ -64,7 +65,7 @@
|
|||
end-time ;Absolute end time
|
||||
proc-timelines ;(listof process-timeline)
|
||||
future-timelines ;Hash of (future id --o--> (listof event))
|
||||
gc-timeline ;(listof event), where each event is a GC
|
||||
gc-timeline ;process-timeline where proc-id == 'gc, and each event is a GC
|
||||
all-events ;(listof event)
|
||||
real-time ;Total amount of time for the trace (in ms)
|
||||
num-futures ;Number of futures created
|
||||
|
|
@ -168,6 +169,12 @@
|
|||
[(block sync) #t]
|
||||
[else #f]))
|
||||
|
||||
;;work-event : (or event indexed-future-event future-event) -> bool
|
||||
(define (work-event? evt)
|
||||
(case (what evt)
|
||||
[(start-work start-0-work) #t]
|
||||
[else #f]))
|
||||
|
||||
;;runtime-thread-evt? : (or event indexed-future-event future-event) -> bool
|
||||
(define (runtime-thread-evt? evt)
|
||||
(= (process-id evt) RT-THREAD-ID))
|
||||
|
|
@ -428,7 +435,7 @@
|
|||
(build-creation-graph future-tl-hash)))
|
||||
(connect-event-chains! tr)
|
||||
(connect-target-fid-events! tr)
|
||||
tr)
|
||||
tr)
|
||||
|
||||
;;build-rtcall-hash : (listof event) -> (values (blocking_prim -o-> count) (sync_prim -o-> count) (fid -o-> rtcall-info)
|
||||
(define (build-rtcall-hashes evts)
|
||||
|
|
|
|||
|
|
@ -294,25 +294,32 @@
|
|||
|
||||
;;Set pixel widths of segments with variable widths, e.g.
|
||||
;;work and GC events
|
||||
;;adjust-variable-width-segs! : (listof segment) -> void
|
||||
(define (adjust-variable-width-segs! segs)
|
||||
;;adjust-variable-width-segs! : (listof segment) uint -> void
|
||||
(define (adjust-variable-width-segs! segs max-x)
|
||||
(cond
|
||||
[(empty? segs) void]
|
||||
[else
|
||||
(define cur (car segs))
|
||||
(case (event-type (segment-event cur))
|
||||
[(start-work start-0-work)
|
||||
(define next-seg (segment-next-proc-seg cur))
|
||||
;Because we are truncating logs after they reach a certain size,
|
||||
;next-seg could be #f (where before it was safe to assume that a work segment
|
||||
;was always followed by another segment).
|
||||
(define x-end (if next-seg
|
||||
(segment-x next-seg)
|
||||
max-x))
|
||||
(set-segment-width! cur (max MIN-SEG-WIDTH
|
||||
(- (segment-x (segment-next-proc-seg cur)) (segment-x cur))))
|
||||
(adjust-variable-width-segs! (cdr segs))]
|
||||
(- x-end (segment-x cur))))
|
||||
(adjust-variable-width-segs! (cdr segs) max-x)]
|
||||
[(gc)
|
||||
(cond
|
||||
[(empty? (cdr segs)) void]
|
||||
[else
|
||||
(set-segment-width! cur (max MIN-SEG-WIDTH
|
||||
(- (segment-x (car (cdr segs))) (segment-x cur))))
|
||||
(adjust-variable-width-segs! (cdr segs))])]
|
||||
[else (adjust-variable-width-segs! (cdr segs))])]))
|
||||
(adjust-variable-width-segs! (cdr segs) max-x)])]
|
||||
[else (adjust-variable-width-segs! (cdr segs) max-x)])]))
|
||||
|
||||
;;connect-segments! : (listof segment) -> void
|
||||
(define (connect-segments! segs)
|
||||
|
|
@ -381,8 +388,6 @@
|
|||
(values (cons seg segs)
|
||||
new-delta
|
||||
(max largest-x (+ offset segw) #;last-right-edge))))
|
||||
(for ([s (in-list sgs)])
|
||||
(printf "seg x: ~a, seg y: ~a\n" (segment-x s) (segment-y s)))
|
||||
(values sgs x-extent))
|
||||
|
||||
;;calc-segments : trace uint uint -> (values frame-info (listof segment))
|
||||
|
|
@ -392,11 +397,11 @@
|
|||
(define max-y (* TIMELINE-ROW-HEIGHT (length (trace-proc-timelines tr))))
|
||||
(define-values (segments x)
|
||||
(build-seg-layout timeToPixModifier evts tr max-y))
|
||||
(define max-x (+ MIN-SEG-WIDTH (round x)))
|
||||
(define ordered-segs (reverse segments))
|
||||
(connect-segments! ordered-segs)
|
||||
(adjust-variable-width-segs! ordered-segs)
|
||||
(adjust-variable-width-segs! ordered-segs max-x)
|
||||
(define ticks (calc-ticks ordered-segs timeToPixModifier tr))
|
||||
(define max-x (+ MIN-SEG-WIDTH (round x)))
|
||||
(values (frame-info max-x
|
||||
max-y
|
||||
TIMELINE-ROW-HEIGHT
|
||||
|
|
|
|||
|
|
@ -97,19 +97,10 @@
|
|||
(values (min screen-w DEF-WINDOW-WIDTH)
|
||||
(min screen-h DEF-WINDOW-HEIGHT)))
|
||||
|
||||
(define COMFORTABLE-TL-LEN 5000)
|
||||
|
||||
(define (show-visualizer #:timeline [timeline #f])
|
||||
(define the-tl (if timeline timeline (timeline-events)))
|
||||
(printf "trace length: ~a\n" (length the-tl))
|
||||
(when (empty? the-tl)
|
||||
(error 'show-visualizer "No future log messages found."))
|
||||
(when (> (length the-tl) COMFORTABLE-TL-LEN)
|
||||
(log-warning (format
|
||||
"show-visualizer: truncating log to ~a, dropped ~a messages"
|
||||
COMFORTABLE-TL-LEN
|
||||
(- (length the-tl) COMFORTABLE-TL-LEN)))
|
||||
(set! the-tl (take the-tl COMFORTABLE-TL-LEN)))
|
||||
(define the-trace (build-trace the-tl))
|
||||
(define-values (winw winh) (get-window-size))
|
||||
;The event segment we are currently mousing over
|
||||
|
|
|
|||
|
|
@ -304,7 +304,9 @@
|
|||
(indexed-future-event 4 (future-event 1 1 'end-work 15.0 #f 0))))
|
||||
(let ([tr (build-trace gc-log1)])
|
||||
(check-true (not (findf gc-event? (trace-all-events tr))))
|
||||
(check-equal? (trace-num-gcs tr) 0))
|
||||
(check-equal? (trace-num-gcs tr) 0)
|
||||
(check-equal? (process-timeline-proc-id (trace-gc-timeline tr)) 'gc)
|
||||
(check-equal? (length (process-timeline-events (trace-gc-timeline tr))) 0))
|
||||
|
||||
(define gc-log2
|
||||
(list
|
||||
|
|
@ -315,6 +317,8 @@
|
|||
(indexed-future-event 4 (future-event 1 1 'end-work 21.0 #f 0))))
|
||||
(let ([tr (build-trace gc-log2)])
|
||||
(check-equal? (length (filter gc-event? (trace-all-events tr))) 1)
|
||||
(check-equal? (process-timeline-proc-id (trace-gc-timeline tr)) 'gc)
|
||||
(check-equal? (length (process-timeline-events (trace-gc-timeline tr))) 1)
|
||||
(check-equal? (trace-num-gcs tr) 1))
|
||||
|
||||
(define gc-log3
|
||||
|
|
@ -328,12 +332,19 @@
|
|||
(let-values ([(tr finfo segs ticks) (compile-trace-data gc-log3)])
|
||||
(check-equal? (length (filter gc-event? (trace-all-events tr))) 2)
|
||||
(check-equal? (trace-num-gcs tr) 2)
|
||||
(check-equal? (length (trace-proc-timelines tr)) 2)
|
||||
(check-equal? (process-timeline-proc-id (trace-gc-timeline tr)) 'gc)
|
||||
(check-equal? (length (process-timeline-events (trace-gc-timeline tr))) 2)
|
||||
(let ([gc-segs (filter (λ (s) (gc-event? (segment-event s))) segs)])
|
||||
(check-equal? (length gc-segs) 2)
|
||||
(for ([gs (in-list gc-segs)])
|
||||
(check-true (= (segment-height gs) (frame-info-adjusted-height finfo)))
|
||||
(check-true (> (segment-width gs) 10)))))
|
||||
|
||||
(check-true (work-event? (future-event #f 0 'start-work 1.0 #f 0)))
|
||||
(check-true (work-event? (future-event #f 0 'start-0-work 2.0 #f 0)))
|
||||
(check-false (work-event? (future-event #f 0 'end-work 1.0 #f 0)))
|
||||
|
||||
;Graph drawing tests
|
||||
(let* ([nodea (drawable-node (node 'a '()) 5 5 10 0 0 '() 10)]
|
||||
[center (drawable-node-center nodea)])
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user