From 4d177f250eb8175c569bf8ec4ca898dda8c83ef0 Mon Sep 17 00:00:00 2001 From: Spencer Florence Date: Tue, 10 Mar 2015 16:40:12 -0400 Subject: [PATCH 1/5] working on lexer wrapping --- info.rkt | 2 +- private/format-utils.rkt | 17 ++++++++++++----- tests/main.rkt | 30 ++++++++++-------------------- 3 files changed, 23 insertions(+), 26 deletions(-) diff --git a/info.rkt b/info.rkt index 56a90fe..4e0331f 100644 --- a/info.rkt +++ b/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))) diff --git a/private/format-utils.rkt b/private/format-utils.rkt index ad9fec4..8e1ab86 100644 --- a/private/format-utils.rkt +++ b/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) diff --git a/tests/main.rkt b/tests/main.rkt index 1466805..60f686a 100644 --- a/tests/main.rkt +++ b/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]) From 481aeb9718fa9c1b96896f65e1623d07396b3edd Mon Sep 17 00:00:00 2001 From: Spencer Florence Date: Tue, 10 Mar 2015 16:40:25 -0400 Subject: [PATCH 2/5] added tests --- tests/at-exp/at-exp.rkt | 2 ++ tests/at-exp/at-exp.rktl | 2 ++ 2 files changed, 4 insertions(+) create mode 100644 tests/at-exp/at-exp.rkt create mode 100644 tests/at-exp/at-exp.rktl diff --git a/tests/at-exp/at-exp.rkt b/tests/at-exp/at-exp.rkt new file mode 100644 index 0000000..ead7317 --- /dev/null +++ b/tests/at-exp/at-exp.rkt @@ -0,0 +1,2 @@ +#lang at-exp racket +@void{1} diff --git a/tests/at-exp/at-exp.rktl b/tests/at-exp/at-exp.rktl new file mode 100644 index 0000000..c5c5ef4 --- /dev/null +++ b/tests/at-exp/at-exp.rktl @@ -0,0 +1,2 @@ +() +() From e051103467948b95947d8f26ffa241831645c313 Mon Sep 17 00:00:00 2001 From: Spencer Florence Date: Mon, 30 Mar 2015 22:16:14 -0400 Subject: [PATCH 3/5] fixing lexer --- private/format-utils.rkt | 25 ++++++++++++++++--------- tests/main.rkt | 2 +- 2 files changed, 17 insertions(+), 10 deletions(-) diff --git a/private/format-utils.rkt b/private/format-utils.rkt index 8e1ab86..520b611 100644 --- a/private/format-utils.rkt +++ b/private/format-utils.rkt @@ -8,6 +8,7 @@ racket/set racket/bool syntax-color/racket-lexer + syntax-color/lexer-contract syntax/modread syntax/parse "shared.rkt") @@ -62,11 +63,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)))))) +(define (maybe-wrap-lexer lexer) + (if (procedure-arity-includes? lexer 3) + lexer + (λ (in offset mode) + (define-values (a b c d e) (lexer in)) + (values a b c d e 0 #f)))) ;; 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. @@ -79,15 +81,20 @@ (define offset (make-byte->str-offset str)) - (let loop () - (define-values (v type _m start end) (lexer for-lex)) + + (let loop ([mode #f]) + (define-values (v type _m start end backup-dist new-mode/ds) + (lexer for-lex 0 mode)) + (define new-mode (if (dont-stop? new-mode/ds) + (dont-stop-val new-mode/ds) + new-mode/ds)) (case type [(eof) (void)] [(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)])) + (loop new-mode)] + [else (loop new-mode)])) (define stx (with-input-from-file f (thunk (with-module-reading-parameterization read-syntax)))) diff --git a/tests/main.rkt b/tests/main.rkt index 60f686a..ae16891 100644 --- a/tests/main.rkt +++ b/tests/main.rkt @@ -28,7 +28,7 @@ (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)) + (define covered? (make-covered? actual-coverage program)) (test-begin (for ([i expected-coverage]) (check-equal? (covered? i) 'covered From 06c9d417dd61b39cb94cc517be5ca6dbaac32ec9 Mon Sep 17 00:00:00 2001 From: Spencer Florence Date: Mon, 30 Mar 2015 22:39:29 -0400 Subject: [PATCH 4/5] fixing test errors --- private/format-utils.rkt | 2 +- tests/main.rkt | 17 +++++++++-------- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/private/format-utils.rkt b/private/format-utils.rkt index 520b611..9dc2077 100644 --- a/private/format-utils.rkt +++ b/private/format-utils.rkt @@ -75,13 +75,13 @@ (define (make-irrelevant? lexer f submods) (define s (mutable-set)) (define-values (for-lex for-str) (replicate-file-port f (current-input-port))) + (port-count-lines! for-lex) (define str (apply vector (string->list (port->string for-str)))) (define init-offset (- (string-length (file->string f)) (vector-length str))) (define offset (make-byte->str-offset str)) - (let loop ([mode #f]) (define-values (v type _m start end backup-dist new-mode/ds) (lexer for-lex 0 mode)) diff --git a/tests/main.rkt b/tests/main.rkt index ae16891..8c5e88c 100644 --- a/tests/main.rkt +++ b/tests/main.rkt @@ -29,15 +29,16 @@ (with-input-from-file cover (lambda () (values (ranges->numbers (read)) (ranges->numbers (read)))))) (define covered? (make-covered? actual-coverage program)) + (define (test-range range type) + (for ([i range]) + (define v (covered? i)) + (unless (eq? v 'irrelevant) + (check-equal? v type + (format "expected char ~a to be covered, but it was not, in: ~s" + i program))))) (test-begin - (for ([i expected-coverage]) - (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-equal? (covered? i) 'uncovered - (format "expected char ~a to be uncovered, but it was, in: ~s" - i program))))) + (test-range expected-coverage 'covered) + (test-range expected-uncoverage 'uncovered))) (clear-coverage!)) From 85896752a92f896b3648c01fe44cd1a39f300dbe Mon Sep 17 00:00:00 2001 From: Spencer Florence Date: Mon, 30 Mar 2015 22:56:24 -0400 Subject: [PATCH 5/5] fixed a port-line/character counting issue. --- private/format-utils.rkt | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/private/format-utils.rkt b/private/format-utils.rkt index 9dc2077..c92ec04 100644 --- a/private/format-utils.rkt +++ b/private/format-utils.rkt @@ -75,7 +75,6 @@ (define (make-irrelevant? lexer f submods) (define s (mutable-set)) (define-values (for-lex for-str) (replicate-file-port f (current-input-port))) - (port-count-lines! for-lex) (define str (apply vector (string->list (port->string for-str)))) (define init-offset (- (string-length (file->string f)) (vector-length str))) @@ -163,19 +162,20 @@ (module+ test (define-runtime-path path2 "../tests/prog.rkt") - (test-begin - (define f (path->string (simplify-path path2))) - (test-files! f) - (define coverage (hash-ref (get-test-coverage) f)) - (define covered? (make-covered? coverage f)) - (check-equal? (covered? 14) 'irrelevant) - (check-equal? (covered? 14 #:byte? #t) 'irrelevant) - (check-equal? (covered? 17) 'irrelevant) - (check-equal? (covered? 28) 'irrelevant) - (check-equal? (covered? 35) 'covered) - (check-equal? (covered? 50) 'uncovered) - (check-equal? (covered? 51 #:byte? #t) 'uncovered) - (check-equal? (covered? 52) 'irrelevant) - (check-equal? (covered? 53) 'irrelevant) - (check-equal? (covered? 54) 'irrelevant) - (clear-coverage!))) + (parameterize ([irrelevant-submodules #f]) + (test-begin + (define f (path->string (simplify-path path2))) + (test-files! f) + (define coverage (hash-ref (get-test-coverage) f)) + (define covered? (make-covered? coverage f)) + (check-equal? (covered? 14) 'irrelevant) + (check-equal? (covered? 14 #:byte? #t) 'irrelevant) + (check-equal? (covered? 17) 'irrelevant) + (check-equal? (covered? 28) 'irrelevant) + (check-equal? (covered? 35) 'covered) + (check-equal? (covered? 50) 'uncovered) + (check-equal? (covered? 51 #:byte? #t) 'uncovered) + (check-equal? (covered? 52) 'irrelevant) + (check-equal? (covered? 53) 'irrelevant) + (check-equal? (covered? 54) 'irrelevant) + (clear-coverage!))))