From 2bc2050c085ec4d51146c536c4966673e6d39b2d Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Mon, 22 Aug 2011 07:49:49 -0400
Subject: [PATCH] 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.
---
 collects/tests/xrepl/xrepl.rkt | 15 +++++++++++++--
 collects/xrepl/xrepl.rkt       |  8 +++++++-
 2 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/collects/tests/xrepl/xrepl.rkt b/collects/tests/xrepl/xrepl.rkt
index 5128c30761..0852e685f2 100644
--- a/collects/tests/xrepl/xrepl.rkt
+++ b/collects/tests/xrepl/xrepl.rkt
@@ -70,8 +70,10 @@
        (repl-> (car strs))
        (loop (cdr strs) #f)])))
 
+(define tmp (path->string (find-system-path 'temp-dir)))
+
 (provide test-xrepl)
-(define test-xrepl @make-xrepl-test|={
+(define test-xrepl @make-xrepl-test{
   -> «(- 2 1)»
   1
   -> «(values 2 3)»
@@ -121,5 +123,14 @@
   ;   imports: mzlib/runtime-path.rkt, racket/base.rkt.
   ;   imports-for-syntax: racket/base.rkt.
   ;   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»
-  |=@||}=|)
+  @||})
diff --git a/collects/xrepl/xrepl.rkt b/collects/xrepl/xrepl.rkt
index 0a94d3cf4d..47466b34ae 100644
--- a/collects/xrepl/xrepl.rkt
+++ b/collects/xrepl/xrepl.rkt
@@ -554,7 +554,13 @@
               [else (cmderror "not an identifier or a known module: ~s" dtm)]))
       (define bind? (or bind (not mod)))
       (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 at-phase (phase->name level " (~a)"))
   (cond