fix derefing srclocs from outside current file

This commit is contained in:
Spencer Florence 2015-08-21 16:00:36 -05:00
parent 47ad550c51
commit d958efe730
2 changed files with 5 additions and 5 deletions

View File

@ -291,11 +291,11 @@ Thus, In essence this module has three responsibilites:
(define vecmap (get-coverage-vector-mapping))
(define raw-coverage
(for*/hash ([(_ filemap) (in-hash (get-coverage-srcloc-mapping))]
[(srcloc loc) (in-hash filemap)])
[(srcloc spot) (in-hash filemap)])
(match-define (list file loc) spot)
(values srcloc
(vector-ref
(hash-ref vecmap
(first srcloc))
(hash-ref vecmap file)
loc))))

View File

@ -76,14 +76,14 @@ The module implements code coverage annotations as described in cover.rkt
(lambda (stx)
(define loc (stx->srcloc stx))
(unless (hash-has-key? loc->vecref loc)
(hash-set! loc->vecref loc count)
(hash-set! loc->vecref loc (list file count))
(set! count (add1 count))))))
(define (test-covered stx)
(define loc (stx->srcloc stx))
(with-syntax ([vector-name vector-name]
[unsafe-vector-set! unsafe-vector-set!-name]
[vecloc (hash-ref loc->vecref loc)])
[vecloc (cadr (hash-ref loc->vecref loc))])
#`(#%plain-app unsafe-vector-set! vector-name vecloc #t)))
;; ---- IN ----