#lang racket/base 
(require rackunit 
         racket/vector
         racket/future/private/visualizer-drawing
         racket/future/private/visualizer-data 
         racket/future/private/display
         "bad-trace1.rkt")  

(define (compile-trace-data logs) 
  (define tr (build-trace logs)) 
  (define-values (finfo segs) (calc-segments tr)) 
  (values tr 
          finfo 
          segs 
          (frame-info-timeline-ticks finfo)))

;Display tests 
(let ([vr (viewable-region 3 3 500 500)]) 
  (for ([i (in-range 4 503)]) 
    (check-true (in-viewable-region-horiz vr i) 
                (format "~a should be in ~a" 
                        i 
                        vr)))
  (for ([i (in-range 0 2)]) 
    (check-false (in-viewable-region-horiz vr i) 
                 (format "~a should not be in ~a" 
                         i 
                         vr))
  (for ([i (in-range 504 1000)]) 
    (check-false (in-viewable-region-horiz vr i) 
                 (format "~a should not be in ~a" 
                         i 
                         vr)))))

(let ([vr (viewable-region 0 0 732 685)]) 
  (check-true (in-viewable-region-horiz vr 10)) 
  (check-true (in-viewable-region-horiz vr 63.0)) 
  (check-true (in-viewable-region-horiz vr 116.0)) 
  (check-true (in-viewable-region-horiz vr 169.0)) 
  (check-true (in-viewable-region-horiz vr 222)))

(let ([vr (viewable-region 0 0 732 685)] 
      [ticks (list (timeline-tick 222.0 #f 0.4999999999999982) 
                   (timeline-tick 169.0 #f 0.3999999999999986) 
                   (timeline-tick 116.0 #f 0.29999999999999893) 
                   (timeline-tick 63.0 #f 0.1999999999999993) 
                   (timeline-tick 10 #f 0.09999999999999964))]) 
  (define in-vr (filter (λ (t) 
                          (in-viewable-region-horiz vr (timeline-tick-x t))) 
                        ticks)) 
  (check-equal? (length in-vr) 5))

;Trace compilation tests
(let* ([future-log (list (indexed-fevent 0 (future-event 0 0 'create 0 #f 0)) 
                         (indexed-fevent 1 (future-event 0 1 'start-work 1 #f #f)) 
                         (indexed-fevent 2 (future-event 0 1 'end-work 2 #f #f)) 
                         (indexed-fevent 3 (future-event 0 0 'complete 3 #f #f)))] 
       [organized (organize-output future-log)]) 
  (check-equal? (vector-length organized) 2) 
  (let ([proc0log (vector-ref organized 0)] 
        [proc1log (vector-ref organized 1)]) 
    (check-equal? (vector-length proc0log) 2) 
    (check-equal? (vector-length proc1log) 2)))

(let* ([future-log (list (indexed-fevent 0 (future-event #f 0 'create 0 #f 0)) 
                         (indexed-fevent 1 (future-event 0 1 'start-work 1 #f #f)) 
                         (indexed-fevent 2 (future-event 0 1 'end-work 2 #f #f)) 
                         (indexed-fevent 3 (future-event 0 0 'complete 3 #f #f)))] 
       [trace (build-trace future-log)] 
       [evts (trace-all-events trace)])
  (check-equal? (length evts) 4) 
  (check-equal? (length (filter (λ (e) (event-next-future-event e)) evts)) 2) 
  (check-equal? (length (filter (λ (e) (event-next-targ-future-event e)) evts)) 1) 
  (check-equal? (length (filter (λ (e) (event-prev-targ-future-event e)) evts)) 1))

(let* ([future-log (list (indexed-fevent 0 (future-event 0 0 'create 0 #f 0)) 
                         (indexed-fevent 1 (future-event 1 0 'create 1 #f 1)) 
                         (indexed-fevent 2 (future-event 0 1 'start-work 2 #f #f)) 
                         (indexed-fevent 3 (future-event 1 2 'start-work 2 #f #f))
                         (indexed-fevent 4 (future-event 0 1 'end-work 4 #f #f)) 
                         (indexed-fevent 5 (future-event 0 0 'complete 5 #f #f)) 
                         (indexed-fevent 6 (future-event 1 2 'end-work 5 #f #f)) 
                         (indexed-fevent 7 (future-event 1 0 'complete 7 #f #f)))] 
       [organized (organize-output future-log)]) 
  (check-equal? (vector-length organized) 3) 
  (let ([proc0log (vector-ref organized 0)] 
        [proc1log (vector-ref organized 1)] 
        [proc2log (vector-ref organized 2)]) 
    (check-equal? (vector-length proc0log) 4) 
    (check-equal? (vector-length proc1log) 2)
    (check-equal? (vector-length proc2log) 2) 
    (for ([msg (in-vector (vector-map indexed-fevent-fevent proc0log))])  
      (check-equal? (future-event-process-id msg) 0)) 
    (for ([msg (in-vector (vector-map indexed-fevent-fevent proc1log))]) 
      (check-equal? (future-event-process-id msg) 1)) 
    (for ([msg (in-vector (vector-map indexed-fevent-fevent proc2log))]) 
      (check-equal? (future-event-process-id msg) 2))))

;Drawing calculation tests
(let* ([future-log (list (indexed-fevent 0 (future-event #f 0 'create 0 #f 0)) 
                         (indexed-fevent 1 (future-event 0 1 'start-work 1 #f #f)) 
                         (indexed-fevent 2 (future-event 0 1 'end-work 2 #f #f)) 
                         (indexed-fevent 3 (future-event 0 0 'complete 3 #f #f)))] 
       [trace (build-trace future-log)]) 
  (let-values ([(finfo segments) (calc-segments trace)]) 
    (check-equal? (length segments) 4) 
    (check-equal? (length (filter (λ (s) (segment-next-future-seg s)) segments)) 2) 
    (check-equal? (length (filter (λ (s) (segment-next-targ-future-seg s)) segments)) 1) 
    (check-equal? (length (filter (λ (s) (segment-prev-targ-future-seg s)) segments)) 1)))

;Future=42
(let* ([future-log (list (indexed-fevent 0 (future-event #f 0 'create 0.05 #f 42)) 
                         (indexed-fevent 1 (future-event 42 1 'start-work 0.07 #f #f)) 
                         (indexed-fevent 2 (future-event 42 1 'end-work 0.3 #f #f)) 
                         (indexed-fevent 3 (future-event 42 0 'complete 1.2 #f #f)))] 
       [tr (build-trace future-log)])
  (define-values (finfo segs) (calc-segments tr))
  (define ticks (frame-info-timeline-ticks finfo))
  (check-equal? (length ticks) 11))

(define (check-seg-layout tr segs ticks) 
  (define (do-seg-check seg tick op adjective) 
    (define evt (segment-event seg))
    (check-true (op (segment-x seg) (timeline-tick-x tick)) 
                (format "Event at time ~a [x:~a] (~a) should be ~a tick at time ~a [x:~a]"
                        (relative-time tr (event-start-time evt))
                        (segment-x seg)
                        (event-type evt)
                        adjective
                        (exact->inexact (timeline-tick-rel-time tick)) 
                        (timeline-tick-x tick))))
  (for ([seg (in-list segs)]) 
    (let* ([evt (segment-event seg)] 
           [evt-rel-time (relative-time tr (event-start-time evt))])
      (for ([tick (in-list ticks)]) 
        (let ([ttime (timeline-tick-rel-time tick)])
          (cond 
            [(< evt-rel-time ttime) 
             (do-seg-check seg tick <= "before")] 
            [(= evt-rel-time ttime) 
             (do-seg-check seg tick = "equal to")]
            [(> evt-rel-time ttime) 
             (do-seg-check seg tick >= "after")]))))))

;Test layout for 'bad' mandelbrot trace 
(let-values ([(tr finfo segs ticks) (compile-trace-data BAD-TRACE-1)]) 
  (check-seg-layout tr segs ticks))
             
(let* ([future-log (list (indexed-fevent 0 (future-event #f 0 'create 0.05 #f 42)) 
                         (indexed-fevent 1 (future-event 42 1 'start-work 0.09 #f #f)) 
                         (indexed-fevent 2 (future-event 42 1 'suspend 1.1 #f #f)) 
                         (indexed-fevent 3 (future-event 42 1 'resume 1.101 #f #f)) 
                         (indexed-fevent 4 (future-event 42 1 'suspend 1.102 #f #f)) 
                         (indexed-fevent 5 (future-event 42 1 'resume 1.103 #f #f)) 
                         (indexed-fevent 6 (future-event 42 1 'start-work 1.104 #f #f)) 
                         (indexed-fevent 7 (future-event 42 1 'complete 1.41 #f #f)) 
                         (indexed-fevent 8 (future-event 42 1 'end-work 1.42 #f #f)) 
                         (indexed-fevent 9 (future-event 42 0 'result 1.43 #f #f)))] 
       [tr (build-trace future-log)]) 
  (define-values (finfo segs) (calc-segments tr)) 
  (define ticks (frame-info-timeline-ticks finfo))
  (check-seg-layout tr segs ticks))

(let* ([future-log (list (indexed-fevent 0 (future-event #f 0 'create 0 #f 0)) 
                         (indexed-fevent 1 (future-event 0 1 'start-work 1 #f #f)) 
                         (indexed-fevent 2 (future-event 0 1 'end-work 2 #f #f)) 
                         (indexed-fevent 3 (future-event 0 0 'complete 3 #f #f)))] 
       [trace (build-trace future-log)]) 
  (check-equal? (trace-start-time trace) 0) 
  (check-equal? (trace-end-time trace) 3) 
  (check-equal? (length (trace-proc-timelines trace)) 2) 
  (check-equal? (trace-real-time trace) 3) 
  (check-equal? (trace-num-futures trace) 1) 
  (check-equal? (trace-num-blocks trace) 0) 
  (check-equal? (trace-num-syncs trace) 0) 
  (let ([proc0tl (list-ref (trace-proc-timelines trace) 0)] 
        [proc1tl (list-ref (trace-proc-timelines trace) 1)]) 
    (check-equal? (process-timeline-start-time proc0tl) 0) 
    (check-equal? (process-timeline-end-time proc0tl) 3) 
    (check-equal? (process-timeline-start-time proc1tl) 1) 
    (check-equal? (process-timeline-end-time proc1tl) 2) 
    (let ([proc0segs (process-timeline-events proc0tl)] 
          [proc1segs (process-timeline-events proc1tl)]) 
      (check-equal? (length proc0segs) 2) 
      (check-equal? (length proc1segs) 2)
      (check-equal? (event-timeline-position (list-ref proc0segs 0)) 'start) 
      (check-equal? (event-timeline-position (list-ref proc0segs 1)) 'end)))) 

;Viewable region tests 
(define (make-seg-at x y w h) 
  (segment #f x y w h #f #f #f #f #f #f #f #f))

;;make-segs-with-times : (listof (or float (float . float))) -> (listof segment)
(define (make-segs-with-times . times) 
  (for/list ([t (in-list times)] [i (in-naturals)]) 
    (if (pair? t) 
        (make-seg-with-time i (car t) #:end-time (cdr t)) 
        (make-seg-with-time i t))))

;;make-seg-with-time : fixnum float [float] -> segment
(define (make-seg-with-time index real-start-time #:end-time [real-end-time real-start-time]) 
  (segment (event index
                  real-start-time 
                  real-end-time 
                  0 0 0 0 0 0 0 0 0 0 0 0 0 #f) 
           0 0 0 0 #f #f #f #f #f #f #f #f))
                   

(let ([vregion (viewable-region 20 30 100 100)] 
      [seg1 (make-seg-at 0 5 10 10)] 
      [seg2 (make-seg-at 20 30 5 5)] 
      [seg3 (make-seg-at 150 35 5 5)]) 
  (check-false ((seg-in-vregion vregion) seg1)) 
  (check-true ((seg-in-vregion vregion) seg2)) 
  (check-false ((seg-in-vregion vregion) seg3)))

;segs-equal-or-later 
(let ([segs (make-segs-with-times 0.1 
                                  0.3 
                                  1.2 
                                  (cons 1.4 1.9) 
                                  2.4 
                                  2.8 
                                  3.1)]) 
  (check-equal? (length (segs-equal-or-later 0.1 segs)) 7) 
  (check-equal? (length (segs-equal-or-later 0.3 segs)) 6) 
  (check-equal? (length (segs-equal-or-later 1.2 segs)) 5) 
  (check-equal? (length (segs-equal-or-later 1.4 segs)) 4) 
  (check-equal? (length (segs-equal-or-later 2.4 segs)) 3) 
  (check-equal? (length (segs-equal-or-later 2.8 segs)) 2) 
  (check-equal? (length (segs-equal-or-later 3.1 segs)) 1) 
  (check-equal? (length (segs-equal-or-later 4.0 segs)) 0))

;Tick drawing  
(let ([l (list (indexed-fevent 0 (future-event #f 0 'create 10.0 #f 0))
               (indexed-fevent 1 (future-event 0 0 'start-work 11.0 #f #f)) 
               (indexed-fevent 2 (future-event 0 0 'end-work 20.0 #f #f)))])
  (define-values (tr finfo segs ticks) (compile-trace-data l)) 
  ;Check that number of ticks stays constant whatever the time->pixel modifier 
  (check-equal? (length ticks) 100)
  (check-equal? (length (calc-ticks segs 700 tr)) 100)
  (for ([i (in-range 0.1 20)]) 
    (check-equal? (length (calc-ticks segs i tr)) 
                  100 
                  (format "Wrong number of ticks for time->pix mod ~a\n" i)))
  (check-seg-layout tr segs ticks))

(let ([l (list (indexed-fevent 0 '#s(future-event #f 0 create 1334778395768.733 #f 3))
               (indexed-fevent 1 '#s(future-event 3 2 start-work 1334778395768.771 #f #f))
               (indexed-fevent 2 '#s(future-event 3 2 complete 1334778395864.648 #f #f))
               (indexed-fevent 3 '#s(future-event 3 2 end-work 1334778395864.652 #f #f)))]) 
  (define-values (tr finfo segs ticks) (compile-trace-data l))
  (define last-evt (indexed-fevent-fevent (list-ref l 3))) 
  (define first-evt (indexed-fevent-fevent (list-ref l 0))) 
  (define total-time (- (future-event-time last-evt) (future-event-time first-evt))) 
  (check-equal? (length ticks) (inexact->exact (floor (* 10 total-time)))))

(define mand-first 
  (list (indexed-fevent 0 '#s(future-event #f 0 create 1334779294212.415 #f 1))
        (indexed-fevent 1 '#s(future-event 1 1 start-work 1334779294212.495 #f #f))
        (indexed-fevent 2 '#s(future-event 1 1 sync 1334779294212.501 #f #f))
        (indexed-fevent 3 (future-event 1 0 'sync 1334779294221.128 'allocate_memory #f))
        (indexed-fevent 4 '#s(future-event 1 0 result 1334779294221.138 #f #f))
        (indexed-fevent 5 '#s(future-event 1 1 result 1334779294221.15 #f #f)))) 
(let-values ([(tr finfo segs ticks) (compile-trace-data mand-first)]) 
  (check-seg-layout tr segs ticks))