fixed an offset bug with 'missing positions and racket-lexer
This commit is contained in:
parent
b78c10ce42
commit
8b4b5faa9f
|
@ -111,13 +111,26 @@
|
||||||
;; TODO should we only ignore test (and main) submodules?
|
;; TODO should we only ignore test (and main) submodules?
|
||||||
(define (make-irrelevant? lexer f)
|
(define (make-irrelevant? lexer f)
|
||||||
(define s (mutable-set))
|
(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 ()
|
(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
|
(case type
|
||||||
[(eof) (void)]
|
[(eof) (void)]
|
||||||
[(comment sexp-comment no-color)
|
[(comment sexp-comment no-color white-space)
|
||||||
(for ([i (in-range start end)])
|
(for ([i (in-range (- start (offset start)) (- end (offset end)))])
|
||||||
(set-add! s i))
|
(set-add! s (+ init-offset i)))
|
||||||
(loop)]
|
(loop)]
|
||||||
[else (loop)]))
|
[else (loop)]))
|
||||||
(define stx
|
(define stx
|
||||||
|
@ -137,6 +150,14 @@
|
||||||
[_else (void)]))
|
[_else (void)]))
|
||||||
(lambda (i) (set-member? s i)))
|
(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 (in-syntax-object? i stx)
|
||||||
(define p (syntax-position stx))
|
(define p (syntax-position stx))
|
||||||
(define r (syntax-span stx))
|
(define r (syntax-span stx))
|
||||||
|
@ -164,6 +185,9 @@
|
||||||
(define f (path->string (simplify-path path2)))
|
(define f (path->string (simplify-path path2)))
|
||||||
(test-files! f)
|
(test-files! f)
|
||||||
(define coverage (hash-ref (get-test-coverage) 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? 17 coverage f) 'missing)
|
||||||
|
(check-equal? (covered? 28 coverage f) 'missing)
|
||||||
(check-equal? (covered? 35 coverage f) 'yes)
|
(check-equal? (covered? 35 coverage f) 'yes)
|
||||||
|
(check-equal? (covered? 50 coverage f) 'no)
|
||||||
(clear-coverage!)))
|
(clear-coverage!)))
|
||||||
|
|
|
@ -143,8 +143,12 @@
|
||||||
(define f (path->string (simplify-path path)))
|
(define f (path->string (simplify-path path)))
|
||||||
(test f
|
(test f
|
||||||
`(ol ()
|
`(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 ()
|
`(li ()
|
||||||
,@(for/list ([c l])
|
,@(for/list ([c l])
|
||||||
`(span ((class "covered"))
|
`(span ((class ,(if (equal? c #\space) "missing" "covered")))
|
||||||
,(encode-char c))))))))
|
,(encode-char c))))))))
|
||||||
|
|
|
@ -1,3 +1,4 @@
|
||||||
#lang racket
|
#lang racket
|
||||||
;; this is a comment
|
;; this is a comment
|
||||||
(+ 1 2)
|
(+ 1 2)
|
||||||
|
(λ (x) 3)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user