From 6027eb9627c612303a23a8fcc8c2010cb39a93b2 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 6 May 2010 07:21:54 -0600
Subject: [PATCH] fix raco setup handling of info.rkt by adding a namespace
 argument to get-info

---
 collects/scribblings/raco/setup.scrbl | 20 +++++++++++++-------
 collects/setup/getinfo.rkt            | 19 ++++++++++---------
 collects/setup/setup-unit.rkt         |  2 +-
 3 files changed, 24 insertions(+), 17 deletions(-)

diff --git a/collects/scribblings/raco/setup.scrbl b/collects/scribblings/raco/setup.scrbl
index 63768ac82f..72d6989cba 100644
--- a/collects/scribblings/raco/setup.scrbl
+++ b/collects/scribblings/raco/setup.scrbl
@@ -984,15 +984,17 @@ An @deftech{unpackable} is one of the following:
    provides functions for accessing fields in @filepath{info.rkt}
    files.}
 
-@defproc[(get-info (collection-names (listof string?)))
+@defproc[(get-info [collection-names (listof string?)]
+                   [#:namespace namespace (or/c namespace? #f) #f])
          (or/c
           (symbol? [(-> any)] . -> . any)
           false/c)]{
    Accepts a list of strings naming a collection or sub-collection,
    and calls @racket[get-info/full] with the full path corresponding to the
-   named collection.}
+   named collection and the @scheme[namespace] argument.}
 
-@defproc[(get-info/full (path path?))
+@defproc[(get-info/full [path path?]
+                         [#:namespace namespace (or/c namespace? #f) #f])
          (or/c
           (symbol? [(-> any)] . -> . any)
           false/c)]{
@@ -1010,16 +1012,20 @@ An @deftech{unpackable} is one of the following:
    case. If the name is not defined and no @racket[_thunk] is
    provided, then an exception is raised.
    
-   @racket[get-info/full] returns @racket[#f] if there is
-   no @filepath{info.rkt} or @filepath{info.rkt} file in the directory. If there is a
-   @filepath{info.rkt} file that has the wrong shape (i.e., not a module
+   The @racket[get-info/full] function returns @racket[#f] if there is
+   no @filepath{info.rkt} or @filepath{info.ss} file in the directory. If there is a
+   @filepath{info.rkt} (or @filepath{info.ss}) file that has the wrong shape (i.e., not a module
    using @racketmodname[setup/infotab] or @racket[(lib "infotab.rkt" "setup")]),
    or if the @filepath{info.rkt} file fails to load, then an exception
    is raised. If the @filepath{info.rkt} file loaded, @racket[get-info/full]
    returns the @racket[get-info] file. If the @filepath{info.rkt} file does not exist, 
    then @racket[get-info/full] does
    the same checks for the @filepath{info.rkt} file, either raising an exception
-   or returning the @racket[get-info] function from the @filepath{info.rkt} file.}
+   or returning the @racket[get-info] function from the @filepath{info.rkt} file.
+
+   The @filepath{info.rkt} (or @filepath{info.ss}) module is loaded
+   into @scheme[namespace] if it is not @scheme[#f], or a private,
+   weakly-held namespace otherwise.}
 
 @defproc[(find-relevant-directories
           (syms (listof symbol?))
diff --git a/collects/setup/getinfo.rkt b/collects/setup/getinfo.rkt
index e23469c8f5..cd6541b350 100644
--- a/collects/setup/getinfo.rkt
+++ b/collects/setup/getinfo.rkt
@@ -8,10 +8,11 @@
 (define user-infotable (get-planet-cache-path))
 
 ;; get-info : (listof path-or-string) -> info/#f
-(define (get-info coll-path)
+(define (get-info coll-path #:namespace [ns #f])
   (get-info/full (apply collection-path
                         (map (lambda (x) (if (path? x) (path->string x) x))
-                             coll-path))))
+                             coll-path))
+                 #:namespace ns))
 
 ;; HACK:
 ;; This require is not used.  It just requires the file, since
@@ -24,11 +25,11 @@
 (require (prefix-in !!!HACK!!! setup/infotab/lang/reader))
 
 ;; get-info/full : path -> info/#f
-(define (get-info/full dir)
-  (or (get-info/full/ext dir "rkt")
-      (get-info/full/ext dir "ss")))
+(define (get-info/full dir #:namespace [ns #f])
+  (or (get-info/full/ext dir "rkt" ns)
+      (get-info/full/ext dir "ss" ns)))
 
-(define (get-info/full/ext dir ext)
+(define (get-info/full/ext dir ext ns)
   (define file (build-path dir (format "info.~a" ext)))
   (define (err fmt . args)
     (apply error 'get-info (string-append "info file " fmt " in ~a")
@@ -60,7 +61,7 @@
           ;; that is required).
           ;; We are, however, trusting that the bytecode form of the
           ;; file (if any) matches the source.
-          (parameterize ([current-namespace (info-namespace)])
+          (parameterize ([current-namespace (or ns (info-namespace))])
             (dynamic-require file '#%info-lookup))]
          [else (err "does not contain a module of the right shape")])))
 
@@ -201,8 +202,8 @@
 
 (provide/contract
  (reset-relevant-directories-state! (-> any))
- (get-info ((listof path-or-string?) . -> . (or/c info? boolean?)))
- (get-info/full (path? . -> . (or/c info? boolean?)))
+ (get-info (((listof path-or-string?)) (#:namespace (or/c namespace? #f)) . ->* . (or/c info? boolean?)))
+ (get-info/full ((path?) (#:namespace (or/c namespace? #f)) . ->* . (or/c info? boolean?)))
  (find-relevant-directories
   (->* [(listof symbol?)]
        [(lambda (x) (memq x '(preferred all-available)))]
diff --git a/collects/setup/setup-unit.rkt b/collects/setup/setup-unit.rkt
index 0134f3d986..adc8b797b7 100644
--- a/collects/setup/setup-unit.rkt
+++ b/collects/setup/setup-unit.rkt
@@ -41,7 +41,7 @@
                      [current-compile compile]
                      [current-load/use-compiled loader]
                      [use-compiled-file-paths paths])
-        (get-info/full path)))))
+        (get-info/full path #:namespace ns)))))
 
 (provide setup@)