fixed module phase shifting bug

cover/cover.rkt

@@ -197,25 +197,29 @@ Thus, In essence this module has three responsibilites:
   (define cover-compile
     (lambda (e immediate-eval?)
       (define file (get-source e))
-      (define to-compile
-        (cond [(or (compiled-expression? (if (syntax? e) (syntax-e e) e))
-                   (not (eq? reg (namespace-module-registry (current-namespace))))
-                   (not file))
-               e]
-              [else
-               (vprintf "compiling ~s with coverage annotations in enviornment ~s"
-                        file
-                        (get-topic))
-               (let ([x ((annotate-top file)
-                         (if (syntax? e) (expand-syntax e) (datum->syntax #f e))
-                         (namespace-base-phase (current-namespace)))])
-                 (vprintf "\ncurrently using ~aGB memory after file ~a\n"
-                          (* 0.000000001 (current-memory-use))
-                          file)
-                 x)]))
-      (compile to-compile immediate-eval?)))
+      (with-handlers ([void (lambda (e) (displayln file) (raise e))])
+          (define to-compile
+            (cond [(or (compiled-expression? (if (syntax? e) (syntax-e e) e))
+                       (not (eq? reg (namespace-module-registry (current-namespace))))
+                       (not file))
+                   e]
+                  [else
+                   (vprintf "compiling ~s with coverage annotations in enviornment ~s"
+                            file
+                            (get-topic))
+                   (let ([x ((annotate-top file)
+                             (if (syntax? e) (expand-syntax e) (datum->syntax #f e))
+                             (namespace-base-phase (current-namespace)))])
+                     (vprintf "\ncurrently using ~aGB memory after file ~a\n"
+                              (* 0.000000001 (current-memory-use))
+                              file)
+                     ;(pretty-print (syntax->datum x))
+                     x)]))
+        (compile to-compile immediate-eval?))))
   cover-compile)
 
+(require racket/pretty)
+
 (define (get-source stx)
   (and (syntax? stx)
        (let loop ([e stx])
@@ -300,7 +304,8 @@ Thus, In essence this module has three responsibilites:
 
     (define vecmap (get-coverage-vector-mapping))
     (define raw-coverage
-      (for/hash ([(srcloc loc) (in-hash (get-coverage-srcloc-mapping))])
+      (for*/hash ([(_ filemap) (in-hash (get-coverage-srcloc-mapping))]
+                  [(srcloc loc) (in-hash filemap)])
         (values srcloc
                 (vector-ref
                  (hash-ref vecmap

cover/strace.rkt

@@ -18,11 +18,15 @@ The module implements code coverage annotations as described in cover.rkt
 
 ;; symbol [Hash srcloclist index] [Hash pathstring vector]
 ;; -> (pathstring -> annotator)
-(define (make-annotate-top topic loc->vecref vecmapping)
+(define (make-annotate-top topic file->loc->vecref vecmapping)
   (define log-message-name #'log-message)
   (define current-logger-name #'current-logger)
-  (define unsafe-vector-set!-name #'unsafe-vector*-set!)
-  (define unsafe-vector-ref-name #'unsafe-vector*-ref)
+  (define unsafe-vector-set!-name #'vector-set!
+    #;#'unsafe-vector*-set!
+    )
+  (define unsafe-vector-ref-name #'vector-ref
+    #;#'unsafe-vector*-ref
+    )
   (define vector-name #'cover-coverage-vector)
   (define make-log-receiver-name #'make-log-receiver)
   (define sync-name #'sync)
@@ -69,7 +73,7 @@ The module implements code coverage annotations as described in cover.rkt
                   (define stx
                     #'(m name lang
                          (#%module-begin add ... body ...)))
-                  (rebuild-syntax stx disarmed expr phase))])]))]
+                  (rebuild-syntax stx disarmed expr phase-shift))])]))]
 
        [(b a ...)
         (or (eq? 'begin (syntax-e #'b))
@@ -127,8 +131,8 @@ The module implements code coverage annotations as described in cover.rkt
                           (for-meta #,i (rename '#%kernel #%papp #%app))
                           (for-meta #,i (rename '#%kernel pdefine-values define-values))
                           (for-meta #,i (rename '#%kernel pbegin begin))
-                          (for-meta #,i (rename '#%unsafe unsafe-vector-ref unsafe-vector-ref))
-                          (for-meta #,i (rename '#%unsafe unsafe-vector-set! unsafe-vector-set!))))
+                          (for-meta #,i (rename '#%kernel unsafe-vector-ref unsafe-vector-ref))
+                          (for-meta #,i (rename '#%kernel unsafe-vector-set! unsafe-vector-set!))))
          (pdefine-values (lgr) (#%papp current-logger))
          (pdefine-values (rec)
                          (#%papp make-log-receiver
@@ -158,7 +162,10 @@ The module implements code coverage annotations as described in cover.rkt
 
 
   (lambda (file)
-    (define initialized? (hash-has-key? loc->vecref file))
+    (define initialized? (hash-has-key? file->loc->vecref file))
+    (unless initialized?
+      (hash-set! file->loc->vecref file (make-hash)))
+    (define loc->vecref (hash-ref file->loc->vecref file))
     (define count 0)
 
     (define (make-cover-annotate-top annotate-top)

cover/tests/do-bfs+module.rkt

@@ -3,9 +3,11 @@
 (define-runtime-path-list fs
   (list "module.rkt"
         "bfs.rkt"
-        "bfs+module.rkt"))
+        "bfs+module.rkt"
+        "bfs+module-nolex.rkt"
+        "lazy-require.rkt"))
 (test-case
- "begin-for-syntax with nexted modules should be okay"
+ "begin-for-syntax with modules should be okay"
  (parameterize ([current-cover-environment (make-cover-environment)])
    (for-each
     (lambda (f)