working on lexer wrapping

info.rkt

@@ -5,7 +5,7 @@
                "syntax-color-lib" "compiler-lib"))
 (define build-deps
   '("racket-doc" "scribble-lib" "typed-racket-doc" "htdp-lib"
-    "net-doc" "scribble-doc"))
+    "net-doc" "scribble-doc" "at-exp-lib"))
 
 (define raco-commands
   '(("cover" (submod cover/raco main) "a code coverage tool" 30)))

private/format-utils.rkt

@@ -47,11 +47,12 @@
   (with-input-from-file f
     (thunk
      (define lexer
-       (with-handlers ([exn:fail:read? (const racket-lexer)])
-         (define f (read-language))
-         (if f
-             (f 'color-lexer racket-lexer)
-             racket-lexer)))
+       (maybe-wrap-lexer
+        (with-handlers ([exn:fail:read? (const racket-lexer)])
+          (define f (read-language))
+          (if f
+              (f 'color-lexer racket-lexer)
+              racket-lexer))))
      (define irrelevant? (make-irrelevant? lexer f submods))
      (define file-length (string-length (file->string f)))
      (define cache
@@ -61,6 +62,12 @@
                        [else (raw-covered? i c)]))))
      cache)))
 
+(define (maybe-wrap-lexer f)
+  (if (procedure-arity-includes? f 3)
+      f
+      (lambda (a b c)
+        (apply values (append (call-with-values (thunk f a) list) (list b c))))))
+
 ;; Lexer(in the sence of color:text<%>) InputPort (Maybe (Listof Symbol)) -> (Natural -> Boolean)
 ;; builds a function that determines if a given location in that port is irrelivent.
 (define (make-irrelevant? lexer f submods)

tests/main.rkt

@@ -3,7 +3,8 @@
 ;; for every .rkt file in those directories it loads
 ;; tests that file and checks its coverage against an
 ;; .rktl file of the same name
-(require (only-in "../main.rkt" test-files! clear-coverage! get-test-coverage irrelevant-submodules)
+(require (only-in "../main.rkt" test-files! clear-coverage! get-test-coverage irrelevant-submodules
+                  make-covered?)
          "../private/file-utils.rkt"
          racket/runtime-path rackunit)
 
@@ -27,15 +28,16 @@
       (define-values (expected-coverage expected-uncoverage)
         (with-input-from-file cover (lambda () (values (ranges->numbers (read))
                                                        (ranges->numbers (read))))))
+      (define covered? (make-covered? program actual-coverage))
       (test-begin
        (for ([i expected-coverage])
-         (check-true (covered? i actual-coverage)
-                     (format "expected char ~a to be covered, but it was not, in: ~s"
-                             i program)))
+         (check-equal? (covered? i) 'covered
+                       (format "expected char ~a to be covered, but it was not, in: ~s"
+                               i program)))
        (for ([i expected-uncoverage])
-         (check-true (not (covered? i actual-coverage))
-                     (format "expected char ~a to be uncovered, but it was, in: ~s"
-                             i program)))))
+         (check-equal? (covered? i) 'uncovered
+                       (format "expected char ~a to be uncovered, but it was, in: ~s"
+                               i program)))))
 
     (clear-coverage!))
 
@@ -51,20 +53,8 @@
          (ranges->numbers r)
          (cons a (ranges->numbers (cons (list (add1 a) b) r))))]))
 
-(define (covered? i map)
-  (for*/and ([l map]
-             [b (in-value (first l))]
-             [srcloc (in-value (second l))]
-             #:when (within? i srcloc))
-    b))
-
-(define (within? i src)
-  (match src
-    [(srcloc _ _ _ start range)
-     (<= start i (+ start range))]))
-
 (module+ test
-  (define-runtime-path-list test-dirs '("basic" "simple-multi" "syntax"))
+  (define-runtime-path-list test-dirs '("basic" "simple-multi" "syntax" "at-exp"))
   (for-each (compose test-dir path->string) test-dirs)
   (define-runtime-path submods "submods")
   (parameterize ([irrelevant-submodules null])