initial commit

coverage.rkt

@@ -0,0 +1,3 @@
+(module coverage '#%kernel 
+  (#%provide coverage)
+  (define-values (coverage) (make-hash)))

main.rkt

@@ -0,0 +1,24 @@
+#lang racket/base
+(provide test-files clear-coverage!)
+(require racket/dict
+         racket/function
+         syntax/modread
+         "coverage.rkt"
+         "strace.rkt")
+
+
+(define ns (make-base-empty-namespace))
+(namespace-attach-module (current-namespace) "coverage.rkt" ns)
+
+(define (test-files . paths)
+  (for ([p paths])
+    (define stx 
+      (with-module-reading-parameterization (thunk (read-syntax p (open-input-file p)))))
+    (define anned (annotate-top (expand stx) (namespace-base-phase ns)))
+    (eval-syntax anned ns))
+  coverage)
+
+(define (clear-coverage!)
+  (dict-clear! coverage)
+  (set! ns (make-base-empty-namespace))
+  (namespace-attach-module (current-namespace) "coverage.rkt" ns))

strace.rkt

@@ -0,0 +1,24 @@
+#lang racket/base
+(provide annotate-top)
+(require errortrace/stacktrace
+         racket/function
+         racket/unit
+         "coverage.rkt")
+
+(define (with-mark src dest phase) dest)
+(define test-coverage-enabled (make-parameter #t))
+
+(define (initialize-test-coverage-point stx)
+  (hash-set! coverage stx #f))
+(define (test-covered stx)
+  (thunk (hash-set! coverage stx #t)))
+
+(define profile-key (gensym))
+
+(define profiling-enabled (make-parameter #f))
+(define initialize-profile-point void)
+(define (register-profile-start . a) #f)
+(define register-profile-done void)
+
+(define-values/invoke-unit/infer stacktrace@)
+