suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco setup: make --check-pkg-deps work on a collection subset

Browse Source 
Lift the remaining caveat about using `--check-pkg-deps` when
supplying specific collections to `raco setup`.
This commit is contained in:
Matthew Flatt 2014-12-01 10:10:19 -07:00
parent 592ea25ee2
commit 2e69ece74b
6 changed files with 86 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl
View File

@ -330,6 +330,8 @@ The @racket[name] parameter is the name of the new package.
@defproc[(pkg-show [indent string?]
[#:auto? auto? boolean? #f]
[#:long? long? boolean? #f]
[#:directory show-dir? boolean? #f])
void?]{
@ -338,7 +340,9 @@ printing to the current output port. See also
@racket[installed-pkg-names] and @racket[installed-pkg-table].
The package lock must be held to allow reads; see
@racket[with-pkg-lock/read-only].}
@racket[with-pkg-lock/read-only].
@history[#:changed "6.1.1.5" @elem{Added the @racket[#:long?] argument.}]}
@defproc[(pkg-migrate [from-version string?]

21
pkgs/racket-pkgs/racket-doc/pkg/scribblings/path.scrbl
View File

@ -76,6 +76,16 @@ Like @racket[path->pkg], but returns a second value that represents
the remainder of @racket[path] within the package's directory.}
@defproc[(path->pkg+subpath+scope [path path-string?]
[#:cache cache (or/c #f (and/c hash? (not/c immutable?)))])
(values (or/c string? #f)
(or/c path? 'same #f)
(or/c 'installation 'user (and/c path? complete-path?) #f))]{
Like @racket[path->pkg+subpath], but returns a third value for the package's
installation scope.}
@defproc[(path->pkg+subpath+collect [path path-string?]
[#:cache cache (or/c #f (and/c hash? (not/c immutable?)))])
(values (or/c string? #f) (or/c path? 'same #f) (or/c string? #f))]{
@ -85,6 +95,17 @@ collection name if the package is a single-collection package,
@racket[#f] otherwise.}
@defproc[(path->pkg+subpath+collect+scope [path path-string?]
[#:cache cache (or/c #f (and/c hash? (not/c immutable?)))])
(values (or/c string? #f)
(or/c path? 'same #f)
(or/c string? #f)
(or/c 'installation 'user (and/c path? complete-path?) #f))]{
Like @racket[path->pkg+subpath+collects], but returns a fourth value for
the package's installation scope.}
@defproc[(get-pkgs-dir [scope (or/c 'installation 'user 'shared
(and/c path? complete-path?))]
[user-version string? (version)])

4
pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl
View File

@ -187,9 +187,7 @@ flags:
@item{@DFlag{check-pkg-deps} --- checks package dependencies (unless
explicitly disabled) even when specific collections are provided to
@exec{raco setup}, and even for packages that have no
dependency declarations. Currently, dependency checking related to
documentation cross-referencing is constrained to documents among
specified collections.}
dependency declarations.}
@item{@DFlag{fix-pkg-deps} --- attempt to correct dependency
mismatches by adjusting package @filepath{info.rkt} files (which makes

16
pkgs/racket-pkgs/racket-test/tests/pkg/path.rkt
View File

@ -4,17 +4,31 @@
(module+ test
(require rackunit)
(check-equal? (path->pkg (collection-file-path "path.rkt" "tests" "pkg"))
"racket-test")
(check-equal? (call-with-values
(lambda () (path->pkg+subpath (collection-file-path "path.rkt" "tests" "pkg")))
list)
(list "racket-test" (build-path "tests" "pkg" "path.rkt")))
;; We don't know the scope where these tests are installed, but we want to
;; at least call the `...+scope` variants:
(define-values (racket-test-pkg racket-test-subpath scope)
(path->pkg+subpath+scope (collection-file-path "path.rkt" "tests" "pkg")))
(check-equal? (call-with-values
(lambda () (path->pkg+subpath+scope (collection-file-path "path.rkt" "tests" "pkg")))
list)
(list "racket-test" (build-path "tests" "pkg" "path.rkt") scope))
(check-equal? (call-with-values
(lambda () (path->pkg+subpath+collect (collection-file-path "path.rkt" "tests" "pkg")))
list)
(list "racket-test" (build-path "tests" "pkg" "path.rkt") #f))
(check-equal? (call-with-values
(lambda () (path->pkg+subpath+collect+scope (collection-file-path "path.rkt" "tests" "pkg")))
list)
(list "racket-test" (build-path "tests" "pkg" "path.rkt") #f scope))
(check-equal? (path->pkg (find-system-path 'temp-dir))
#f)

40
racket/collects/pkg/path.rkt
View File

@ -10,7 +10,9 @@
read-pkg-file-hash
path->pkg
path->pkg+subpath
path->pkg+subpath+collect)
path->pkg+subpath+scope
path->pkg+subpath+collect
path->pkg+subpath+collect+scope)
(struct pkg-info (orig-pkg checksum auto?) #:prefab)
(struct pkg-info/alt pkg-info (dir-name) #:prefab) ; alternate installation directory
@ -88,7 +90,7 @@
(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])
(for/fold ([pkg #f] [subpath #f] [collect #f] [install-scope #f])
([scope (in-list (list* 'user
(get-pkgs-search-dirs)))]
#:when (not pkg))
@ -112,18 +114,19 @@
(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 #f #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))))))]
(and i (sc-pkg-info? i) (sc-pkg-info-collect i))))
scope))]
[else
;; Maybe it's a linked package
(define pkgs-dir (get-pkgs-dir scope))
(for/fold ([pkg #f] [subpath #f] [collect #f])
(for/fold ([pkg #f] [subpath #f] [collect #f] [install-scope #f])
([(k v) (in-hash (read-pkg-db/cached))]
#:when (not pkg))
(define orig (pkg-info-orig-pkg v))
@ -142,19 +145,30 @@
(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)))])))
(and (sc-pkg-info? v) (sc-pkg-info-collect v))
scope)
(values #f #f #f #f)))
(values #f #f #f #f)))])))
(define (path->pkg+subpath+collect given-p #:cache [cache #f])
(define (path->pkg+subpath+collect+scope given-p #:cache [cache #f])
(path->pkg+subpath+collect* 'path->pkg+subpath+collect given-p cache #t))
(define (path->pkg+subpath given-p #:cache [cache #f])
(define-values (pkg rest rest2)
(define (path->pkg+subpath+collect given-p #:cache [cache #f])
(define-values (pkg subpath collect scope)
(path->pkg+subpath+collect* 'path->pkg+subpath+collect given-p cache #t))
(values pkg subpath collect))
(define (path->pkg+subpath+scope given-p #:cache [cache #f])
(define-values (pkg subpath collect scope)
(path->pkg+subpath+collect* 'path->pkg+subpath given-p cache #f))
(values pkg rest))
(values pkg subpath scope))
(define (path->pkg+subpath given-p #:cache [cache #f])
(define-values (pkg subpath collect scope)
(path->pkg+subpath+collect* 'path->pkg+subpath given-p cache #f))
(values pkg subpath))
(define (path->pkg given-p #:cache [cache #f])
(define-values (pkg rest rest2)
(define-values (pkg subpath collect scope)
(path->pkg+subpath+collect* path->pkg given-p cache #f))
pkg)

17
racket/collects/setup/private/pkg-deps.rkt
View File

@ -318,8 +318,14 @@
;; ----------------------------------------
(define doc-pkgs (make-hash))
(define doc-reported (make-hash))
(define doc-all-registered? #f)
(define (check-doc! pkg dep dest-dir)
(define-values (base name dir?) (split-path dep))
(when (and all-pkgs-lazily?
(not doc-all-registered?)
(not (hash-ref doc-pkgs base #f)))
(set! doc-all-registered? #t)
(register-all-docs!))
(define src-pkg (hash-ref doc-pkgs base #f))
(when src-pkg
(unless (check-dep! pkg src-pkg 'build)
@ -424,6 +430,17 @@
[else
(hash-set! doc-pkgs (path->directory-path dest-dir) pkg)])))))
(define (register-all-docs!)
(define pkg-cache (make-hash))
(define dirs (find-relevant-directories '(scribblings)))
(for ([dir (in-list dirs)])
(define-values (pkg subpath scope) (path->pkg+subpath+scope dir #:cache pkg-cache))
(when pkg
(define main? (not (eq? scope 'user)))
(register-or-check-docs #f pkg dir main?))))
;; ----------------------------------------
;; For each collection, set up package info:
(for ([path (in-list paths)]
[coll-main? (in-list coll-main?s)])