commit 12e710ab30b7792ffa46b57d5a424eed3bbbc3bf
parent 982cd95c6b7f41b2696082a12f4811dbba360e50
Author: Ryan Culpepper <ryanc@racket-lang.org>
Date: Mon, 23 Apr 2012 16:55:53 -0600
fix check-requires for submodules
original commit: 0b8b0c36ef80c79f0f9e7762ce1c5383917fd19e
Diffstat:
7 files changed, 58 insertions(+), 21 deletions(-)
diff --git a/collects/macro-debugger/analysis/private/moduledb.rkt b/collects/macro-debugger/analysis/private/moduledb.rkt
@@ -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
diff --git a/collects/macro-debugger/analysis/private/util.rkt b/collects/macro-debugger/analysis/private/util.rkt
@@ -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]))))
;; --------
diff --git a/collects/tests/macro-debugger/check-requires/src-a.rkt b/collects/tests/macro-debugger/check-requires/src-a.rkt
@@ -0,0 +1,3 @@
+#lang racket/base
+(define a 1)
+(provide a)
diff --git a/collects/tests/macro-debugger/check-requires/src-b.rkt b/collects/tests/macro-debugger/check-requires/src-b.rkt
@@ -0,0 +1,3 @@
+#lang racket/base
+(define b 2)
+(provide b)
diff --git a/collects/tests/macro-debugger/check-requires/src-c.rkt b/collects/tests/macro-debugger/check-requires/src-c.rkt
@@ -0,0 +1,8 @@
+#lang racket/base
+
+(module s racket/base
+ (define cs 30)
+ (provide cs))
+
+(define c 3)
+(provide c)
diff --git a/collects/tests/macro-debugger/check-requires/use-a.rkt b/collects/tests/macro-debugger/check-requires/use-a.rkt
@@ -0,0 +1,7 @@
+#lang racket/base
+(require "src-a.rkt"
+ "src-b.rkt"
+ "src-c.rkt"
+ (submod "src-c.rkt" s))
+
+(void a)
diff --git a/collects/tests/macro-debugger/check-requires/use-cs.rkt b/collects/tests/macro-debugger/check-requires/use-cs.rkt
@@ -0,0 +1,7 @@
+#lang racket/base
+(require "src-a.rkt"
+ "src-b.rkt"
+ "src-c.rkt"
+ (submod "src-c.rkt" s))
+
+(void cs)
