From 8b4b5faa9fb08c7054114806d5ffd0386f70f49f Mon Sep 17 00:00:00 2001
From: Spencer Florence <florence@ccs.neu.edu>
Date: Wed, 31 Dec 2014 00:12:28 -0600
Subject: [PATCH] fixed an offset bug with 'missing positions and racket-lexer

---
 private/format-utils.rkt | 32 ++++++++++++++++++++++++++++----
 private/html.rkt         |  8 ++++++--
 tests/prog.rkt           |  1 +
 3 files changed, 35 insertions(+), 6 deletions(-)

diff --git a/private/format-utils.rkt b/private/format-utils.rkt
index 8f36d9f..ccc65cd 100644
--- a/private/format-utils.rkt
+++ b/private/format-utils.rkt
@@ -111,13 +111,26 @@
 ;; TODO should we only ignore test (and main) submodules?
 (define (make-irrelevant? lexer f)
   (define s (mutable-set))
+  (define-values (for-lex for-str) (dup-input-port (current-input-port)))
+  (define str (apply vector (string->list (port->string for-str))))
+  (define init-offset (- (string-length (file->string f))
+                        (vector-length str)))
+
+  (define (offset offset)
+    (let loop ([s 0] [b 0])
+      (cond [(= (sub1 offset) b)
+             (- b s)]
+            [else
+             (define l (char-utf-8-length (vector-ref str s)))
+             (loop (add1 s) (+ b l))])))
+
   (let loop ()
-    (define-values (_v type _m start end) (lexer (current-input-port)))
+    (define-values (v type _m start end) (lexer for-lex))
     (case type
       [(eof) (void)]
-      [(comment sexp-comment no-color)
-       (for ([i (in-range start end)])
-         (set-add! s i))
+      [(comment sexp-comment no-color white-space)
+       (for ([i (in-range (- start (offset start)) (- end (offset end)))])
+         (set-add! s (+ init-offset i)))
        (loop)]
       [else (loop)]))
   (define stx
@@ -137,6 +150,14 @@
       [_else (void)]))
   (lambda (i) (set-member? s i)))
 
+(define (dup-input-port p)
+  (define-values (i1 o1) (make-pipe))
+  (define-values (i2 o2) (make-pipe))
+  (copy-port p o1 o2)
+  (close-output-port o1)
+  (close-output-port o2)
+  (values i1 i2))
+
 (define (in-syntax-object? i stx)
   (define p (syntax-position stx))
   (define r (syntax-span stx))
@@ -164,6 +185,9 @@
    (define f (path->string (simplify-path path2)))
    (test-files! f)
    (define coverage (hash-ref (get-test-coverage) f))
+   (check-equal? (covered? 14 coverage f) 'missing)
    (check-equal? (covered? 17 coverage f) 'missing)
+   (check-equal? (covered? 28 coverage f) 'missing)
    (check-equal? (covered? 35 coverage f) 'yes)
+   (check-equal? (covered? 50 coverage f) 'no)
    (clear-coverage!)))
diff --git a/private/html.rkt b/private/html.rkt
index 22f9fff..07b8d01 100644
--- a/private/html.rkt
+++ b/private/html.rkt
@@ -143,8 +143,12 @@
   (define f (path->string (simplify-path path)))
   (test f
         `(ol ()
-          ,@(for/list ([l (string-split (file->string f) "\n")])
+          (li ()
+              ,@(for/list ([c (first (string-split (file->string f) "\n"))])
+                 `(span ((class "covered"))
+                   ,(encode-char c))))
+          ,@(for/list ([l (rest (string-split (file->string f) "\n"))])
               `(li ()
                 ,@(for/list ([c l])
-                    `(span ((class "covered"))
+                    `(span ((class ,(if (equal? c #\space) "missing" "covered")))
                       ,(encode-char c))))))))
diff --git a/tests/prog.rkt b/tests/prog.rkt
index 3868b90..19baf4f 100644
--- a/tests/prog.rkt
+++ b/tests/prog.rkt
@@ -1,3 +1,4 @@
 #lang racket
 ;; this is a comment
 (+ 1 2)
+(λ (x) 3)