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

raco pkg install: make conflict checking sensitive to platform specifier

Browse Source
This commit is contained in:
Matthew Flatt 2014-07-05 11:04:31 +01:00
parent 739863099d
commit f5d4093ffa
5 changed files with 69 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8,7 +8,8 @@
(only-in pkg/db current-pkg-catalog-file)
net/url
syntax/modcollapse
setup/getinfo))
setup/getinfo
setup/matching-platform))
@title[#:tag "lib"]{Package Management Functions}
@ -538,15 +539,25 @@ 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)])
[#:namespace namespace namespace? (make-base-namespace)]
[#:system-type sys-type (or/c #f symbol?) (system-type)]
[#:system-library-subpath sys-lib-subpath (or/c #f path?)
(system-library-subpath #f)])
(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.
shared files, and man pages---all as specified by @filepath{info.rkt}
files. 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.
The @racket[sys-type] and @racket[sys-lib-subpath] arguments are used
in the same way as for @racket[matching-platform?] to determine
platform-specific installations as determined by
@racketidfont{install-platform} definitions in @filepath{info.rkt}
files.
@history[#:added "6.0.1.13"]}

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

@ -0,0 +1 @@
one

5
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-add-none/info.rkt Normal file
View File

@ -0,0 +1,5 @@
#lang info
(define install-platform #rx"$.^") ; matches nothing
(define copy-shared-files '("1"))

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

@ -19,40 +19,6 @@
(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"
@ -112,7 +78,7 @@
$ "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"))
(shelly-case
"conflict extra installs"
(for ([c '("test-pkgs/pkg-add-a"
@ -120,8 +86,14 @@
"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))))
$ (~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
@ -131,5 +103,13 @@
"test-pkgs/pkg-add-x"
"test-pkgs/pkg-add-1")])
(shelly-begin
$ (~a "raco pkg install " c) =exit> 1))))
(putenv "PLT_PKG_NOSETUP" "1")))
$ (~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")
(with-fake-root
(shelly-case
"no conflict for non-matching platform"
$ "raco pkg install --strict-doc-conflicts test-pkgs/pkg-add-base test-pkgs/pkg-add-none"))))

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

@ -3222,10 +3222,16 @@
[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)))
#:namespace [metadata-ns (make-metadata-namespace)]
#:system-type [sys-type #f]
#:system-library-subpath [sys-lib-subpath #f])
(set->list (directory->additional-installs dir pkg-name metadata-ns
#:system-type sys-type
#:system-library-subpath sys-lib-subpath)))
(define (directory->additional-installs dir pkg-name metadata-ns)
(define (directory->additional-installs dir pkg-name metadata-ns
#:system-type [sys-type #f]
#:system-library-subpath [sys-lib-subpath #f])
(define single-collect
(pkg-single-collection dir #:name pkg-name #:namespace metadata-ns))
(let loop ([s (set)] [f dir] [top? #t])
@ -3234,14 +3240,14 @@
(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)
(set-union (extract-additional-installs i sys-type sys-lib-subpath)
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-additional-installs i sys-type sys-lib-subpath)
(define (extract-documents i)
(let ([s (i 'scribblings (lambda () null))])
(for/set ([doc (in-list (if (list? s) s null))]
@ -3284,12 +3290,20 @@
(define (extract-man-pages i)
(extract-paths i 'man '(copy-man-pages
move-man-pages)))
(define (this-platform? i)
(define v (i 'install-platform (lambda () #rx"")))
(or (not (platform-spec? v))
(matching-platform? v
#:system-type sys-type
#:system-library-subpath sys-lib-subpath)))
(set-union (extract-documents i)
(extract-launchers i)
(extract-foreign-libs i)
(extract-shared-files i)
(extract-man-pages i)))
(if (this-platform? i)
(set-union
(extract-foreign-libs i)
(extract-shared-files i)
(extract-man-pages i))
(set))))
(define (get-additional-installed kind ai-cache metadata-ns)
(or (unbox ai-cache)
@ -3311,7 +3325,7 @@
(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))
(set-union s (extract-additional-installs i #f #f))
s)))
(set-box! ai-cache s)
s)))
@ -3719,5 +3733,7 @@
(#:namespace namespace?)
(listof module-path?))]
[pkg-directory->additional-installs (->* (path-string? string?)
(#:namespace namespace?)
(#:namespace namespace?
#:system-type (or/c #f symbol?)
#:system-library-subpath (or/c #f path?))
(listof (cons/c symbol? string?)))]))