racket/collects/meta/drdr/replay.rkt
2010-11-11 15:59:50 -07:00

30 lines
839 B
Racket

#lang racket
(require (prefix-in racket: racket)
"formats.rkt"
"status.rkt")
(define replay-event
(match-lambda
[(struct stdout (bs))
(fprintf (current-output-port) "~a\n" bs)]
[(struct stderr (bs))
(fprintf (current-error-port) "~a\n" bs)]))
(define (replay-status s)
(for-each replay-event (status-output-log s))
#;(when (timeout? s)
(fprintf (current-error-port) "[replay-log] TIMEOUT!\n"))
#;(when (exit? s)
(fprintf (current-error-port) "[replay-log] Exit code: ~a\n" (exit-code s)))
#;(printf "[replay-log] Took ~a\n"
(format-duration-ms (status-duration s)))
(replay-exit-code s))
(define (replay-exit-code s)
(when (exit? s)
(racket:exit (exit-code s))))
(provide/contract
[replay-exit-code (status? . -> . void)]
[replay-status (status? . -> . void)])