From bb81fec0d68dde007980d1763de53bb305dda5cd Mon Sep 17 00:00:00 2001
From: Spencer Florence <florence@ccs.neu.edu>
Date: Sun, 28 Dec 2014 22:24:14 -0600
Subject: [PATCH] now disabling test coverage when its not needed

---
 main.rkt   | 55 +++++++++++++++++++++++++++---------------------------
 raco.rkt   |  2 +-
 strace.rkt |  2 +-
 3 files changed, 30 insertions(+), 29 deletions(-)

diff --git a/main.rkt b/main.rkt
index 22711d6..61392e7 100644
--- a/main.rkt
+++ b/main.rkt
@@ -18,34 +18,35 @@
 ;; PathString * -> Boolean
 ;; Test files and build coverage map
 ;; returns true if all tests passed
-(define (test-files! . paths)
-  (clear-coverage!)
-  (for ([p paths])
-    (let loop ()
-      (define-values (loc type) (get-module-path (build-path p)))
-      (case type
-        [(zo so)
-         (delete-file loc)
-         (loop)]
-        [else (void)])))
-  (parameterize ([use-compiled-file-paths
-                  (cons (build-path "compiled" "better-test")
-                        (use-compiled-file-paths))]
-                 [current-compile (make-better-test-compile)])
-    (define tests-failed #f)
+(define (test-files!  #:coverage [coverage? #t] . paths)
+  (parameterize ([test-coverage-enabled coverage?])
+    (clear-coverage!)
     (for ([p paths])
-      (define old-check (current-check-handler))
-      (parameterize* ([current-namespace ns]
-                      [current-check-handler
-                       (lambda x
-                         (set! tests-failed #t)
-                         (apply old-check x))])
-        (eval `(dynamic-require '(file ,p) #f))
-        (namespace-require `(file ,p))
-        (define submod `(submod (file ,p) test))
-        (when (module-declared? submod)
-          (namespace-require submod))))
-    (not tests-failed)))
+      (let loop ()
+        (define-values (loc type) (get-module-path (build-path p)))
+        (case type
+          [(zo so)
+           (delete-file loc)
+           (loop)]
+          [else (void)])))
+    (parameterize ([use-compiled-file-paths
+                    (cons (build-path "compiled" "better-test")
+                          (use-compiled-file-paths))]
+                   [current-compile (make-better-test-compile)])
+      (define tests-failed #f)
+      (for ([p paths])
+        (define old-check (current-check-handler))
+        (parameterize* ([current-namespace ns]
+                        [current-check-handler
+                         (lambda x
+                           (set! tests-failed #t)
+                           (apply old-check x))])
+          (eval `(dynamic-require '(file ,p) #f))
+          (namespace-require `(file ,p))
+          (define submod `(submod (file ,p) test))
+          (when (module-declared? submod)
+            (namespace-require submod))))
+      (not tests-failed))))
 
 (define (make-better-test-compile)
   (define compile (current-compile))
diff --git a/raco.rkt b/raco.rkt
index c087fe8..4d4f9f9 100644
--- a/raco.rkt
+++ b/raco.rkt
@@ -20,7 +20,7 @@
       #:args files
       files)))
   (printf "testing ~s\n" files)
-  (define passed (apply test-files! files))
+  (define passed (keyword-apply test-files! '(#:coverage) (list coverage?) files))
   (when coverage?
     (printf "COVERAGE!")
     (define coverage (get-test-coverage))
diff --git a/strace.rkt b/strace.rkt
index cab6d67..52aabbc 100644
--- a/strace.rkt
+++ b/strace.rkt
@@ -1,5 +1,5 @@
 #lang racket/base
-(provide annotate-top)
+(provide annotate-top test-coverage-enabled)
 (require errortrace/stacktrace
          racket/function
          racket/unit