suzanne.soy/cover
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

more tests

Browse Source
This commit is contained in:
Spencer Florence 2015-01-07 12:04:24 -05:00
parent 6493f74bd3
commit 5edd35e120
1 changed files with 29 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
private/html.rkt
View File

@ -43,26 +43,37 @@
(write-xexpr expr)) (write-xexpr expr))
#:exists 'replace) #:exists 'replace)
output-file)) output-file))
(build-index! coverage file-list dir) (define index (build-index coverage file-list))
(move-support-files! dir))
(define (build-index! coverage file-list dir)
(vprintf "building index.html\n")
(define %ages (get-percentages/top coverage))
(define xexpr
`(html
(head ()
(link ([rel "stylesheet"] [type "text/css"] [href "main.css"])))
(body
,(%s->xexpr %ages)
(div ()
,@(for/list ([file file-list])
(define f (path->string (apply build-path (rest (explode-path file)))))
`(p () (a ([href ,f]) ,f)))))))
(with-output-to-file (build-path dir "index.html") (with-output-to-file (build-path dir "index.html")
#:exists 'replace #:exists 'replace
(thunk (thunk (write-xexpr index)))
(write-xexpr xexpr)))) (move-support-files! dir))
(define (build-index coverage file-list)
(vprintf "building index.html\n")
(define %ages (get-percentages/top coverage))
`(html
(head ()
(link ([rel "stylesheet"] [type "text/css"] [href "main.css"])))
(body
,(%s->xexpr %ages)
(div ()
,@(for/list ([file file-list])
(define f (path->string (apply build-path (rest (explode-path file)))))
`(p () (a ([href ,f]) ,f)))))))
(module+ test
(define-runtime-path prog.rkt "../tests/basic/prog.rkt")
(test-begin
(after
(test-files! (path->string (simplify-path prog.rkt)))
(define coverage (get-test-coverage))
(check-equal?
(build-index coverage '("./tests/basic/prog.rkt"))
`(html (head () (link ([rel "stylesheet"] [type "text/css"] [href "main.css"])))
(body ,(%s->xexpr 1)
(div () (p () (a ([href "tests/basic/prog.rkt"]) "tests/basic/prog.rkt"))))))
(clear-coverage!))))
(define-runtime-path css "main.css") (define-runtime-path css "main.css")
(define (move-support-files! dir) (define (move-support-files! dir)
@ -121,19 +132,6 @@
`(ol () `(ol ()
,@(reverse lines))) ,@(reverse lines)))
(define (get-mode loc c)
(define-values (mode _)
(for/fold ([mode 'none] [last-start 0])
([pair c])
(match pair
[(list m (srcloc _ _ _ start range))
(if (and (<= start loc (+ start range))
(or (eq? mode 'none)
(> start last-start)))
(values m start)
(values mode last-start))])))
mode)
(define (encode-char c) (define (encode-char c)
(case c (case c
[(#\space) 'nbsp] [(#\space) 'nbsp]