From 347652b226a8632fa9af320c1ee552bcdf0733e6 Mon Sep 17 00:00:00 2001
From: Spencer Florence <florence@ccs.neu.edu>
Date: Sat, 27 Dec 2014 17:50:25 -0600
Subject: [PATCH] now compiling tested files to allow for cross module test
 coverage

---
 main.rkt   | 47 +++++++++++++++++++++++++++++------------------
 strace.rkt |  1 -
 2 files changed, 29 insertions(+), 19 deletions(-)

diff --git a/main.rkt b/main.rkt
index 8013691..632bc6d 100644
--- a/main.rkt
+++ b/main.rkt
@@ -23,24 +23,34 @@
 
 ;; PathString * -> Void
 ;; Test files and build coverage map
-;; TODO we need to load all the modules, then test them
+;; TODO we need to load all the modules, *then* test them
 ;;   for the sake of coverage
 ;;   in addition we need to make sure each module loads the
-;;   annotated, not the module on disk
+;;   annotated, not the module on disK
 (define (test-files! . paths)
-  (for ([p paths])
-    (define stx
-      (with-module-reading-parameterization
-          (thunk (read-syntax p (open-input-file p)))))
-    (define-values (name anned)
-      (syntax-parse (with-ns (expand stx))
-        #:datum-literals (module)
-        [(~and s (module name:id lang forms ...))
-         (values (syntax-e #'name)
-                 (annotate-top #'s (namespace-base-phase ns)))]))
-    (eval-syntax anned ns)
-    ;; TODO run test/given submodule
-    (with-ns (namespace-require `',name))))
+  (parameterize ([use-compiled-file-paths
+                  (cons (build-path "compiled" "better-test")
+                        (use-compiled-file-paths))]
+                 [current-compile better-test-compile])
+    (for ([p paths])
+      ;; TODO remove any compiled form of the module not in compiled/errortrace
+      (with-ns (namespace-require `(file ,p)))
+      ;; TODO run test/given submodule
+      )))
+
+(define better-test-compile
+  (let ()
+    (define compile (current-compile))
+    (define reg (namespace-module-registry ns))
+    (define phase (namespace-base-phase ns))
+    (lambda (e immediate-eval?)
+      (define to-compile
+        (if (eq? reg (namespace-module-registry (current-namespace)))
+            (annotate-top
+             (if (syntax? e) (expand e) (datum->syntax #f e))
+             phase)
+            e))
+      (compile to-compile immediate-eval?))))
 
 ;; -> Void
 ;; clear coverage map
@@ -62,9 +72,10 @@
     (filter values
             (for/list ([(stx covered?) coverage])
               (and (syntax? stx)
-                   (let ([src (syntax-source stx)]
-                         [pos (syntax-position stx)]
-                         [span (syntax-span stx)])
+                   (let* ([orig-src  (syntax-source stx)]
+                          [src (if (path? orig-src) (path->string orig-src) orig-src)]
+                          [pos (syntax-position stx)]
+                          [span (syntax-span stx)])
                      (and pos
                           span
                           (list covered?
diff --git a/strace.rkt b/strace.rkt
index e525a6e..cab6d67 100644
--- a/strace.rkt
+++ b/strace.rkt
@@ -21,4 +21,3 @@
 (define register-profile-done void)
 
 (define-values/invoke-unit/infer stacktrace@)
-