raco pkg install: use `--link' by default for directory sources

The new `--copy' flag provides the old behavior.
This commit is contained in:
Matthew Flatt 2013-08-01 06:39:54 -06:00
parent a6f8f00f55
commit 1b98359925
9 changed files with 55 additions and 25 deletions

View File

@ -170,7 +170,8 @@ Unless @racket[quiet?] is true, information about the output is repotred to the
[#:force? force? boolean? #f]
[#:ignore-checksums? ignore-checksums? boolean? #f]
[#:quiet? boolean? quiet? #f]
[#:strip strip (or/c #f 'source 'binary) #f])
[#:strip strip (or/c #f 'source 'binary) #f]
[#:link-dirs? link-dirs? boolean? #f])
(or/c 'skip
#f
(listof (or/c path-string?
@ -181,6 +182,11 @@ collections should be setup via @exec{raco setup}: @racket['skip]
means that no setup is needed, @racket[#f] means all, and a list means
only the indicated collections.
The @racket[link-dirs?] argument determines whether package sources
inferred to be directory paths should be treated as links or copied
(like other package sources). Note that the default is @racket[#f],
unlike the default built into @racket[pkg-install-command].
Status information and debugging details are mostly reported to a logger
named @racket['pkg], but information that is especially relevant to a
user (such as a download action) is reported to the current output

View File

@ -301,7 +301,11 @@ sub-sub-commands:
@item{@DFlag{ignore-checksums} --- Ignores errors verifying package @tech{checksums} (unsafe).}
@item{@DFlag{link} --- Implies @exec{--type dir} (and overrides any specified type),
and links the existing directory as an installed package. The package is identified
and links the existing directory as an installed package, instead of copying the
directory's content to install. Directory @tech{package sources} are treated as links
by default, unless @DFlag{copy} is specified.
The package is identified
as a @tech{single-collection package} or a @tech{multi-collection package} at the
time that it is installed, and that categorization does not change even if the @schemeidfont{collection}
definition in @filepath{info.rkt} is changed (i.e., he package must be removed and re-installed
@ -311,9 +315,12 @@ sub-sub-commands:
of the given directory will not change for each given directory that implements a
@tech{multi-collection package}.}
@item{@DFlag{binary} --- Strips source elements of a package before installing.}
@item{@DFlag{copy} --- Disables default handling of directory @tech{package sources} as links,
and instead treats them like other sources: package content is copied to install.}
@item{@DFlag{source} --- Strips built elements of a package before installing.}
@item{@DFlag{binary} --- Strips source elements of a package before installing, and implies @DFlag{copy}.}
@item{@DFlag{source} --- Strips built elements of a package before installing, and implies @DFlag{copy}.}
@item{@DFlag{skip-installed} --- Ignore any @nonterm{pkg-source}
whose name corresponds to an already-installed package.}

View File

@ -13,10 +13,10 @@
$ "raco pkg install --deps fail test-pkgs/pkg-x/ test-pkgs/pkg-y/" =exit> 1
$ "raco pkg install --deps fail test-pkgs/pkg-y/ test-pkgs/pkg-x/" =exit> 1
$ "raco pkg install --deps fail test-pkgs/pkg-z/" =exit> 0
$ "raco pkg install --deps fail --copy test-pkgs/pkg-z/" =exit> 0
(putenv "PLT_PKG_NOSETUP" "")
$ "raco pkg install test-pkgs/pkg-x/ test-pkgs/pkg-y/"
$ "raco pkg install --copy test-pkgs/pkg-x/ test-pkgs/pkg-y/"
(putenv "PLT_PKG_NOSETUP" "1")
$ "racket -l racket/base -l x -e '(x)'" =stdout> "'x\n"

View File

@ -38,6 +38,10 @@
(check-equal-values? (package-source->name+type "fish" 'dir) (values "fish" 'dir))
(check-equal-values? (package-source->name+type "fish!/" 'dir) (values #f 'dir))
(check-equal-values? (package-source->name+type "fish/" #f #:link-dirs? #t) (values "fish" 'link))
(check-equal-values? (package-source->name+type "fish/" 'dir #:link-dirs? #t) (values "fish" 'dir))
(check-equal-values? (package-source->name+type "fish.plt" #f #:link-dirs? #t) (values "fish" 'file))
(check-equal? (package-source->name "http://") #f)
(check-equal-values? (package-source->name+type "http://racket-lang.org/fish.plt" #f) (values "fish" 'file-url))

View File

@ -32,7 +32,7 @@
(with-fake-root
(shelly-case
"raco install uses raco setup with single collect"
$ "raco pkg install test-pkgs/pkg-test3-v3" =exit> 0))
$ "raco pkg install --copy test-pkgs/pkg-test3-v3" =exit> 0))
(shelly-begin
(initialize-catalogs)
@ -46,7 +46,7 @@
(shelly-install* "remote packages can be updated"
"http://localhost:9999/update-test/pkg-test1.zip"
"pkg-test1 pkg-test3"
$ "raco pkg install test-pkgs/pkg-test3"
$ "raco pkg install --copy test-pkgs/pkg-test3"
$ "racket -l pkg-test3/number" =exit> 1
$ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip"
$ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM"

View File

@ -695,15 +695,18 @@
metadata-ns
#:strip [strip-mode #f]
#:in-place? [in-place? #f]
#:in-place-clean? [in-place-clean? #f])
#:in-place-clean? [in-place-clean? #f]
#:link-dirs? [link-dirs? #f])
(define-values (inferred-pkg-name type)
(if (path? pkg)
(package-source->name+type (path->string pkg)
(or given-type
(if (directory-exists? pkg)
'dir
(if link-dirs?
'link
'dir)
'file)))
(package-source->name+type pkg given-type)))
(package-source->name+type pkg given-type #:link-dirs? link-dirs?)))
(define pkg-name (or given-pkg-name inferred-pkg-name))
(when (and type (not pkg-name))
(pkg-error (~a "could not infer package name from source\n"
@ -1066,6 +1069,7 @@
#:install-conversation [install-conversation #f]
#:update-conversation [update-conversation #f]
#:strip [strip-mode #f]
#:link-dirs? [link-dirs? #f]
descs)
(define download-printf (if quiet? void printf/flush))
(define check-sums? (not ignore-checksums?))
@ -1323,7 +1327,8 @@
(stage-package/info (pkg-desc-source v) (pkg-desc-type v) (pkg-desc-name v)
check-sums? download-printf
metadata-ns
#:strip strip-mode)))
#:strip strip-mode
#:link-dirs? link-dirs?)))
;; For the top-level call, we need to double-check that all provided packages
;; were distinct:
(for/fold ([ht (hash)]) ([i (in-list infos)]
@ -1447,7 +1452,8 @@
#:quiet? [quiet? #f]
#:install-conversation [install-conversation #f]
#:update-conversation [update-conversation #f]
#:strip [strip-mode #f])
#:strip [strip-mode #f]
#:link-dirs? [link-dirs? #f])
(define new-descs
(remove-duplicates
(if (not skip-installed?)
@ -1456,10 +1462,8 @@
(filter (lambda (d)
(define pkg-name
(or (pkg-desc-name d)
(let-values ([(name type)
(package-source->name+type (pkg-desc-source d)
(pkg-desc-type d))])
name)))
(package-source->name (pkg-desc-source d)
(pkg-desc-type d))))
(not (hash-ref db pkg-name #f)))
descs)))
pkg-desc=?))
@ -1492,6 +1496,7 @@
#:install-conversation install-conversation
#:update-conversation update-conversation
#:strip strip-mode
#:link-dirs? link-dirs?
new-descs)))
(define ((update-is-possible? db) pkg-name)
@ -2360,7 +2365,8 @@
#:ignore-checksums? boolean?
#:skip-installed? boolean?
#:quiet? boolean?
#:strip (or/c #f 'source 'binary))
#:strip (or/c #f 'source 'binary)
#:link-dirs? boolean?)
(or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))]
[pkg-migrate
(->* (string?)

View File

@ -74,10 +74,11 @@
[#:bool force () "Ignores conflicts"]
[#:bool ignore-checksums () "Ignores checksums"]
#:once-any
[#:bool link () ("Link a directory package source in place")]
[#:bool link () ("Link a directory package source in place (default for a directory)")]
[#:bool static-link () ("Link in place, promising collections do not change")]
[#:bool source () ("Strip built elements of the package before installing")]
[#:bool binary () ("Strip source elements of the package before installing")]
[#:bool copy () ("Treat directory sources the same as other sources")]
[#:bool source () ("Strip package's built elements before installing; implies --copy")]
[#:bool binary () ("Strip packages' source elements before installing; implies --copy")]
#:once-each
[#:bool skip-installed () ("Skip a <pkg-source> if already installed")]
#:once-any
@ -104,14 +105,17 @@
(with-pkg-lock
(parameterize ([current-pkg-catalogs (and catalog
(list (catalog->url catalog)))])
(define link-dirs? (not (or copy source binary)))
(pkg-install #:dep-behavior deps
#:force? force
#:ignore-checksums? ignore-checksums
#:skip-installed? skip-installed
#:strip (or (and source 'source) (and binary 'binary))
#:link-dirs? link-dirs?
(for/list ([p (in-list pkg-source)])
(define a-type (or (and link 'link)
(and static-link 'static-link)
(and (eq? type 'dir) link-dirs? 'link)
type))
(pkg-desc p a-type name #f))))))
(setup no-setup setup-collects jobs)))]

View File

@ -5,8 +5,9 @@
(provide
(contract-out
[package-source->name+type (-> string? (or/c #f symbol?)
(values (or/c #f string?) (or/c #f symbol?)))]
[package-source->name+type (->* (string? (or/c #f symbol?))
(#:link-dirs? boolean?)
(values (or/c #f string?) (or/c #f symbol?)))]
[package-source->name (-> string? (or/c #f string?))]))
(define rx:package-name #rx"^[-_a-zA-Z0-9]+$")
@ -33,7 +34,7 @@
(and (not (equal? "" (path/param-path (car p))))
(path/param-path (car p))))]))
(define (package-source->name+type s type)
(define (package-source->name+type s type #:link-dirs? [link-dirs? #f])
;; returns (values inferred-name inferred-type);
;; if `type' is given it should be returned, but name can be #f;
;; type should not be #f for a non-#f name
@ -101,7 +102,7 @@
(path-string? s))
(define-values (base name dir?) (split-path s))
(define dir-name (and (path? name) (path->string name)))
(values (validate-name dir-name) (or type (and dir-name 'dir)))]
(values (validate-name dir-name) (or type (and dir-name (if link-dirs? 'link 'dir))))]
[else
(values #f #f)]))

View File

@ -2,6 +2,8 @@ Version 5.90.0.3
Base user directoy paths on an installation name instead
of the Racket version string
Remove "shared" links and package scope
raco pkg install: --link is default for directory source; added
--copy
Version 5.90.0.2
Added #%declare