From e23f22a9af914b198b28eb977d8674fb4eeda045 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 3 Jul 2014 15:22:24 +0100 Subject: [PATCH] raco pkg: check for conflicting docs, executables, etc. Unfortunately, many existing packages rely on the fact that documentation-name conflicts do not cause trouble when a package is installed in user scope (because the documentation in that case is rendered with the package). So, flag conflicts only for installation scope by default, but add a `--strict-doc-conflicts` flag for strict checking even for user scope. --- .../racket-doc/pkg/scribblings/lib.scrbl | 19 ++ .../racket-doc/pkg/scribblings/pkg.scrbl | 7 + .../tests/pkg/test-pkgs/.gitignore | 1 + .../tests/pkg/test-pkgs/pkg-add-1/1 | 1 + .../tests/pkg/test-pkgs/pkg-add-1/b.scrbl | 3 + .../tests/pkg/test-pkgs/pkg-add-1/info.rkt | 8 + .../tests/pkg/test-pkgs/pkg-add-1/y.rkt | 1 + .../tests/pkg/test-pkgs/pkg-add-a/2 | 1 + .../tests/pkg/test-pkgs/pkg-add-a/a.scrbl | 3 + .../tests/pkg/test-pkgs/pkg-add-a/info.rkt | 8 + .../tests/pkg/test-pkgs/pkg-add-a/y.rkt | 1 + .../tests/pkg/test-pkgs/pkg-add-base/1 | 1 + .../tests/pkg/test-pkgs/pkg-add-base/a.scrbl | 3 + .../tests/pkg/test-pkgs/pkg-add-base/info.rkt | 8 + .../tests/pkg/test-pkgs/pkg-add-base/x.rkt | 1 + .../tests/pkg/test-pkgs/pkg-add-x/2 | 1 + .../tests/pkg/test-pkgs/pkg-add-x/a.scrbl | 3 + .../tests/pkg/test-pkgs/pkg-add-x/info.rkt | 8 + .../tests/pkg/test-pkgs/pkg-add-x/x.rkt | 1 + .../racket-test/tests/pkg/tests-conflicts.rkt | 58 +++++- racket/collects/pkg/lib.rkt | 168 +++++++++++++++++- racket/collects/pkg/main.rkt | 4 + 22 files changed, 302 insertions(+), 7 deletions(-) create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/1 create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/b.scrbl create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/info.rkt create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/y.rkt create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/2 create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/a.scrbl create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/info.rkt create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/y.rkt create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/1 create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/a.scrbl create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/info.rkt create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/x.rkt create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/2 create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/a.scrbl create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/info.rkt create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/x.rkt diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl index 7ebd91832b..2349ca2ae3 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl @@ -210,6 +210,7 @@ is true, error messages may suggest specific command-line flags for [#:update-deps? update-deps? boolean? #f] [#:force? force? boolean? #f] [#:ignore-checksums? ignore-checksums? boolean? #f] + [#:strict-doc-conflicts? strict-doc-conflicts? boolean? #f] [#:use-cache? use-cache? boolean? #t] [#:quiet? boolean? quiet? #f] [#:from-command-line? from-command-line? boolean? #f] @@ -249,6 +250,7 @@ The package lock must be held; see @racket[with-pkg-lock].} [#:update-deps? update-deps? boolean? #f] [#:force? force? boolean? #f] [#:ignore-checksums? ignore-checksums? boolean? #f] + [#:strict-doc-conflicts? strict-doc-conflicts? boolean? #f] [#:use-cache? use-cache? quiet? #t] [#:quiet? boolean? quiet? #f] [#:from-command-line? from-command-line? boolean? #f] @@ -312,6 +314,7 @@ The package lock must be held to allow reads; see [#:force? force? boolean? #f] [#:use-cache? use-cache? boolean? #t] [#:ignore-checksums? ignore-checksums? boolean? #f] + [#:strict-doc-conflicts? strict-doc-conflicts? boolean? #f] [#:quiet? boolean? quiet? #f] [#:from-command-line? from-command-line? boolean? #f] [#:strip strip (or/c #f 'source 'binary) #f]) @@ -531,3 +534,19 @@ two-element list containing a string and a version (when Returns a list of module paths (normalized in the sense of @racket[collapse-module-path]) that are provided by the package represented by @racket[dir] and named @racket[pkg-name].} + + +@defproc[(pkg-directory->additional-installs [dir path-string?] + [pkg-name string] + [#:namespace namespace namespace? (make-base-namespace)]) + (listof (cons/c symbol? string?))]{ + +Returns a list of pairs for items that are installed by the package +represented by @racket[dir] and named @racket[pkg-name]. Installed +items can include documentation, executables, foreign libraries, other +shared files, and man pages. The symbol for each item gives it a +category, such as @racket['doc] or @racket['exe], and the string part +is a normalized name, such as the destination name for a document or a +case-folded executable name without a file suffix. + +@history[#:added "6.0.1.13"]} diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl index 6e11825c38..6809261134 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl @@ -435,6 +435,11 @@ sub-commands. @item{@DFlag{ignore-checksums} --- Ignores errors verifying package @tech{checksums} (unsafe).} + @item{@DFlag{strict-doc-conflicts} --- Refuses to install in user @tech{package scope} when + documentation-directory names would conflict with other packages. ``Conflicting'' + documentation names are normally allowed for installation in user @tech{package scope}, + but strict checking ensures that installation would succeed in other @tech{package scopes}.} + @item{@DFlag{no-cache} --- Disables use of the download cache.} @item{@DFlag{no-setup} --- Does not run @exec{raco setup} after installation. This behavior is also the case if the @@ -489,6 +494,7 @@ the given @nonterm{pkg-source}s. @item{@DFlag{all-platforms} --- Same as for @command-ref{install}.} @item{@DFlag{force} --- Same as for @command-ref{install}.} @item{@DFlag{ignore-checksums} --- Same as for @command-ref{install}.} + @item{@DFlag{strict-doc-conflicts} --- Same as for @command-ref{install}.} @item{@DFlag{no-cache} --- Same as for @command-ref{install}.} @item{@DFlag{no-setup} --- Same as for @command-ref{install}.} @item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.} @@ -572,6 +578,7 @@ the given @nonterm{pkg}s. @item{@DFlag{all-platforms} --- Same as for @command-ref{install}.} @item{@DFlag{force} --- Same as for @command-ref{install}.} @item{@DFlag{ignore-checksums} --- Same as for @command-ref{install}.} + @item{@DFlag{strict-doc-conflicts} --- Same as for @command-ref{install}.} @item{@DFlag{no-cache} --- Same as for @command-ref{install}.} @item{@DFlag{no-setup} --- Same as for @command-ref{install}.} @item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.} diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/.gitignore b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/.gitignore index 5411e23e4a..76d97e86c8 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/.gitignore +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/.gitignore @@ -6,3 +6,4 @@ MANIFEST pkg-test1b* /src-pkgs/ /built-pkgs/ +pkg-add-base/doc diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/1 b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/1 new file mode 100644 index 0000000000..5626abf0f7 --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/1 @@ -0,0 +1 @@ +one diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/b.scrbl b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/b.scrbl new file mode 100644 index 0000000000..14fb57234b --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/b.scrbl @@ -0,0 +1,3 @@ +#lang scribble/base + +@title{A} diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/info.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/info.rkt new file mode 100644 index 0000000000..7f1a869aad --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/info.rkt @@ -0,0 +1,8 @@ +#lang info + +(define scribblings '(("a.scrbl" '() '(other) "b"))) + +(define racket-launcher-names '("y")) +(define racket-launcher-libraries '("y.rkt")) + +(define copy-shared-files '("1")) diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/y.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/y.rkt new file mode 100644 index 0000000000..7bc35af1c4 --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/y.rkt @@ -0,0 +1 @@ +#lang racket/base diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/2 b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/2 new file mode 100644 index 0000000000..5626abf0f7 --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/2 @@ -0,0 +1 @@ +one diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/a.scrbl b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/a.scrbl new file mode 100644 index 0000000000..14fb57234b --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/a.scrbl @@ -0,0 +1,3 @@ +#lang scribble/base + +@title{A} diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/info.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/info.rkt new file mode 100644 index 0000000000..44fb2bd8cd --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/info.rkt @@ -0,0 +1,8 @@ +#lang info + +(define scribblings '(("a.scrbl"))) + +(define racket-launcher-names '("y")) +(define racket-launcher-libraries '("y.rkt")) + +(define copy-shared-files '("2")) diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/y.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/y.rkt new file mode 100644 index 0000000000..7bc35af1c4 --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/y.rkt @@ -0,0 +1 @@ +#lang racket/base diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/1 b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/1 new file mode 100644 index 0000000000..5626abf0f7 --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/1 @@ -0,0 +1 @@ +one diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/a.scrbl b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/a.scrbl new file mode 100644 index 0000000000..14fb57234b --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/a.scrbl @@ -0,0 +1,3 @@ +#lang scribble/base + +@title{A} diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/info.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/info.rkt new file mode 100644 index 0000000000..b09487c76b --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/info.rkt @@ -0,0 +1,8 @@ +#lang info + +(define scribblings '(("a.scrbl"))) + +(define racket-launcher-names '("x")) +(define racket-launcher-libraries '("x.rkt")) + +(define copy-shared-files '("1")) diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/x.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/x.rkt new file mode 100644 index 0000000000..7bc35af1c4 --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/x.rkt @@ -0,0 +1 @@ +#lang racket/base diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/2 b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/2 new file mode 100644 index 0000000000..5626abf0f7 --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/2 @@ -0,0 +1 @@ +one diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/a.scrbl b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/a.scrbl new file mode 100644 index 0000000000..14fb57234b --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/a.scrbl @@ -0,0 +1,3 @@ +#lang scribble/base + +@title{A} diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/info.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/info.rkt new file mode 100644 index 0000000000..b0c17ca84e --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/info.rkt @@ -0,0 +1,8 @@ +#lang info + +(define scribblings '(("b.scrbl"))) + +(define gracket-launcher-names '("x")) +(define gracket-launcher-libraries '("x.rkt")) + +(define move-shared-files '("2")) diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/x.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/x.rkt new file mode 100644 index 0000000000..7bc35af1c4 --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/x.rkt @@ -0,0 +1 @@ +#lang racket/base diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-conflicts.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-conflicts.rkt index 218ce2d7a4..3367cc59a1 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-conflicts.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-conflicts.rkt @@ -2,6 +2,7 @@ (require rackunit racket/system racket/match + racket/format (for-syntax racket/base syntax/parse) racket/file @@ -18,6 +19,40 @@ (shelly-begin (initialize-catalogs) + + + (shelly-case + "conflict extra installs" + (for ([c '("test-pkgs/pkg-add-a" + "test-pkgs/pkg-add-x" + "test-pkgs/pkg-add-1")]) + (with-fake-root + (shelly-begin + $ (~a "raco pkg install --strict-doc-conflicts test-pkgs/pkg-add-base " c) =exit> 1 + $ (~a "raco pkg install --strict-doc-conflicts " c "test-pkgs/pkg-add-base") =exit> 1)))) + (shelly-case + "doc conflict allowed in non-strict mode" + (for ([c '("test-pkgs/pkg-add-a")]) + (with-fake-root + (shelly-begin + $ (~a "raco pkg install test-pkgs/pkg-add-base " c) =exit> 0)))) + (putenv "PLT_PKG_NOSETUP" "") + (with-fake-root + (shelly-case + "conflict extra installs with already installed" + $ (~a "raco pkg install test-pkgs/pkg-add-base") =exit> 0 + (for ([c '("test-pkgs/pkg-add-a" + "test-pkgs/pkg-add-x" + "test-pkgs/pkg-add-1")]) + (shelly-begin + $ (~a "raco pkg install --strict-doc-conflicts " c) =exit> 1))) + (for ([c '("test-pkgs/pkg-add-a")]) + (with-fake-root + (shelly-begin + $ (~a "raco pkg install --no-setup " c) =exit> 0)))) + (putenv "PLT_PKG_NOSETUP" "1") + (exit) + $ "raco pkg create --format plt test-pkgs/pkg-test1/" $ "raco pkg create --format plt test-pkgs/pkg-test1-not-conflict/" (shelly-install "only modules are considered for conflicts" @@ -76,4 +111,25 @@ $ "racket -e '(require pkg-test1/conflict)'" =exit> 43 $ "raco pkg install --force test-pkgs/pkg-test1.zip" =exit> 0 $ "racket -e '(require pkg-test1/conflict)'" =exit> 43 - $ "raco pkg remove pkg-test1-conflict")))) + $ "raco pkg remove pkg-test1-conflict")) + + (shelly-case + "conflict extra installs" + (for ([c '("test-pkgs/pkg-add-a" + "test-pkgs/pkg-add-x" + "test-pkgs/pkg-add-1")]) + (with-fake-root + (shelly-begin + $ (~a "raco pkg install test-pkgs/pkg-add-base " c) =exit> 1 + $ (~a "raco pkg install " c "test-pkgs/pkg-add-base") =exit> 1)))) + (putenv "PLT_PKG_NOSETUP" "") + (with-fake-root + (shelly-case + "conflict extra installs with already installed" + $ (~a "raco pkg install test-pkgs/pkg-add-base") =exit> 0 + (for ([c '("test-pkgs/pkg-add-a" + "test-pkgs/pkg-add-x" + "test-pkgs/pkg-add-1")]) + (shelly-begin + $ (~a "raco pkg install " c) =exit> 1)))) + (putenv "PLT_PKG_NOSETUP" "1"))) diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index 9e8b7ad38c..fc50e84801 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -763,7 +763,7 @@ (or (current-pkg-catalogs) (map string->url (read-pkg-cfg/def 'catalogs)))) -(struct install-info (name orig-pkg directory clean? checksum module-paths)) +(struct install-info (name orig-pkg directory clean? checksum module-paths additional-installs)) (define (update-install-info-orig-pkg if op) (struct-copy install-info if @@ -1359,7 +1359,8 @@ pkg-path #f given-checksum ; if a checksum is provided, just use it - (directory->module-paths pkg pkg-name metadata-ns))] + (directory->module-paths pkg pkg-name metadata-ns) + (directory->additional-installs pkg pkg-name metadata-ns))] [else (define pkg-dir (if in-place? @@ -1384,7 +1385,8 @@ pkg-dir (or (not in-place?) in-place-clean?) given-checksum ; if a checksum is provided, just use it - (directory->module-paths pkg-dir pkg-name metadata-ns))]))] + (directory->module-paths pkg-dir pkg-name metadata-ns) + (directory->additional-installs pkg-dir pkg-name metadata-ns))]))] [(eq? type 'name) (define catalog-info (package-catalog-lookup pkg #f download-printf)) (log-pkg-debug "catalog response: ~s" catalog-info) @@ -1482,6 +1484,8 @@ #:conversation conversation #:strip strip-mode #:link-dirs? link-dirs? + #:local-docs-ok? local-docs-ok? + #:ai-cache ai-cache descs) (define download-printf (if quiet? void printf/flush)) (define check-sums? (not ignore-checksums?)) @@ -1491,7 +1495,7 @@ (define (install-package/outer infos desc info) (match-define (pkg-desc pkg type orig-name given-checksum auto?) desc) (match-define - (install-info pkg-name orig-pkg pkg-dir clean? checksum module-paths) + (install-info pkg-name orig-pkg pkg-dir clean? checksum module-paths additional-installs) info) (define name? (eq? 'catalog (first orig-pkg))) (define this-dep-behavior (or dep-behavior @@ -1608,6 +1612,50 @@ " package: ~a\n" " module path: ~s") pkg (pretty-module-path mp))))] + [(and + (not force?) + (for/or ([ai (in-set additional-installs)]) + ;; Check for source or compiled: + (cond + ;; If `local-docs-ok?`, exempt doc collisions for user-scope install, since + ;; user-scope documentation is rendered within the package: + [(and local-docs-ok? + (eq? (car ai) 'doc) + (eq? (current-pkg-scope) 'user)) + #f] + [(set-member? (get-additional-installed (car ai) ai-cache metadata-ns) ai) + ;; This item is already installed + (cons #f ai)] + [else + ;; Compare with simultaneous installs + (for/or ([other-pkg-info (in-list infos)] + #:unless (eq? other-pkg-info info)) + (and (set-member? (install-info-additional-installs other-pkg-info) ai) + (cons (install-info-name other-pkg-info) + ai)))]))) + => + (λ (conflicting-pkg*ai) + (clean!) + (match-define (cons conflicting-pkg ai) conflicting-pkg*ai) + (if conflicting-pkg + (pkg-error (~a "packages ~aconflict\n" + " package: ~a\n" + " package: ~a\n" + " item category: ~a\n" + " item name: ~s") + (if (equal? conflicting-pkg pkg-name) + "in different scopes " + "") + pkg conflicting-pkg + (car ai) + (cdr ai)) + (pkg-error (~a "package conflicts with existing installed item\n" + " package: ~a\n" + " item category: ~a\n" + " item name: ~s") + pkg + (car ai) + (cdr ai))))] [(and (not (eq? dep-behavior 'force)) (let () @@ -2018,6 +2066,7 @@ #:all-platforms? [all-platforms? #f] #:force? [force #f] #:ignore-checksums? [ignore-checksums? #f] + #:strict-doc-conflicts? [strict-doc-conflicts? #f] #:use-cache? [use-cache? #t] #:skip-installed? [skip-installed? #f] #:pre-succeed [pre-succeed void] @@ -2056,6 +2105,7 @@ #:all-platforms? all-platforms? #:force? force #:ignore-checksums? ignore-checksums? + #:strict-doc-conflicts? strict-doc-conflicts? #:use-cache? use-cache? #:dep-behavior dep-behavior #:update-deps? update-deps? @@ -2089,6 +2139,8 @@ #:conversation conversation #:strip strip-mode #:link-dirs? link-dirs? + #:local-docs-ok? (not strict-doc-conflicts?) + #:ai-cache (box #f) new-descs) (unless (empty? summary-deps) (unless quiet? @@ -2286,6 +2338,7 @@ #:all-platforms? [all-platforms? #f] #:force? [force? #f] #:ignore-checksums? [ignore-checksums? #f] + #:strict-doc-conflicts? [strict-doc-conflicts? #f] #:use-cache? [use-cache? #t] #:update-deps? [update-deps? #f] #:update-implies? [update-implies? #t] @@ -2345,6 +2398,7 @@ #:all-platforms? all-platforms? #:force? force? #:ignore-checksums? ignore-checksums? + #:strict-doc-conflicts? strict-doc-conflicts? #:use-cache? use-cache? #:link-dirs? link-dirs? to-update)])) @@ -2409,6 +2463,7 @@ #:quiet? [quiet? #f] #:from-command-line? [from-command-line? #f] #:ignore-checksums? [ignore-checksums? #f] + #:strict-doc-conflicts? [strict-doc-conflicts? #f] #:use-cache? [use-cache? #t] #:dep-behavior [dep-behavior #f] #:strip [strip-mode #f]) @@ -2450,6 +2505,7 @@ #:all-platforms? all-platforms? #:force? force? #:ignore-checksums? ignore-checksums? + #:strict-doc-conflicts? strict-doc-conflicts? #:use-cache? use-cache? #:skip-installed? #t #:dep-behavior (or dep-behavior 'search-auto) @@ -3171,6 +3227,101 @@ [else s])] [else s])])])))) +(define (pkg-directory->additional-installs dir pkg-name + #:namespace [metadata-ns (make-metadata-namespace)]) + (set->list (directory->additional-installs dir pkg-name metadata-ns))) + +(define (directory->additional-installs dir pkg-name metadata-ns) + (define single-collect + (pkg-single-collection dir #:name pkg-name #:namespace metadata-ns)) + (let loop ([s (set)] [f dir] [top? #t]) + (cond + [(directory-exists? f) + (define i (get-pkg-info f metadata-ns)) + (define new-s + (if (and i (or single-collect (not top?))) + (set-union (extract-additional-installs i) + s) + s)) + (for/fold ([s new-s]) ([f (directory-list f #:build? #t)]) + (loop s f #f))] + [else s]))) + +(define (extract-additional-installs i) + (define (extract-documents i) + (let ([s (i 'scribblings (lambda () null))]) + (for/set ([doc (in-list (if (list? s) s null))] + #:when (and (list? doc) + (pair? doc) + (path-string? (car doc)) + (or ((length doc) . < . 4) + (collection-name-element? (list-ref doc 3))))) + (cons 'doc (string-foldcase + (if ((length doc) . < . 4) + (let-values ([(base name dir?) (split-path (car doc))]) + (path->string (path-replace-suffix name #""))) + (list-ref doc 3))))))) + (define (extract-paths i tag keys) + (define (get k) + (define l (i k (lambda () null))) + (if (and (list? l) (andmap path-string? l)) + l + null)) + (list->set (map (lambda (v) (cons tag + (let-values ([(base name dir?) (split-path v)]) + ;; Normalize case, because some platforms + ;; have case-insensitive filesystems: + (string-foldcase (path->string name))))) + (apply + append + (for/list ([k (in-list keys)]) + (get k)))))) + (define (extract-launchers i) + (extract-paths i 'exe '(racket-launcher-names + mzscheme-launcher-names + gracket-launcher-names + mred-launcher-names))) + (define (extract-foreign-libs i) + (extract-paths i 'lib '(copy-foreign-libs + move-foreign-libs))) + (define (extract-shared-files i) + (extract-paths i 'share '(copy-shared-files + move-shared-files))) + (define (extract-man-pages i) + (extract-paths i 'man '(copy-man-pages + move-man-pages))) + + (set-union (extract-documents i) + (extract-launchers i) + (extract-foreign-libs i) + (extract-shared-files i) + (extract-man-pages i))) + +(define (get-additional-installed kind ai-cache metadata-ns) + (or (unbox ai-cache) + (let () + (define dirs (find-relevant-directories '(scribblings + racket-launcher-names + mzscheme-launcher-names + gracket-launcher-names + mred-launcher-names + copy-foreign-libs + move-foreign-libs + copy-shared-files + move-shared-files + copy-man-pages + move-man-pages) + (if (eq? 'user (current-pkg-scope)) + 'all-available + 'no-user))) + (define s (for/fold ([s (set)]) ([dir (in-list dirs)]) + (define i (get-pkg-info dir metadata-ns)) + (if i + (set-union s (extract-additional-installs i)) + s))) + (set-box! ai-cache s) + s))) + (define (pkg-catalog-update-local #:catalogs [catalogs (pkg-config-catalogs)] #:set-catalogs? [set-catalogs? #t] #:catalog-file [catalog-file (db:current-pkg-catalog-file)] @@ -3437,6 +3588,7 @@ #:all-platforms? boolean? #:force? boolean? #:ignore-checksums? boolean? + #:strict-doc-conflicts? boolean? #:use-cache? boolean? #:strip (or/c #f 'source 'binary) #:link-dirs? boolean?) @@ -3462,6 +3614,7 @@ #:all-platforms? boolean? #:force? boolean? #:ignore-checksums? boolean? + #:strict-doc-conflicts? boolean? #:use-cache? boolean? #:skip-installed? boolean? #:quiet? boolean? @@ -3475,6 +3628,7 @@ #:all-platforms? boolean? #:force? boolean? #:ignore-checksums? boolean? + #:strict-doc-conflicts? boolean? #:use-cache? boolean? #:quiet? boolean? #:from-command-line? boolean? @@ -3569,5 +3723,7 @@ (or/c #f package-scope/c))] [pkg-directory->module-paths (->* (path-string? string?) (#:namespace namespace?) - (listof module-path?))])) - + (listof module-path?))] + [pkg-directory->additional-installs (->* (path-string? string?) + (#:namespace namespace?) + (listof (cons/c symbol? string?)))])) diff --git a/racket/collects/pkg/main.rkt b/racket/collects/pkg/main.rkt index 4ec051b276..f0f62cee06 100644 --- a/racket/collects/pkg/main.rkt +++ b/racket/collects/pkg/main.rkt @@ -188,6 +188,7 @@ #:all-platforms? all-platforms #:force? force #:ignore-checksums? ignore-checksums + #:strict-doc-conflicts? strict-doc-conflicts #:use-cache? (not no-cache) #:skip-installed? skip-installed #:update-deps? update-deps @@ -246,6 +247,7 @@ #:all-platforms? all-platforms #:force? force #:ignore-checksums? ignore-checksums + #:strict-doc-conflicts? strict-doc-conflicts #:use-cache? (not no-cache) #:update-deps? (or update-deps auto) #:update-implies? (not ignore-implies) @@ -348,6 +350,7 @@ #:force? force #:all-platforms? all-platforms #:ignore-checksums? ignore-checksums + #:strict-doc-conflicts? strict-doc-conflicts #:use-cache? (not no-cache) #:strip (or (and source 'source) (and binary 'binary)))))) (setup "migrated" no-setup #f setup-collects jobs)))] @@ -511,6 +514,7 @@ ([#:bool all-platforms () "Follow package dependencies for all platforms"] [#:bool force () "Ignore conflicts"] [#:bool ignore-checksums () "Ignore checksums"] + [#:bool strict-doc-conflicts () "Report doc-name conflicts, even for user scope"] [#:bool no-cache () "Disable download cache"]) #:update-deps-flags ([#:bool update-deps () "For `search-ask' or `search-auto', also update dependencies"]