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

fix backwards compat for module suffixes

Browse Source
This commit is contained in:
Spencer Florence 2015-09-21 15:57:46 -05:00
parent 391f32c7b1
commit b4fd0fadab
1 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
cover/raco.rkt
View File

@ -4,7 +4,6 @@
racket/match racket/match
racket/contract/base racket/contract/base
racket/function racket/function
compiler/module-suffix
"main.rkt" "main.rkt"
(only-in "private/contracts.rkt" coverage-gen/c) (only-in "private/contracts.rkt" coverage-gen/c)
"private/shared.rkt" "private/shared.rkt"
@ -106,8 +105,6 @@
'debug 'debug
'cover)) 'cover))
(define extensions '(#rx"\\.rkt$" #rx"\\.ss$" #rx"\\.scrbl"))
(define (expand-lib files [exts null]) (define (expand-lib files [exts null])
(define (find x) (define (find x)
(define rmp ((current-module-name-resolver) x #f #f #f)) (define rmp ((current-module-name-resolver) x #f #f #f))
@ -131,6 +128,15 @@
[(_ [id:id e] b ...) [(_ [id:id e] b ...)
#'(let ([id e]) #'(let ([id e])
(and id (maybe b ...)))])) (and id (maybe b ...)))]))
(define extensions #px#"^(.*)\\.(?i:rkt|scm|scrbl|ss)$")
(define get-module-suffix-regexp
(with-handlers ([(lambda (e) (or (exn:fail:filesystem? e)
(exn:fail:contract? e)))
(const (const extensions))])
(dynamic-require 'compiler/module-suffix
'get-module-suffix-regexp)))
(define (filter-exts files [exts null]) (define (filter-exts files [exts null])
(for/list ([f files] (for/list ([f files]
#:when (maybe [ext? (filename-extension f)] #:when (maybe [ext? (filename-extension f)]
@ -152,7 +158,7 @@
(if (absolute-path? f) (if (absolute-path? f)
f f
(build-path (current-directory) f))]) (build-path (current-directory) f))])
(expand-directory (append extensions comped))))))) (expand-directory (cons extensions comped)))))))
(let loop ([paths paths+vectors]) (let loop ([paths paths+vectors])
(match paths (match paths
[(list) null] [(list) null]
@ -213,12 +219,12 @@
(define-runtime-path cur ".") (define-runtime-path cur ".")
(parameterize ([current-directory (build-path cur "tests/basic")]) (parameterize ([current-directory (build-path cur "tests/basic")])
(check-equal? (list->set (map (compose path->string ->relative) (check-equal? (list->set (map (compose path->string ->relative)
(flatten (expand-directory extensions)))) (flatten (expand-directory (list extensions)))))
(set "prog.rkt" (set "prog.rkt"
"not-run.rkt"))) "not-run.rkt")))
(parameterize ([current-directory cur]) (parameterize ([current-directory cur])
(define omit (map ->absolute (get-info-var cur 'test-omit-paths))) (define omit (map ->absolute (get-info-var cur 'test-omit-paths)))
(define dirs (map ->absolute (filter list? (flatten (expand-directory extensions))))) (define dirs (map ->absolute (filter list? (flatten (expand-directory (list extensions))))))
(for ([o omit]) (for ([o omit])
(check-false (member o dirs) (check-false (member o dirs)
(format "~s ~s" o dirs))))) (format "~s ~s" o dirs)))))