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, <j...@racket-lang.org> 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 <j...@racket-lang.org> 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 "+<n>") > - (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) ; +<n> 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 "+<n>") > + (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) ; +<n> used as an > alternate path, sometimes > (regexp-replace #rx"[+].*$" pkg-name "") > pkg-name) > - (build-path* (list-tail p (add1 len))) > - (and want-collect? > - (let ([i (hash-ref (read-pkg-db/cached) pkg-name #f)]) > - (and i (sc-pkg-info? i) (sc-pkg-info-collect > i))))))] > - [else > - ;; Maybe it's a linked package > - (define pkgs-dir (get-pkgs-dir scope)) > - (for/fold ([pkg #f] [subpath #f] [collect #f]) > - ([(k v) (in-hash (read-pkg-db/cached))] > - #:when (not pkg)) > - (define orig (pkg-info-orig-pkg v)) > - (if (and (pair? orig) > - (or (eq? 'link (car orig)) > - (eq? 'static-link (car orig)))) > - (let ([e (or (and cache > - (hash-ref cache `(pkg-dir ,(cadr orig)) #f)) > - (let ([e (explode (simplify-path > - (path->complete-path (cadr orig) > pkgs-dir) > - #f))]) > - (when cache > - (hash-set! cache `(pkg-dir ,(cadr orig)) e)) > - e))]) > - (if (sub-path? <= p e) > + (build-path* (list-tail p (add1 len))) > + (and want-collect? > + (let ([i (hash-ref (read-pkg-db/cached) pkg-name > #f)]) > + (and i (sc-pkg-info? i) (sc-pkg-info-collect > i))))))] > + [else > + ;; Maybe it's a linked package > + (define pkgs-dir (get-pkgs-dir scope)) > + (for/fold ([pkg #f] [subpath #f] [collect #f]) > + ([(k v) (in-hash (read-pkg-db/cached))] > + #:when (not pkg)) > + (define orig (pkg-info-orig-pkg v)) > + (if (and (pair? orig) > + (or (eq? 'link (car orig)) > + (eq? 'static-link (car orig)))) > + (let ([e (or (and cache > + (hash-ref cache `(pkg-dir ,(cadr orig)) #f)) > + (let ([e (explode (simplify-path > + (path->complete-path (cadr > orig) pkgs-dir) > + #f))]) > + (when cache > + (hash-set! cache `(pkg-dir ,(cadr orig)) e)) > + e))]) > + (if (sub-path? <= p e) > (values k > (build-path* (list-tail p (length e))) > (and (sc-pkg-info? v) (sc-pkg-info-collect v))) > (values #f #f #f))) > - (values #f #f #f)))]))) > + (values #f #f #f)))]))])) > > (define (path->pkg+subpath+collect given-p #:cache [cache #f]) > (path->pkg+subpath+collect* 'path->pkg+subpath+collect given-p cache #t)) -- Jay McCarthy http://jeapostrophe.github.io "Wherefore, be not weary in well-doing, for ye are laying the foundation of a great work. And out of small things proceedeth that which is great." - D&C 64:33 _________________________ Racket Developers list: http://lists.racket-lang.org/dev
