I need to revert this because it horribly breaks the bootstrapping
phase. It may be possible to make the core have a package in the
future, but it's not an easy change.
Jay
On Wed, Sep 3, 2014 at 10:44 AM, wrote:
> jay has updated `master' from b942a21846 to 92d5408aa8.
> http://git.racket-lang.org/plt/b942a21846..92d5408aa8
>
> =[ One Commit ]=
> Directory summary:
>3.9% pkgs/racket-pkgs/racket-test/tests/pkg/
> 96.0% racket/collects/pkg/
>
> ~~
>
> 92d5408 Jay McCarthy 2014-09-03 10:43
> :
> | Fix PR14692
> :
> M pkgs/racket-pkgs/racket-test/tests/pkg/path.rkt | 7 ++
> M racket/collects/pkg/path.rkt| 113
> -
>
> =[ Overall Diff ]===
>
> pkgs/racket-pkgs/racket-test/tests/pkg/path.rkt
> ~~~
> --- OLD/pkgs/racket-pkgs/racket-test/tests/pkg/path.rkt
> +++ NEW/pkgs/racket-pkgs/racket-test/tests/pkg/path.rkt
> @@ -1,10 +1,17 @@
> #lang racket/base
> (require pkg/path
> + syntax/modresolve
> setup/dirs)
>
> (module+ test
>(require rackunit)
>
> + (check-equal? (path->pkg (resolve-module-path 'typed/racket #f))
> +"typed-racket-lib")
> +
> + (check-equal? (path->pkg (resolve-module-path 'racket #f))
> +"base")
> +
>(check-equal? (path->pkg (collection-file-path "path.rkt" "tests" "pkg"))
> "racket-test")
>(check-equal? (call-with-values
>
> racket/collects/pkg/path.rkt
>
> --- OLD/racket/collects/pkg/path.rkt
> +++ NEW/racket/collects/pkg/path.rkt
> @@ -69,6 +69,9 @@
> [orig-pkg `(catalog ,(cadr (pkg-info-orig-pkg
> v)))])
>v)
>
> +(define (mbind m f)
> + (and m (f m)))
> +
> (define (path->pkg+subpath+collect* who given-p cache want-collect?)
>(unless (path-string? given-p)
> (raise-argument-error who "path-string?" given-p))
> @@ -88,62 +91,72 @@
>(define p (explode given-p))
>(define (build-path* l)
> (if (null? l) 'same (apply build-path l)))
> - (for/fold ([pkg #f] [subpath #f] [collect #f])
> - ([scope (in-list (list* 'user
> - (get-pkgs-search-dirs)))]
> - #:when (not pkg))
> -(define d (or (and cache
> - (hash-ref cache `(dir ,scope) #f))
> - (let ([d (explode (get-pkgs-dir scope))])
> -(when cache (hash-set! cache `(dir ,scope) d))
> -d)))
> -(define (read-pkg-db/cached)
> - (or (and cache
> - (hash-ref cache `(db ,scope) #f))
> - (let ([db (read-pkgs-db scope)])
> -(when cache (hash-set! cache `(db ,scope) db))
> -db)))
> -(cond
> - [(sub-path? < p d)
> - ;; Under the installation mode's package directory.
> - ;; We assume that no one else writes there, so the
> - ;; next path element is the package name (or the package
> - ;; name followed by "+")
> - (define len (length d))
> - (define pkg-name (path-element->string (list-ref p len)))
> - (if (regexp-match? #rx"pkgs[.]rktd" pkg-name)
> - (values #f #f #f) ; don't count the database as a package
> - (values (if (regexp-match? #rx"[+]" pkg-name) ; + used as an
> alternate path, sometimes
> + (define cdp (mbind (find-collects-dir) explode))
> + (cond
> +[(and cdp (sub-path? < p cdp))
> + (define len (length cdp))
> + ;; This might need to be something else in the future, if base
> + ;; gets smaller
> + (values "base"
> + (build-path* (list-tail p (add1 len)))
> + #f)]
> +[else
> + (for/fold ([pkg #f] [subpath #f] [collect #f])
> + ([scope (in-list (list* 'user
> + (get-pkgs-search-dirs)))]
> + #:when (not pkg))
> + (define d (or (and cache
> + (hash-ref cache `(dir ,scope) #f))
> + (let ([d (explode (get-pkgs-dir scope))])
> + (when cache (hash-set! cache `(dir ,scope) d))
> + d)))
> + (define (read-pkg-db/cached)
> + (or (and cache
> + (hash-ref cache `(db ,scope) #f))
> + (let ([db (read-pkgs-db scope)])
> + (when cache (hash-set! cache `(db ,scope) db))
> + db)))
> + (cond
> + [(sub-path? < p d)
> + ;; Under the installation mode's package directory.
> + ;; We assume that no one else writes there, so the
> + ;; next path element is the package name (or the package
> + ;; name followed by "+")
> + (define len (length d))
> + (define pkg-name (path-element->string (list-ref p len)))
> + (if (regexp-match? #rx"pkgs[.]rktd" pkg-name)
> +(values #f #f #f) ; do
