raco setup: add package-dependency checking

The new `--no-pkg-deps' or `-K' flag skips the check.

If a module in package X refers to a module in package Y, check that
package X declares a dependency on Y.  Note that package X must
specifically depend on Y --- not another package that at the moment
happens to declare a dependency on Y.

A new "base" package represents the content of the core (so that, if
the core shrinks, a new "base2" can represent the smaller core).
Most every package now needs a dependency on "base".

Sometimes, it makes sense for X to access Y when X declares a
dependency on Z, because Z promises to always depend on Y.  For
example, the "gui" package is defined to combne "gui-lib" and
"gui-doc", so it's appropriate to use the modules of "gui-lib" when
depending on "gui". A package's "info.rkt" can therefore define
`implies' as a subset of the dependencies listed in `deps', which
means that depending on the package implies a dependency on the listed
packages. (It's even possible for packages to mutually imply each
other, which is why the dependency checking code ends up with a
union-find.)

Dependency checking distinguishes between run-time dependencies and
build-time dependencies: anything listed in a ".dep" file is a build
dependency, at least. To imply a run-time dependency, a reference must
appear in a bytecode file's imports, and not in a subdirectory or
submodule that would be pruned for a binary package.

The `--fix-pkg-deps' flag attempts to automatically fix package
dependency declarations (i.e., modify a package's "info.rkt" file)
based on inferred dependencies.

pkgs/base/info.rkt

@@ -0,0 +1,11 @@
+#lang setup/infotab
+
+;; The "base" package exists only as a way to declare dependencies
+;; on the current Racket core. If the core gets smaller in the
+;; future, then "base" can have new dependencies to cover things
+;; moved out of the core, while a new "base2" package can represent
+;; the new, smaller core.
+
+(define collection 'multi)
+
+(define implies '(core))

pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl

@@ -78,10 +78,11 @@ catalogs}.}
 A structure type that is used to report installed-package information.}
 
 
-@defproc[(pkg-directory [name string?]) path-string?]{
+@defproc[(pkg-directory [name string?]) (or/c path-string? #f)]{
 
 Returns the directory that holds the installation of the installed
-(in any scope) package @racket[name].}
+(in any scope) package @racket[name], or @racket[#f] if no such package
+is installed.}
 
 
 @defproc[(path->pkg [path path-string?]) (or/c string? #f)]{
@@ -129,16 +130,25 @@ dependency.}
 
 
 @defproc[(pkg-stage [desc pkg-desc?]
-                        [#:checksum checksum (or/c #f string?) #f])
+                    [#:checksum checksum (or/c #f string?) #f]
-         (values string? path? (or/c #f string?) boolean?)]{
+                    [#:in-place? in-place? boolean? #f]
+                    [#:namespace namespace namespace? (make-base-namespace)])
+         (values string? path? (or/c #f string?) boolean? (listof module-path?))]{
 
-Locates the implementation of the package specified by @racket[desc] and
+Locates the implementation of the package specified by @racket[desc]
-downloads and unpacks it to a temporary directory (as needed).
+and downloads and unpacks it to a temporary directory (as needed).
+
+If @racket[desc] refers to an existing directory and
+@racket[in-place?]  is true, then the directory is used in place.
+
+The @racket[namespace] argument is passed along to
+@racket[get-info/full] when the package's @filepath{info.rkt} is
+loaded.
 
 The result is the package name, the directory containing the unpacked package content,
-the checksum (if any) for the unpacked package, and whether the
+the checksum (if any) for the unpacked package, whether the
 directory should be removed after the package content is no longer
-needed.}
+needed, and a list of module paths provided by the package.}
 
 
 @defproc[(pkg-config [set? boolean?] [keys/vals list?])
@@ -345,3 +355,19 @@ The results are as follows:
        @racket[get-info].}
 
 ]}
+
+@defproc[(extract-pkg-dependencies [info (symbol? (-> any/c) . -> . any/c)]
+                                   [#:build-deps? build-deps? boolean? #f]
+                                   [#:filter? filter? boolean? #f])
+         (listof (or/c string? (cons/c string? list?)))]{
+
+Returns packages dependencies reported by the @racket[info] procedure
+(normally produced by @racket[get-info]).
+
+If @racket[build-deps?] is true, then the result includes both
+run-time dependencies and build-time dependencies.
+
+If @racket[filter?] is true, then platform-specific dependencies are
+removed from the result list when they do not apply to the current
+platform, and other information is stripped so that the result list is
+always a list of strings.}

pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl

@@ -816,6 +816,18 @@ The following @filepath{info.rkt} fields are used by the package manager:
        @racketidfont{build-deps} when converting a package for
        @DFlag{binary} mode.}
 
+ @item{@racketidfont{implies} --- a list of strings and
+       @racket['core]. Each string refers to a package listed in the
+       @racketidfont{deps} and indicates that a dependency on the
+       current package counts as a dependency on named package; for
+       example, the @pkgname{gui} package is defined to ensure access
+       to all of the libraries provided by @pkgname{gui-lib}, so the
+       @filepath{info.rkt} file of @pkgname{gui} lists
+       @racket["gui-lib"] in @racketidfont{implies}. The special value
+       @racket['core] is intended for use by an appropriate
+       @pkgname{base} package to declare it as the representative of
+       core Racket libraries.}
+
  @item{@racketidfont{setup-collects} --- a list of path strings and/or
        lists of path strings, which are used as collection names to
        set up via @exec{raco setup} after the package is installed, or

pkgs/racket-pkgs/racket-doc/scribblings/raco/setup.scrbl

@@ -166,6 +166,16 @@ flags:
  @item{@DFlag{avoid-main} --- refrain from any setup actions that
   affect the installation, as opposed to user-specific actions.}
 
+ @item{@DFlag{no-pkg-deps} or @Flag{K} --- refrain from checking whether dependencies among
+  libraries are properly reflected by package-level dependency
+  declarations. The check uses compiled bytecode and associated
+  @filepath{.dep} files, and it checks only files are setup against
+  only packages that include files that are setup.}
+
+ @item{@DFlag{fix-pkg-deps} --- attempt to correct dependency
+  mismatches by adjusting package @filepath{info.rkt} files (which makes
+  sense only for packages that are installed as links).}
+
  @item{@DFlag{mode} @nonterm{mode} --- use a @filepath{.zo} compiler
    other than the default compiler, and put the resulting
    @filepath{.zo} files in a subdirectory (of the usual place) named
@@ -176,16 +186,16 @@ flags:
    @racket[compile]; see the @filepath{errortrace} collection for an
    example.}
 
- @item{@DFlag{verbose} or @Flag{v} --- More verboase output about
+ @item{@DFlag{verbose} or @Flag{v} --- more verbose output about
    @exec{raco setup} actions.}
 
- @item{@DFlag{make-verbose} or @Flag{m} --- More verboase output about
+ @item{@DFlag{make-verbose} or @Flag{m} --- more verbose output about
    dependency checks.}
 
- @item{@DFlag{compiler-verbose} or @Flag{r} --- Even more verbose
+ @item{@DFlag{compiler-verbose} or @Flag{r} --- even more verbose
    output about dependency checks and compilation.}
 
- @item{@DFlag{pause} or @Flag{p} --- Pause for user input if any
+ @item{@DFlag{pause} or @Flag{p} --- pause for user input if any
   errors are reported (so that a user has time to inspect output that
   might otherwise disappear when the @exec{raco setup} process ends).}
 

pkgs/racket-pkgs/racket-test/tests/pkg/tests-deps.rkt

@@ -134,6 +134,7 @@
    (with-fake-root
     (shelly-case
      "remote - fail"
+     $ "raco pkg config --set catalogs http://localhost:9990"
      $ "racket -e '(require pkg-test2)'" =exit> 1
      $ "raco pkg install --deps fail pkg-test2" =exit> 1
      $ "racket -e '(require pkg-test2)'" =exit> 1)))))

pkgs/racket-pkgs/racket-test/tests/pkg/tests-install.rkt

@@ -36,6 +36,9 @@
    (shelly-install "remote/URL/http package (directory)"
                    "http://localhost:9999/pkg-test1/")
 
+   (with-fake-root
+    (shelly-begin
+     $ "raco pkg config --set catalogs http://localhost:9990 http://localhost:9991"
      (shelly-case
       "fails due to unrecognized scheme"
       $ "raco pkg install magic://download" =exit> 1)
@@ -47,7 +50,7 @@
       $ "raco pkg install tests-install.rkt" =exit> 1)
      (shelly-case
       "not a valid (inferred) package name"
-    $ "raco pkg install 1+2" =exit> 1)
+      $ "raco pkg install 1+2" =exit> 1)))
 
    (shelly-case
     "local file fails because called a directory"

pkgs/redex/tut-subst.rkt

@@ -17,8 +17,7 @@ for untyped.
 |#
 
 (require racket/set racket/match
-         redex/reduction-semantics
+         redex/reduction-semantics)
-         rackunit)
 (provide subst/proc fvs)
 
 (define (subst/proc x? vars replacements body)

racket/lib/collects/pkg/lib.rkt

@@ -581,7 +581,8 @@
            [_
             (build-path (pkg-installed-dir) pkg-name)]))))
 
-(define (path->pkg+subpath given-p)
+(define (path->pkg+subpath given-p
+                           #:cache [cache #f])
   (define (explode p)
     (explode-path
      (normal-case-path
@@ -596,9 +597,21 @@
     (if (null? l) 'same (apply build-path l)))
   (for/fold ([pkg #f] [subpath #f]) ([scope (in-list (get-scope-list))]
                                      #:when (not pkg))
+    (define d (or (and cache
+                       (hash-ref cache `(dir ,scope) #f))
                   (parameterize ([current-pkg-scope scope])
                     (with-pkg-lock/read-only
                      (define d (explode (pkg-installed-dir)))
+                     (when cache (hash-set! cache `(dir ,scope) d))
+                     d))))
+    (define (read-pkg-db/cached)
+      (or (and cache
+               (hash-ref cache `(db ,scope) #f))
+          (parameterize ([current-pkg-scope scope])
+            (with-pkg-lock/read-only
+             (define db (read-pkg-db))
+             (when cache (hash-set! cache `(db ,scope) db))
+             db))))
     (cond
      [(sub-path? < p d)
       ;; Under the installation mode's package directory.
@@ -609,7 +622,7 @@
               (build-path* (list-tail p (add1 len))))]
      [else
       ;; Maybe it's a linked package
-         (for/fold ([pkg #f] [subpath #f]) ([(k v) (in-hash (read-pkg-db))]
+      (for/fold ([pkg #f] [subpath #f]) ([(k v) (in-hash (read-pkg-db/cached))]
                                          #:when (not pkg))
         (match (pkg-info-orig-pkg v)
           [`(link ,orig-pkg-dir)
@@ -617,10 +630,11 @@
            (if (sub-path? <= p e)
                (values k (build-path* (list-tail p (length e))))
                (values #f #f))]
-             [else (values #f #f)]))])))))
+          [else (values #f #f)]))])))
 
-(define (path->pkg given-p)
+(define (path->pkg given-p #:cache [cache #f])
-  (define-values (pkg rest) (path->pkg+subpath given-p))
+  (define-values (pkg rest)
+    (path->pkg+subpath given-p #:cache cache))
   pkg)
 
 (define ((remove-package quiet?) pkg-name)
@@ -736,7 +750,9 @@
                             #:given-checksum [given-checksum #f]
                             check-sums?
                             download-printf
-                            metadata-ns)
+                            metadata-ns
+                            #:in-place? [in-place? #f]
+                            #:in-place-clean? [in-place-clean? #f])
   (define-values (inferred-pkg-name type) 
     (if (path? pkg)
         (package-source->name+type (path->string pkg)
@@ -804,19 +820,25 @@
               (λ ()
                  (download-printf "Downloading ~a\n" (url->string new-url))
                  (download-file! new-url tmp.tgz)
+                 (define staged? #f)
                  (dynamic-wind
                      void
                      (λ ()
                         (untar tmp.tgz tmp-dir #:strip-components 1)
+                        (begin0
                          (stage-package/info (path->string package-path)
                                              'dir
                                              pkg-name
                                              #:given-checksum checksum
                                              check-sums?
                                              download-printf
-                                            metadata-ns))
+                                             metadata-ns
+                                             #:in-place? #t
+                                             #:in-place-clean? #t)
+                         (set! staged? #t)))
                      (λ ()
-                        (delete-directory/files tmp-dir))))
+                        (unless staged?
+                          (delete-directory/files tmp-dir)))))
               (λ ()
                  (delete-directory/files tmp.tgz)))]
          [_
@@ -937,6 +959,7 @@
     (define pkg-dir
       (make-temporary-file (string-append "~a-" pkg-name)
                            'directory))
+    (define staged? #t)
     (dynamic-wind
         void
         (λ ()
@@ -961,6 +984,7 @@
              [x
               (pkg-error "invalid package format\n  given: ~a" x)])
 
+           (begin0
             (update-install-info-checksum
              (update-install-info-orig-pkg
               (stage-package/info pkg-dir
@@ -969,11 +993,15 @@
                                   #:given-checksum checksum
                                   check-sums?
                                   download-printf
-                                 metadata-ns)
+                                  metadata-ns
+                                  #:in-place? #t
+                                  #:in-place-clean? #t)
               `(file ,(simple-form-path* pkg)))
-            checksum))
+             checksum)
+            (set! staged? #t)))
         (λ ()
-           (delete-directory/files pkg-dir)))]
+           (unless staged?
+             (delete-directory/files pkg-dir))))]
    [(or (eq? type 'dir)
         (eq? type 'link))
     (unless (directory-exists? pkg)
@@ -988,14 +1016,18 @@
                       (directory->module-paths pkg pkg-name metadata-ns))]
        [else
         (define pkg-dir
-          (make-temporary-file "pkg~a" 'directory))
+          (if in-place?
+              pkg
+              (let ([pkg-dir (make-temporary-file "pkg~a" 'directory)])
                 (delete-directory pkg-dir)
                 (make-parent-directory* pkg-dir)
                 (copy-directory/files pkg pkg-dir #:keep-modify-seconds? #t)
+                pkg-dir)))
         (install-info pkg-name
                       `(dir ,(simple-form-path* pkg))
                       pkg-dir
-                      #t #f
+                      (or (not in-place?) in-place-clean?) 
+                      #f
                       (directory->module-paths pkg-dir pkg-name metadata-ns))]))]
    [(eq? type 'name)
     (define catalog-info (package-catalog-lookup pkg #f))
@@ -1021,18 +1053,22 @@
     (pkg-error "cannot infer package source type\n  source: ~a" pkg)]))
 
 (define (pkg-stage desc
-                   #:checksum [checksum #f])
+                   #:namespace [metadata-ns (make-metadata-namespace)] 
+                   #:checksum [checksum #f]
+                   #:in-place? [in-place? #f])
   (define i (stage-package/info (pkg-desc-source desc)
                                 (pkg-desc-type desc)
                                 (pkg-desc-name desc)
                                 #:given-checksum checksum 
                                 #t
                                 void
-                                (make-metadata-namespace)))
+                                metadata-ns
+                                #:in-place? in-place?))
   (values (install-info-name i)
           (install-info-directory i)
           (install-info-checksum i)
-          (install-info-clean? i)))
+          (install-info-clean? i)
+          (install-info-module-paths i)))
 
 (define (install-packages
          #:old-infos [old-infos empty]
@@ -1048,6 +1084,7 @@
   (define download-printf (if quiet? void printf))
   (define check-sums? (not ignore-checksums?))
   (define all-db (merge-pkg-dbs))
+  (define path-pkg-cache (make-hash))
   (define (install-package/outer infos desc info)
     (match-define (pkg-desc pkg type orig-name auto?) desc)
     (match-define
@@ -1085,9 +1122,9 @@
                                                                       (path-replace-suffix name #".ss")
                                                                       #".zo"))))))
                  (or (not updating?)
-                     (not (equal? pkg-name (path->pkg f)))))
+                     (not (equal? pkg-name (path->pkg f #:cache path-pkg-cache)))))
             ;; This module is already installed
-            (cons (path->pkg f) mp)]
+            (cons (path->pkg f #:cache path-pkg-cache) mp)]
            [else
             ;; Compare with simultaneous installs
             (for/or ([other-pkg-info (in-list infos)]
@@ -1974,27 +2011,35 @@
           ht
           (hash-set ht k v)))))
 
-(define (extract-dependencies get-info)
+(define (extract-pkg-dependencies get-info
+                                  #:build-deps? [build-deps? #t]
+                                  #:filter? [filter? #f])
   (define v (if get-info
                 (get-info 'deps (lambda () empty))
                 empty))
   ((check-dependencies 'deps) v)
-  (define v2 (if get-info
+  (define v2 (if (and get-info build-deps?)
                  (get-info 'build-deps (lambda () empty))
                  empty))
   ((check-dependencies 'build-deps) v2)
-  (append v v2))
+  (define all-v (append v v2))
+  (if filter?
+      (for/list ([dep (in-list all-v)]
+                 #:when (dependency-this-platform? dep))
+        (if (pair? dep)
+            (car dep)
+            dep))
+      all-v))
 
 (define (get-pkg-content desc 
-                         #:extract-info [extract-info extract-dependencies])
+                         #:namespace [metadata-ns (make-metadata-namespace)]
-  (define-values (pkg-name dir cksum clean?) (pkg-stage desc))
+                         #:extract-info [extract-info extract-pkg-dependencies])
-  (define metadata-ns (make-metadata-namespace))
+  (define-values (pkg-name dir cksum clean? module-paths) 
+    (pkg-stage desc #:in-place? #t #:namespace metadata-ns))
   (define get-info (get-info/full dir #:namespace metadata-ns))
-  (define module-paths
-    (set->list (directory->module-paths dir pkg-name metadata-ns)))
   (begin0
    (values cksum
-           module-paths
+           (set->list module-paths)
            (extract-info get-info))
    (when clean?
      (delete-directory/files dir))))
@@ -2164,11 +2209,15 @@
   [current-pkg-catalogs
    (parameter/c (or/c #f (listof url?)))]
   [pkg-directory
-   (-> string? path-string?)]
+   (-> string? (or/c path-string? #f))]
   [path->pkg
-   (-> path-string? (or/c #f string?))]
+   (->* (path-string?)
+        (#:cache (or/c #f (and/c hash? (not/c immutable?))))
+        (or/c #f string?))]
   [path->pkg+subpath
-   (-> path-string? (values (or/c #f string?) (or/c #f 'same path?)))]
+   (->* (path-string?)
+        (#:cache (or/c #f (and/c hash? (not/c immutable?))))
+        (values (or/c #f string?) (or/c #f 'same path?)))]
   [pkg-desc 
    (-> string? 
        (or/c #f 'file 'dir 'link 'file-url 'dir-url 'github 'name) 
@@ -2235,11 +2284,14 @@
         (#:scope (or/c #f package-scope/c))
         (hash/c string? pkg-info?))]
   [pkg-stage (->* (pkg-desc?)
-                  (#:checksum (or/c #f string?))
+                  (#:namespace namespace?
+                               #:checksum (or/c #f string?)
+                               #:in-place? boolean?)
                   (values string?
                           path?
                           (or/c #f string?)
-                          boolean?))]
+                          boolean?
+                          (listof module-path?)))]
   [pkg-config-catalogs
    (-> (listof string?))]
   [pkg-catalog-update-local
@@ -2263,10 +2315,16 @@
    (->* (pkg-desc?)
         (#:extract-info (-> (or/c #f
                                   ((symbol?) ((-> any)) . ->* . any))
-                            any/c))
+                            any/c)
+                        #:namespace namespace?)
         (values (or/c #f string?)
                 (listof module-path?)
                 any/c))]
+  [extract-pkg-dependencies
+   (->* ((symbol? (-> any/c) . -> . any/c))
+        (#:build-deps? boolean?
+                       #:filter? boolean?)
+        (listof (or/c string? (cons/c string? list?))))]
   [pkg-single-collection
    (->* (path-string?)
         (#:name string?

racket/lib/collects/racket/HISTORY.txt

@@ -10,6 +10,7 @@ Added links-file and links-search-dirs to config, enabling
  as pkgs-dir and pkgs-search-dirs
 Removed -C/--links command-line flag
 setup/infotab: removed string-constants require as an allowed form
+raco setup: added --no-pkg-deps and --fix-pkg-deps
 
 Version 5.3.900.1
 Reorganized collections into packages

racket/lib/collects/setup/option-sig.rkt

@@ -22,6 +22,8 @@
      avoid-main-installation
      make-tidy
      make-doc-index
+     check-dependencies
+     fix-dependencies
      call-install
      call-post-install
      pause-on-errors

racket/lib/collects/setup/option-unit.rkt

@@ -47,6 +47,8 @@
   (define-flag-param avoid-main-installation #f)
   (define-flag-param make-tidy #f)
   (define-flag-param make-doc-index #f)
+  (define-flag-param check-dependencies #t)
+  (define-flag-param fix-dependencies #f)
   (define-flag-param call-install #t)
   (define-flag-param call-post-install #t)
   (define-flag-param pause-on-errors #f)

racket/lib/collects/setup/private/pkg-deps.rkt

@@ -0,0 +1,410 @@
+#lang racket/base
+(require syntax/modread
+         syntax/modcollapse
+         pkg/lib
+         racket/set
+         racket/string
+         racket/list
+         setup/getinfo
+         racket/file)
+
+(provide check-package-dependencies)
+
+(define core-pkg "base")
+
+;; Submodules with these names are dropped in binary
+;; packages, so they only controbute to `build-deps':
+(define build-only-submod-names '(test doc srcdoc))
+
+(define (check-package-dependencies
+         paths
+         coll-paths
+         coll-modes
+         setup-printf setup-fprintf
+         fix? verbose?)
+  ;; Tables
+  (define missing (make-hash))
+  (define pkg-internal-deps (make-hash)) ; dependencies available for a package's own use
+  (define pkg-immediate-deps (make-hash)) ; save immediate dependencies
+  (define pkg-external-deps (make-hash)) ; dependencies made available though `implies'
+  (define pkg-reps (make-hash)) ; for union-find on external deps
+  (define mod-pkg (make-hash))
+  (define path-cache (make-hash))
+  (define metadata-ns (make-base-namespace))
+  
+  ;; ----------------------------------------
+  ;; Find the canonical representative for a set of external dependencies:
+  (define (find-rep! pkg)
+    (define rep-pkg (hash-ref pkg-reps pkg))
+    (if (equal? rep-pkg pkg)
+        pkg
+        (let ([rep-pkg (find-rep! rep-pkg)])
+          (hash-set! pkg-reps pkg rep-pkg)
+          rep-pkg)))
+  
+  ;; ----------------------------------------
+  ;; Equate `a-pkg' and `b-pkg', returning a representative:
+  (define (union-find! a-pkg b-pkg)
+    (define rep-a-pkg (find-rep! a-pkg))
+    (define rep-b-pkg (find-rep! b-pkg))
+    (unless (equal? rep-a-pkg rep-b-pkg)
+      (define a-deps (hash-ref pkg-reps rep-a-pkg))
+      (define b-deps (hash-ref pkg-reps rep-b-pkg))
+      (hash-set! pkg-reps rep-b-pkg (set-union a-deps b-deps))
+      (hash-remove! pkg-external-deps rep-a-pkg)
+      (hash-set! pkg-reps rep-a-pkg rep-b-pkg))
+    rep-b-pkg)
+
+  ;; ----------------------------------------
+  ;; Get a package's info, returning its deps and implies:
+  (define (get-immediate-pkg-info! pkg)
+    (define dir (pkg-directory pkg))
+    (unless dir 
+      (error 'check-dependencies "package not installed: ~s" pkg))
+    ;; Get package information:
+    (define-values (checksum mods deps+build-deps)
+      (get-pkg-content (pkg-desc (if (path? dir) (path->string dir) dir) 'dir pkg #f)
+                       #:namespace metadata-ns
+                       #:extract-info (lambda (i)
+                                        (if i
+                                            (cons
+                                             (extract-pkg-dependencies i 
+                                                                       #:build-deps? #f 
+                                                                       #:filter? #t)
+                                             (extract-pkg-dependencies i 
+                                                                       #:filter? #t))
+                                            (cons '() '())))))
+    (define deps (cdr deps+build-deps))
+    (define runtime-deps (list->set (car deps+build-deps)))
+    (define implies 
+      (list->set (let ([i (get-info/full dir #:namespace metadata-ns)])
+                   (if i
+                       (i 'implies (lambda () null))
+                       null))))
+    ;; check that `implies' is a subset of `deps'
+    (for ([i (in-set implies)])
+      (unless (eq? i 'core)
+        (unless (set-member? runtime-deps i)
+          (setup-fprintf (current-error-port) #f 
+                         (string-append
+                          "implied package is not declared as a dependency:\n"
+                          " in package: ~s\n"
+                          " implied package: ~s\n")
+                         pkg
+                         i))))
+    (for ([mod (in-list mods)])
+      (hash-set! mod-pkg mod pkg))
+    ;; Save immediate dependencies, initialize external dependencies:
+    (hash-set! pkg-reps pkg pkg)
+    (hash-set! pkg-immediate-deps pkg (list
+                                       (set-add runtime-deps
+                                                pkg)
+                                       (set-add (list->set deps) 
+                                                pkg)))
+    (hash-set! pkg-external-deps pkg (set-add (set-intersect
+                                               implies
+                                               (set-add runtime-deps
+                                                        'core))
+                                              pkg))
+    (values deps implies))
+  
+  ;; ----------------------------------------
+  ;; Flatten package dependencies, record mod->pkg mappings,
+  ;; return representative package name (of a recursive set)
+  (define (register-pkg! pkg ancestors)
+    (cond
+     [(hash-ref pkg-reps pkg #f)
+      => (lambda (rep-pkg) rep-pkg)]
+     [else
+      (when verbose?
+        (setup-printf #f " checking dependencies of ~s" pkg))
+      (define-values (deps implies) (get-immediate-pkg-info! pkg))
+      ;; Recur on all dependencies
+      (define new-ancestors (hash-set ancestors pkg #t))
+      (define rep-pkg
+        (for/fold ([rep-pkg pkg]) ([dep (in-list deps)])
+          (define dep-rep-pkg (register-pkg! dep ancestors))
+          (cond
+           [(not (set-member? implies dep))
+            ;; not implied, so doesn't add external dependencies
+            rep-pkg]
+           [(equal? dep-rep-pkg rep-pkg)
+            ;; an "implies" cycle that points back here - done!
+            rep-pkg]
+           [(hash-ref ancestors dep-rep-pkg #f)
+            ;; an "implies" cycle back to an ancestor; union to ancestor
+            (union-find! rep-pkg dep-rep-pkg)]
+           [else
+            ;; assert: external deps of `dep-rep-pkg' will not change anymore
+            (define new-rep-pkg (find-rep! rep-pkg))
+            (hash-set! pkg-external-deps
+                       rep-pkg
+                       (set-union (hash-ref pkg-external-deps dep-rep-pkg)
+                                  (hash-ref pkg-external-deps new-rep-pkg)))
+            new-rep-pkg])))
+      rep-pkg]))
+
+  ;; ----------------------------------------
+  ;; Fill in package internal dependencies, given that immediate-dependency
+  ;; external-dependency information is available for all relevant packages:
+  (define (init-pkg-internals! pkg)
+    (unless (hash-ref pkg-internal-deps pkg #f)
+      ;; register modules and compute externally visible dependencies
+      (register-pkg! pkg (hash))
+      ;; combine flattened external dependencies to determine internal dependencies
+      (define (flatten imm-deps)
+        (for/fold ([deps (set)]) ([dep (in-set imm-deps)])
+          (set-union deps
+                     (hash-ref pkg-external-deps (find-rep! dep)))))
+      (let ([imm-depss (hash-ref pkg-immediate-deps pkg)])
+        (hash-set! pkg-internal-deps
+                   pkg
+                   (map flatten imm-depss)))
+      (when verbose?
+        (define (make-list s)
+          (apply
+           string-append
+           (for/list ([k (in-set s)])
+             (format "\n   ~s" k))))
+        (setup-printf #f 
+                      (string-append
+                       " declared accesses, counting `implies'\n"
+                       "  for package: ~s\n"
+                       "  packages:~a"
+                       "  packages for build:~a")
+                      pkg
+                      (make-list (car (hash-ref pkg-internal-deps pkg)))
+                      (make-list (cadr (hash-ref pkg-internal-deps pkg)))))))
+  
+  ;; ----------------------------------------
+  ;; Check use of `mod' (in `mode') from `pkg' by file `f':
+  (define (check mod mode pkg f)
+    (define src-pkg (or (hash-ref mod-pkg mod #f)
+                        'core))
+    (when src-pkg
+      (define flat-depss (hash-ref pkg-internal-deps pkg))
+      (unless (set-member? (if (eq? mode 'run)
+                               (car flat-depss)
+                               (cadr flat-depss))
+                           src-pkg)
+        (hash-update! missing pkg
+                      (lambda (h)
+                        (hash-update h src-pkg
+                                     (lambda (old-mode)
+                                       (if (eq? mode old-mode)
+                                           mode
+                                           'run))
+                                     mode))
+                      (hash))
+        (when verbose?
+          (setup-fprintf (current-error-port) #f 
+                         (string-append
+                          " found undeclared dependency:\n"
+                          "  mode: ~s\n"
+                          "  for package: ~s\n"
+                          "  on package: ~s\n"
+                          "  dependent source: ~a\n"
+                          "  used module: ~s")
+                         mode
+                         pkg
+                         src-pkg
+                         f
+                         mod)))))
+
+  ;; For each collection, set up package info:
+  (for ([path (in-list paths)])
+    (define pkg (path->pkg path #:cache path-cache))
+    (when pkg
+      (init-pkg-internals! pkg)))
+
+  ;; For each collection, check its dependencies:
+  (for ([path (in-list paths)]
+        [coll-path (in-list coll-paths)]
+        [coll-mode (in-list coll-modes)])
+    (when verbose?
+      (setup-printf #f " checking ~a" path))
+    (define dir (build-path path "compiled"))
+    (when (directory-exists? dir)
+      (define pkg (path->pkg dir #:cache path-cache))
+      (when pkg
+        (for ([f (directory-list dir)])
+          ;; A ".dep" file triggers a check:
+          (when (regexp-match? #rx#"[.]dep$" (path-element->bytes f))
+            (define deps (cddr (call-with-input-file* (build-path dir f) read)))
+            ;; Decide whether the file is inherently 'build or 'run mode:
+            (define mode
+              (if (or (eq? coll-mode 'build)
+                      (regexp-match? #rx#"_scrbl[.]dep$" (path-element->bytes f)))
+                  'build
+                  'run))
+            ;; Treat everything in ".dep" as 'build mode...
+            (for ([dep (in-list deps)])
+              (when (and (pair? dep)
+                         (eq? 'collects (car dep)))
+                (define path-strs (map bytes->string/utf-8 (cdr dep)))
+                (define mod `(lib ,(string-join path-strs "/")))
+                (check mod 'build pkg f)))
+            ;; Look at the actual module for 'run mode (dropping
+            ;; submodules like `test'):
+            (when (eq? mode 'run)
+              ;; This is the slowest part, because we have to read the module ".zo"
+              (define zo-f (path-replace-suffix f #".zo"))
+              (when (file-exists? (build-path dir zo-f))
+                (define base (let ([m (regexp-match #rx#"^(.*)_[a-z]+[.]zo$"
+                                                    (path-element->bytes zo-f))])
+                               (and m (bytes->string/utf-8 (cadr m)))))
+                (define in-mod `(lib ,(string-join 
+                                       (append (map path-element->string coll-path) (list base))
+                                       "/")))
+                (define mod-code (call-with-input-file*
+                                  (build-path dir zo-f)
+                                  (lambda (i)
+                                    (parameterize ([read-accept-compiled #t])
+                                      (read i)))))
+                ;; Recur to cover submodules:
+                (let loop ([mod-code mod-code])
+                  (define name (module-compiled-name mod-code))
+                  (unless (and (list? name)
+                               (memq (last name) build-only-submod-names))
+                    ;; Check the module's imports:
+                    (for* ([imports (in-list (module-compiled-imports mod-code))]
+                           [import (cdr imports)])
+                      (define mod (let ([m (collapse-module-path-index import in-mod)])
+                                    (if (and (pair? m)
+                                             (eq? (car m) 'submod))
+                                        (cadr m)
+                                        m)))
+                      (when (and (pair? mod) (eq? 'lib (car mod)))
+                        (check mod 'run pkg zo-f)))
+                    ;; Recur for submodules:
+                    (for-each loop
+                              (append
+                               (module-compiled-submodules mod-code #t)
+                               (module-compiled-submodules mod-code #f))))))))))))
+
+  ;; Report result summary and (optionally) repair:
+  (for ([pkg (in-list (sort (hash-keys missing) string<?))])
+    (define pkgs (hash-ref missing pkg))
+    (define modes '(run build))
+    (define pkgss (for/list ([mode modes])
+                    (sort
+                     (for/list ([(pkg pkg-mode) (in-hash pkgs)]
+                                #:when (eq? mode pkg-mode))
+                       (if (eq? pkg 'core)
+                           core-pkg
+                           pkg))
+                     string<?)))
+    (apply setup-fprintf (current-error-port) #f 
+           (apply
+            string-append
+            "undeclared dependency detected\n"
+            "  for package: ~s"
+            (for/list ([pkgs (in-list pkgss)]
+                       [mode (in-list modes)]
+                       #:when (pair? pkgs))
+              (format "\n  on package~a~a:~~a"
+                      (if (null? (cdr pkgs)) "" "s")
+                      (case mode
+                        [(run) ""]
+                        [(build) " for build"]))))
+           pkg
+           (for/list ([pkgs (in-list pkgss)]
+                      [mode (in-list modes)]
+                      #:when (pair? pkgs))
+             (apply
+              string-append
+              (for/list ([k (in-list pkgs)])
+                (format "\n   ~s" k)))))
+    (when fix?
+      (define info-path (build-path (pkg-directory pkg) "info.rkt"))
+      (setup-printf #f "repairing ~s..." info-path)
+      (fix-info-deps-definition info-path 'deps (car pkgss))
+      (fix-info-deps-definition info-path 'build-deps (cadr pkgss)))))
+
+(define (fix-info-deps-definition info-path deps-id pkgs)
+  (unless (null? pkgs)
+    (unless (file-exists? info-path)
+      (call-with-output-file* 
+       info-path
+       (lambda (o)
+         (displayln "#lang setup/infotab" o))))
+    (define stx (call-with-input-file* 
+                 info-path
+                 (lambda (i)
+                   (port-count-lines! i)
+                   (with-module-reading-parameterization
+                    (lambda ()
+                      (read-syntax info-path i))))))
+    (define deps-stx
+      (syntax-case stx ()
+        [(mod name lang (#%mb def ...))
+         (for/or ([def (in-list (syntax->list #'(def ...)))])
+           (syntax-case def ()
+             [(dfn id rhs)
+              (eq? 'define (syntax-e #'dfn))
+              (and (eq? deps-id (syntax-e #'id))
+                   def)]
+             [_ #f]))]
+        [_
+         (error 'fix-deps "could not parse ~s" info-path)]))
+    (cond
+     [deps-stx
+      (define (fixup prefix start indent)
+        (unless (and start indent)
+          (error 'fix-deps
+                 "could get relevant source location for `~a' definition in ~s"
+                 deps-id
+                 info-path))
+        (define str (file->string info-path))
+        (define new-str
+          (string-append (substring str 0 start)
+                         (apply
+                          string-append
+                          (for/list ([s (in-list pkgs)])
+                            (format "~a~s\n~a" 
+                                    prefix
+                                    s
+                                    (make-string indent #\space))))
+                         (substring str start)))
+        (call-with-output-file*
+         info-path
+         #:exists 'truncate
+         (lambda (o) (display new-str o))))
+      (define (x+ a b) (and a b (+ a b)))
+      (syntax-case deps-stx ()
+        [(def id (quot parens))
+         (and (eq? 'quote (syntax-e #'quot))
+              (or (null? (syntax-e #'parens))
+                  (pair? (syntax-e #'parens))))
+         (fixup ""
+                (syntax-position #'parens)
+                (add1 (syntax-column #'parens)))]
+        [(def id (lst . elms))
+         (eq? 'list (syntax-e #'lst))
+         (syntax-case deps-stx ()
+           [(_ _ parens)
+            (fixup " "
+                   (x+ (x+ (syntax-position #'lst)
+                           -1)
+                       (syntax-span #'lst))
+                   (x+ (syntax-column #'lst)
+                       (syntax-span #'lst)))])]
+        [_
+         (error 'fix-deps
+                "could parse `~a' definition in ~s"
+                deps-id
+                info-path)])]
+     [else
+      (define prefix (format "(define ~a '(" deps-id))
+      (call-with-output-file*
+       info-path
+       #:exists 'append
+       (lambda (o)
+         (display prefix o)
+         (for ([pkg (in-list pkgs)]
+               [i (in-naturals)])
+           (unless (zero? i)
+             (newline o)
+             (display (make-string (string-length prefix) #\space) o))
+           (write pkg o))
+         (displayln "))" o)))])))

racket/lib/collects/setup/setup-cmdline.rkt

@@ -78,6 +78,11 @@
       (add-flags '((make-planet #f)))]
      [("--avoid-main") "Do not make main-installation files"
       (add-flags '((avoid-main-installation #t)))]
+     [("--no-pkg-deps") "Do not check package dependencies"
+      (add-flags '((check-dependencies #f)))]
+     [("-K" "--fix-pkg-deps") "Auto-repair package-dependency declarations"
+      (add-flags '((check-dependencies #t)
+                   (fix-dependencies #t)))]
      [("--mode") mode "Select a compilation mode"
       (add-flags `((compile-mode ,mode)))]
      [("-v" "--verbose") "See names of compiled files and info printfs"

racket/lib/collects/setup/setup-unit.rkt

@@ -30,7 +30,8 @@
          "private/omitted-paths.rkt"
          "parallel-build.rkt"
          "private/cc-struct.rkt"
-         "link.rkt")
+         "link.rkt"
+         "private/pkg-deps.rkt")
 
 (define-namespace-anchor anchor)
 
@@ -1563,6 +1564,27 @@
                                        (bytes->path-element (bytes-append #"man" (filename-extension n)))
                                        n))))
 
+  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;;       Package-dependency checking         ;;
+  ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (define (do-check-package-dependencies)
+    (setup-printf #f (format "--- checking package dependencies ---"))
+    (check-package-dependencies (map cc-path ccs-to-compile)
+                                (map cc-collection ccs-to-compile)
+                                ;; If "test" or "scribblings" is this collection's name,
+                                ;; then it's build-mode code, otherwise it's test mode:
+                                (let ([tests-path (string->path "tests")]
+                                      [scribblings-path (string->path "scribblings")])
+                                  (for/list ([cc (in-list ccs-to-compile)])
+                                    (if (or (member tests-path (cc-collection cc))
+                                            (member scribblings-path (cc-collection cc)))
+                                        'build
+                                        'run)))
+                                setup-printf setup-fprintf
+                                (fix-dependencies)
+                                (verbose)))
+
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; setup-unit Body                ;;
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1601,4 +1623,7 @@
   (do-install-part 'general)
   (do-install-part 'post)
 
+  (when (check-dependencies)
+    (do-check-package-dependencies))
+
   (done))

racket/src/link-all.rkt

@@ -102,22 +102,7 @@
           (error 'link-all "requested package not available: ~s" pkg-name))
         (define i (get-info/full dir))
         (define deps
-          (for/list ([dep (in-list (append (i 'deps (lambda () null))
+          (extract-pkg-dependencies i #:filter? #t))
-                                           (i 'build-deps (lambda () null))))]
-                     #:when
-                     (let ([platform (and (list? dep)
-                                          (member '#:platform dep))])
-                       (or (not platform)
-                           (let ([p (cadr platform)])
-                             (if (symbol? p)
-                                 (eq? p (system-type))
-                                 (let ([s (path->string (system-library-subpath #f))])
-                                   (if (regexp? p)
-                                       (regexp-match? p s)
-                                       (equal? p s))))))))
-            (if (pair? dep)
-                (car dep)
-                dep)))
         (set-union
          new-pkgs
          (for/set ([dep (in-list deps)]