Fix when showing the description of a module.

Set `current-load-relative-directory' to the path of the module file so
paths that it resolves in the description (in `describe-modeul') are not
bogus.
This commit is contained in:
Eli Barzilay 2011-08-22 07:49:49 -04:00
parent e2e2cedead
commit 2bc2050c08
2 changed files with 20 additions and 3 deletions

View File

@ -70,8 +70,10 @@
(repl-> (car strs)) (repl-> (car strs))
(loop (cdr strs) #f)]))) (loop (cdr strs) #f)])))
(define tmp (path->string (find-system-path 'temp-dir)))
(provide test-xrepl) (provide test-xrepl)
(define test-xrepl @make-xrepl-test|={ (define test-xrepl @make-xrepl-test{
-> «(- 2 1)» -> «(- 2 1)»
1 1
-> «(values 2 3)» -> «(values 2 3)»
@ -121,5 +123,14 @@
; imports: mzlib/runtime-path.rkt, racket/base.rkt. ; imports: mzlib/runtime-path.rkt, racket/base.rkt.
; imports-for-syntax: racket/base.rkt. ; imports-for-syntax: racket/base.rkt.
; direct syntax exports: define-runtime-module-path. ; direct syntax exports: define-runtime-module-path.
-> «(current-directory "/( none )")» racket allows this
; now in /( none ) ⇒ reports without ,cd
-> «,cd @|tmp|»
; now in @tmp
-> «,desc scribble/html»
; `scribble/html' is a module,
; located at scribble/html.rkt
; imports: racket/base.rkt, scribble/html/main.rkt.
; no direct exports.
-> «,ex» -> «,ex»
|=@||}=|) @||})

View File

@ -554,7 +554,13 @@
[else (cmderror "not an identifier or a known module: ~s" dtm)])) [else (cmderror "not an identifier or a known module: ~s" dtm)]))
(define bind? (or bind (not mod))) (define bind? (or bind (not mod)))
(when bind? (describe-binding dtm bind level)) (when bind? (describe-binding dtm bind level))
(when mod (describe-module dtm mod bind?))))) (when mod
(parameterize (;; without this the reported paths are wrong
[current-load-relative-directory
(and (path? mod)
(let-values ([(base name dir?) (split-path mod)])
(and (path? base) base)))])
(describe-module dtm mod bind?))))))
(define (describe-binding sym b level) (define (describe-binding sym b level)
(define at-phase (phase->name level " (~a)")) (define at-phase (phase->name level " (~a)"))
(cond (cond