improving test coverage

private/coveralls.rkt

@@ -61,6 +61,23 @@
       (hasheq 'source src 'coverage c 'name local-file)))
   (hash-set meta 'source_files src-files))
 
+(module+ test
+  (define-runtime-path tests/prog.rkt"../tests/prog.rkt")
+  (define-runtime-path root "..")
+  (test-begin
+   (parameterize ([current-directory root])
+     (after
+      (define file (path->string (simplify-path tests/prog.rkt)))
+      (test-files! (path->string (simplify-path tests/prog.rkt)))
+      (define coverage (get-test-coverage))
+      (check-equal?
+       (generate-coveralls-json coverage (hasheq))
+       (hasheq 'source_files
+               (list (hasheq 'source (file->string tests/prog.rkt)
+                             'coverage (line-coverage coverage file)
+                             'name "tests/prog.rkt"))))
+      (clear-coverage!)))))
+
 ;; CoverallsCoverage = Nat | json-null
 
 ;; Coverage PathString Covered? -> [Listof CoverallsCoverage]

private/format-utils.rkt

@@ -1,5 +1,5 @@
 #lang racket
-(provide get-percentages/top get-percentages/file make-covered?)
+(provide make-covered?)
 (require syntax/modread syntax/parse unstable/sequence syntax-color/racket-lexer
          "shared.rkt")
 (module+ test (require rackunit "../cover.rkt" racket/runtime-path))
@@ -7,76 +7,6 @@
 ;;;;; a Coverage is the output of (get-test-coverage)
 ;;;;; a FileCoverage is the values of the hashmap from (get-test-coverage)
 
-;;;;; percentage
-;; A Percentage is a [HashMap Type Real∈[0,1]]
-;; a Type is one of: (update this as needed)
-;; 'expr
-
-;;  TODO this needs not count submodules and test directories
-
-;; Coverage -> Percentage
-(define (get-percentages/top coverage)
-  (hash
-   'expr (file-percentages->top expr-percentage coverage)))
-
-(define (file-percentages->top get-% coverage)
-  (define per-file
-    (for/list ([(f v) coverage])
-      (define covered? (make-covered? v f))
-      (call-with-values (thunk (get-% f covered?)) list)))
-  (define total (for/sum ([v per-file]) (second v)))
-  (for/sum ([v per-file])
-    (* (first v) (/ (second v) total))))
-
-;; PathString Covered? -> Percentage
-(define (get-percentages/file path covered?)
-  (hash
-   'expr (first (call-with-values (thunk (expr-percentage path covered?)) list))))
-
-;;; percentage generators. each one has the type:
-;; FilePath Covered? -> Real∈[0,1] Natural
-;; there the Real is the percentage covered
-;; and the Natural is the number of things of that type in the file
-(define (expr-percentage path covered?)
-  (define (is-covered? e)
-    ;; we don't need to look at the span because the coverage is expression based
-    (define p (syntax-position e))
-    (covered? p #:byte? #t))
-
-  (define e
-    (with-module-reading-parameterization
-        (thunk (with-input-from-file path read-syntax))))
-  (define (ret e)
-    (values (e->n e) (a->n e)))
-  (define (a->n e)
-    (case (is-covered? e)
-      [(yes no) 1]
-      [else 0]))
-  (define (e->n e)
-    (if (eq? (is-covered? e) 'yes) 1 0))
-  (define-values (covered count)
-    (let recur ([e e])
-      (syntax-parse e
-        [(v ...)
-         (for/fold ([covered (e->n e)] [count (a->n e)])
-                   ([e (in-syntax e)])
-           (define-values (cov cnt) (recur e))
-           (values (+ covered cov)
-                   (+ count cnt)))]
-        [e:expr (ret #'e)]
-        [_ (values 0 0)])))
-  (values (/ covered count) count))
-
-(module+ test
-  (define-runtime-path path "../tests/basic/prog.rkt")
-  (test-begin
-   (define f (path->string (simplify-path path)))
-   (test-files! f)
-   (define covered? (make-covered? (hash-ref (get-test-coverage) f) f))
-   (define-values (result _) (expr-percentage f covered?))
-   (check-equal? result 1)
-   (clear-coverage!)))
-
 ;;;;; utils
 
 ;;; a Cover is (U 'yes 'no 'missing)

private/html.rkt

@@ -1,13 +1,17 @@
 #lang racket
 (provide generate-html-coverage)
 (require racket/runtime-path
+         syntax/modread
+         syntax/parse
+         unstable/sequence
          (only-in xml write-xexpr)
          "format-utils.rkt"
          "shared.rkt")
 
 
 (module+ test
-  (require rackunit "../cover.rkt" racket/runtime-path))
+  (require rackunit "../cover.rkt" racket/runtime-path)
+  (define-runtime-path tests/basic/prog.rkt "../tests/basic/prog.rkt"))
 
 ;;; Coverage [PathString] -> Void
 (define (generate-html-coverage coverage [d "coverage"])
@@ -50,7 +54,7 @@
       (head ()
             (link ([rel "stylesheet"] [type "text/css"] [href "main.css"])))
       (body
-       ,@(%s->xexprs %ages)
+       ,(%s->xexpr %ages)
        (div ()
             ,@(for/list ([file file-list])
                 (define f (path->string (apply build-path (rest (explode-path file)))))
@@ -73,13 +77,12 @@
           (meta ([charset "utf-8"]))
           (link ([rel "stylesheet"] [type "text/css"] [href ,path-to-css])))
     (body ()
-          ,@(%s->xexprs %age)
+          ,(%s->xexpr %age)
           (div ([class "code"])
                ,(file->html path covered?)))))
 
-(define (%s->xexprs %age)
-  (for/list ([(type %) %age])
-    `(p () ,(~a type ': " " (~r (* 100 %) #:precision 2) "%") (br ()))))
+(define (%s->xexpr %)
+  `(p () ,(~a "expr" ': " " (~r (* 100 %) #:precision 2) "%") (br ())))
 
 (module+ test
   (define-runtime-path path "../tests/basic/prog.rkt")
@@ -167,3 +170,75 @@
                 ,@(for/list ([c l])
                     `(span ((class ,(if (equal? c #\space) "missing" "covered")))
                       ,(encode-char c))))))))
+
+
+;;;;; percentage
+;; A Percentage is a Real∈[0,1]
+;; a Type is one of: (update this as needed)
+;; 'expr
+
+;; Coverage -> Percentage
+(define (get-percentages/top coverage)
+  (file-percentages->top expr-percentage coverage))
+(module+ test
+  (test-begin
+   (after
+    (test-files! (path->string (simplify-path tests/basic/prog.rkt)))
+    (check-equal? (get-percentages/top (get-test-coverage)) 1)
+    (clear-coverage!))))
+
+(define (file-percentages->top get-% coverage)
+  (define per-file
+    (for/list ([(f v) coverage])
+      (define covered? (make-covered? v f))
+      (call-with-values (thunk (get-% f covered?)) list)))
+  (define total (for/sum ([v per-file]) (second v)))
+  (for/sum ([v per-file])
+    (* (first v) (/ (second v) total))))
+
+;; PathString Covered? -> Percentage
+(define (get-percentages/file path covered?)
+  (first (call-with-values (thunk (expr-percentage path covered?)) list)))
+
+;;; percentage generators. each one has the type:
+;; FilePath Covered? -> Real∈[0,1] Natural
+;; there the Real is the percentage covered
+;; and the Natural is the number of things of that type in the file
+(define (expr-percentage path covered?)
+  (define (is-covered? e)
+    ;; we don't need to look at the span because the coverage is expression based
+    (define p (syntax-position e))
+    (covered? p #:byte? #t))
+
+  (define e
+    (with-module-reading-parameterization
+        (thunk (with-input-from-file path read-syntax))))
+  (define (ret e)
+    (values (e->n e) (a->n e)))
+  (define (a->n e)
+    (case (is-covered? e)
+      [(yes no) 1]
+      [else 0]))
+  (define (e->n e)
+    (if (eq? (is-covered? e) 'yes) 1 0))
+  (define-values (covered count)
+    (let recur ([e e])
+      (syntax-parse e
+        [(v ...)
+         (for/fold ([covered (e->n e)] [count (a->n e)])
+                   ([e (in-syntax e)])
+           (define-values (cov cnt) (recur e))
+           (values (+ covered cov)
+                   (+ count cnt)))]
+        [e:expr (ret #'e)]
+        [_ (values 0 0)])))
+  (values (/ covered count) count))
+
+(module+ test
+  (test-begin
+   (define f (path->string (simplify-path tests/basic/prog.rkt)))
+   (test-files! f)
+   (define covered? (make-covered? (hash-ref (get-test-coverage) f) f))
+   (define-values (result _) (expr-percentage f covered?))
+   (check-equal? result 1)
+   (clear-coverage!)))

raco.rkt

@@ -66,6 +66,23 @@
                              (build-path (current-directory) f))])
            (expand-directory (append extensions comped)))))))
 
+(module+ test
+  (define-runtime-path root".")
+  (define-runtime-path private "private")
+  (define-runtime-path main.rkt "main.rkt")
+  (parameterize ([current-directory root])
+    (check-equal? (list->set
+                   (map (compose path->string ->relative)
+                        (expand-directories (list (path->string main.rkt)
+                                                  (->relative (path->string private))))))
+                  (set "main.rkt"
+                       "private/coveralls.rkt"
+                       "private/contracts.rkt"
+                       "private/html.rkt"
+                       "private/format-utils.rkt"
+                       "private/shared.rkt"
+                       "private/raw.rkt"))))
+
 ;; -> (HorribyNestedListsOf PathString)
 (define (expand-directory exts)
   (for/list ([p (directory-list)])