From 1b983599251c7dc2f282a4bc83bc9617e690fbd5 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 1 Aug 2013 06:39:54 -0600 Subject: [PATCH] raco pkg install: use `--link' by default for directory sources The new `--copy' flag provides the old behavior. --- .../racket-doc/pkg/scribblings/lib.scrbl | 8 +++++- .../racket-doc/pkg/scribblings/pkg.scrbl | 13 +++++++--- .../racket-test/tests/pkg/tests-binary.rkt | 4 +-- .../racket-test/tests/pkg/tests-name.rkt | 4 +++ .../racket-test/tests/pkg/tests-raco.rkt | 4 +-- racket/collects/pkg/lib.rkt | 26 ++++++++++++------- racket/collects/pkg/main.rkt | 10 ++++--- racket/collects/pkg/name.rkt | 9 ++++--- racket/collects/racket/HISTORY.txt | 2 ++ 9 files changed, 55 insertions(+), 25 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl index c2e136db36..6609d0e767 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl @@ -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 diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl index 07f40ad3ea..f97b330b0a 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl @@ -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.} diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-binary.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-binary.rkt index 959665dab1..1f3f03a0a3 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-binary.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-binary.rkt @@ -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" diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt index cd31e31ffe..a958792111 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt @@ -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)) diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-raco.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-raco.rkt index c445af9e1d..e2e5cd14e6 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-raco.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-raco.rkt @@ -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" diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index 22c0215caf..6f65aaacbd 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -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?) diff --git a/racket/collects/pkg/main.rkt b/racket/collects/pkg/main.rkt index 5f2914746b..d0554b0f70 100644 --- a/racket/collects/pkg/main.rkt +++ b/racket/collects/pkg/main.rkt @@ -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 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)))] diff --git a/racket/collects/pkg/name.rkt b/racket/collects/pkg/name.rkt index 30686c9d31..58d4f97227 100644 --- a/racket/collects/pkg/name.rkt +++ b/racket/collects/pkg/name.rkt @@ -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)])) diff --git a/racket/collects/racket/HISTORY.txt b/racket/collects/racket/HISTORY.txt index 2df5022913..70ab57e49c 100644 --- a/racket/collects/racket/HISTORY.txt +++ b/racket/collects/racket/HISTORY.txt @@ -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