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

raco pkg: check for conflicting docs, executables, etc.

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2014-07-03 15:22:24 +01:00
parent 82326631a9
commit e23f22a9af
22 changed files with 302 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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"]}

7
pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl
View File

@ -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}.}

1
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/.gitignore vendored
View File

@ -6,3 +6,4 @@ MANIFEST
pkg-test1b*
/src-pkgs/
/built-pkgs/
pkg-add-base/doc

1
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/1 Normal file
View File

@ -0,0 +1 @@
one

3
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/b.scrbl Normal file
View File

@ -0,0 +1,3 @@
#lang scribble/base
@title{A}

8
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/info.rkt Normal file
View File

@ -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"))

1
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-1/y.rkt Normal file
View File

@ -0,0 +1 @@
#lang racket/base

1
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/2 Normal file
View File

@ -0,0 +1 @@
one

3
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/a.scrbl Normal file
View File

@ -0,0 +1,3 @@
#lang scribble/base
@title{A}

8
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/info.rkt Normal file
View File

@ -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"))

1
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-a/y.rkt Normal file
View File

@ -0,0 +1 @@
#lang racket/base

1
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/1 Normal file
View File

@ -0,0 +1 @@
one

3
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/a.scrbl Normal file
View File

@ -0,0 +1,3 @@
#lang scribble/base
@title{A}

8
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/info.rkt Normal file
View File

@ -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"))

1
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-base/x.rkt Normal file
View File

@ -0,0 +1 @@
#lang racket/base

1
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/2 Normal file
View File

@ -0,0 +1 @@
one

3
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/a.scrbl Normal file
View File

@ -0,0 +1,3 @@
#lang scribble/base
@title{A}

8
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/info.rkt Normal file
View File

@ -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"))

1
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-x/x.rkt Normal file
View File

@ -0,0 +1 @@
#lang racket/base

58
pkgs/racket-pkgs/racket-test/tests/pkg/tests-conflicts.rkt
View File

@ -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")))

168
racket/collects/pkg/lib.rkt
View File

@ -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?)))]))

4
racket/collects/pkg/main.rkt
View File

@ -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"]