fix check-requires for submodules
original commit: 0b8b0c36ef80c79f0f9e7762ce1c5383917fd19e
This commit is contained in:
parent
982cd95c6b
commit
12e710ab30
|
@ -32,10 +32,11 @@
|
|||
(cond [(symbol? name) 'no-bypass]
|
||||
[(hash-ref module-db name #f)
|
||||
=> values]
|
||||
[else
|
||||
[(path? name)
|
||||
(let ([str (path->relative-string/library name)])
|
||||
(for/or ([rx (in-list no-bypass-rxs)])
|
||||
(and (regexp-match? rx str) 'no-bypass)))])))
|
||||
(and (regexp-match? rx str) 'no-bypass)))]
|
||||
[else #f])))
|
||||
|
||||
;; module-db : ModuleDB
|
||||
(define module-db
|
||||
|
|
|
@ -48,12 +48,17 @@
|
|||
mpi-list->module-path)
|
||||
|
||||
;; get-module-derivation : module-path -> (values compiled Deriv)
|
||||
(define (get-module-code/trace path)
|
||||
(get-module-code (resolve-module-path path #f)
|
||||
#:choose (lambda _ 'src)
|
||||
#:compile (lambda (stx)
|
||||
(let-values ([(stx deriv) (trace/result stx expand)])
|
||||
(values (compile stx) deriv)))))
|
||||
(define (get-module-code/trace modpath)
|
||||
(let-values ([(path subs)
|
||||
(match (resolve-module-path modpath #f)
|
||||
[`(submod ,path . ,subs) (values path subs)]
|
||||
[path (values path null)])])
|
||||
(get-module-code path
|
||||
#:submodule-path subs
|
||||
#:choose (lambda _ 'src)
|
||||
#:compile (lambda (stx)
|
||||
(let-values ([(stx deriv) (trace/result stx expand)])
|
||||
(values (compile stx) deriv))))))
|
||||
|
||||
;; here-mpi? : any -> boolean
|
||||
(define (here-mpi? x)
|
||||
|
@ -96,19 +101,22 @@
|
|||
(collapse-module-path mod (lambda () (loop base)))]
|
||||
[else (build-path 'same)]))]
|
||||
[else (build-path 'same)]))])
|
||||
(match collapsed
|
||||
[(list 'lib str)
|
||||
(cond [(regexp-match? #rx"\\.rkt$" str)
|
||||
(let* ([no-suffix (path->string (path-replace-suffix str ""))]
|
||||
[no-main
|
||||
(cond [(regexp-match #rx"^([^/]+)/main$" no-suffix)
|
||||
=> cadr]
|
||||
[else no-suffix])])
|
||||
(string->symbol no-main))]
|
||||
[else collapsed])]
|
||||
[(? path?)
|
||||
(path->string (simplify-path collapsed #f))] ;; to get rid of "./" at beginning
|
||||
[_ collapsed])))
|
||||
(let simplify ([collapsed collapsed])
|
||||
(match collapsed
|
||||
[(list* 'submod base subs)
|
||||
(list* 'submod (simplify base) subs)]
|
||||
[(list 'lib str)
|
||||
(cond [(regexp-match? #rx"\\.rkt$" str)
|
||||
(let* ([no-suffix (path->string (path-replace-suffix str ""))]
|
||||
[no-main
|
||||
(cond [(regexp-match #rx"^([^/]+)/main$" no-suffix)
|
||||
=> cadr]
|
||||
[else no-suffix])])
|
||||
(string->symbol no-main))]
|
||||
[else collapsed])]
|
||||
[(? path?)
|
||||
(path->string (simplify-path collapsed #f))] ;; to get rid of "./" at beginning
|
||||
[_ collapsed]))))
|
||||
|
||||
;; --------
|
||||
|
||||
|
|
3
collects/tests/macro-debugger/check-requires/src-a.rkt
Normal file
3
collects/tests/macro-debugger/check-requires/src-a.rkt
Normal file
|
@ -0,0 +1,3 @@
|
|||
#lang racket/base
|
||||
(define a 1)
|
||||
(provide a)
|
3
collects/tests/macro-debugger/check-requires/src-b.rkt
Normal file
3
collects/tests/macro-debugger/check-requires/src-b.rkt
Normal file
|
@ -0,0 +1,3 @@
|
|||
#lang racket/base
|
||||
(define b 2)
|
||||
(provide b)
|
8
collects/tests/macro-debugger/check-requires/src-c.rkt
Normal file
8
collects/tests/macro-debugger/check-requires/src-c.rkt
Normal file
|
@ -0,0 +1,8 @@
|
|||
#lang racket/base
|
||||
|
||||
(module s racket/base
|
||||
(define cs 30)
|
||||
(provide cs))
|
||||
|
||||
(define c 3)
|
||||
(provide c)
|
7
collects/tests/macro-debugger/check-requires/use-a.rkt
Normal file
7
collects/tests/macro-debugger/check-requires/use-a.rkt
Normal file
|
@ -0,0 +1,7 @@
|
|||
#lang racket/base
|
||||
(require "src-a.rkt"
|
||||
"src-b.rkt"
|
||||
"src-c.rkt"
|
||||
(submod "src-c.rkt" s))
|
||||
|
||||
(void a)
|
7
collects/tests/macro-debugger/check-requires/use-cs.rkt
Normal file
7
collects/tests/macro-debugger/check-requires/use-cs.rkt
Normal file
|
@ -0,0 +1,7 @@
|
|||
#lang racket/base
|
||||
(require "src-a.rkt"
|
||||
"src-b.rkt"
|
||||
"src-c.rkt"
|
||||
(submod "src-c.rkt" s))
|
||||
|
||||
(void cs)
|
Loading…
Reference in New Issue
Block a user