suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix process id sorting in future visualizer

Browse Source
This commit is contained in:
James Swaine 2012-08-11 09:20:57 -05:00
parent 7aec4f6c7e
commit 3cd4efe201
2 changed files with 20 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/future-visualizer/private/visualizer-data.rkt
View File

@ -34,7 +34,9 @@
runtime-synchronization-event?
gc-event?
final-event?
relative-time)
relative-time
event-or-gc-time
proc-id-or-gc<?)
(define-struct future-event (future-id process-id what time prim-name user-data)
#:prefab)
@ -128,8 +130,9 @@
(define (op-name evt)
(cond
[(event? evt) (event-prim-name evt)]
[(indexed-future-event? evt) (future-event-prim-name (indexed-future-event-fevent evt))]
[(future-event? evt) (future-event-prim-name evt)]))
[(indexed-future-event? evt) (op-name (indexed-future-event-fevent evt))]
[(future-event? evt) (future-event-prim-name evt)]
[(gc-info? evt) 'gc]))
;;event-what : (or event indexed-future-event future-event) -> symbol
(define (what evt)
@ -143,8 +146,9 @@
(define (process-id evt)
(cond
[(event? evt) (event-proc-id evt)]
[(indexed-future-event? evt) (future-event-process-id (indexed-future-event-fevent evt))]
[(future-event? evt) (future-event-process-id evt)]))
[(indexed-future-event? evt) (process-id (indexed-future-event-fevent evt))]
[(future-event? evt) (future-event-process-id evt)]
[(gc-info? evt) RT-THREAD-ID]))
;;touch-event? : (or event indexed-future-event future-event) -> symbol
(define (touch-event? evt)
@ -249,8 +253,8 @@
;;proc-id-or-gc<? : (or number symbol) (or number symbol) -> bool
(define (proc-id-or-gc<? a b)
(cond
[(equal? a 'gc) #t]
[(equal? b 'gc) #t]
[(equal? b 'gc) #f]
[(equal? a 'gc) #t]
[else (< a b)]))
;Produces a vector of vectors, where each inner vector contains

12
collects/tests/future/trace.rkt
View File

@ -25,7 +25,7 @@ Invariants:
[(_ log)
(with-syntax ([line (syntax-line stx)])
#'(let ([time-sorted (sort log
#:key (λ (e) (future-event-time (indexed-future-event-fevent e)))
#:key (λ (e) (event-or-gc-time (indexed-future-event-fevent e)))
<)])
(for ([e (in-list time-sorted)]
[i (in-naturals)])
@ -36,7 +36,7 @@ Invariants:
occurs at actual index ~a\n"
line
(indexed-future-event-index e)
(future-event-time (indexed-future-event-fevent e))
(event-or-gc-time (indexed-future-event-fevent e))
i)))))]))
(cond
@ -83,7 +83,13 @@ Invariants:
(check-true (list? (memf allocation-event? log4)) "No allocation events found in log4")
(define ae (findf allocation-event? log4))
(check-true (allocation-event? ae))
(check-true (runtime-synchronization-event? ae))]
(check-true (runtime-synchronization-event? ae))
(check-true (proc-id-or-gc<? 'gc 0))
(check-false (proc-id-or-gc<? 0 'gc))
(check-false (proc-id-or-gc<? 'gc 'gc))
(check-true (proc-id-or-gc<? 0 1))
(check-false (proc-id-or-gc<? 1 0))]
[else
(define l (trace-futures (let ([f (future (λ () (printf "hello\n")))])
(sleep 0.1)