FV: fix drawing code to handle truncated logs, tests

collects/future-visualizer/private/visualizer-data.rkt

@@ -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) 

collects/future-visualizer/private/visualizer-drawing.rkt

@@ -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
+;;adjust-variable-width-segs! : (listof segment) uint -> void
-(define (adjust-variable-width-segs! segs) 
+(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)))) 
+                                     (- x-end (segment-x cur)))) 
-        (adjust-variable-width-segs! (cdr segs))]
+        (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))])] 
+           (adjust-variable-width-segs! (cdr segs) max-x)])] 
-       [else (adjust-variable-width-segs! (cdr segs))])]))
+       [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 

collects/future-visualizer/private/visualizer-gui.rkt

@@ -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

collects/tests/future/visualizer.rkt

@@ -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)])