raco pkg update: implies package dependencies are always updated
.. where "always" means "unless `--ignore-implies` is specified".
This commit is contained in:
Matthew Flatt
parent
298385a4a6
commit
cb943909e4
|
|
@ -363,7 +363,13 @@ sub-commands.
|
|||
@item{@DFlag{update-deps} --- With @exec{search-ask} or @exec{search-auto} dependency behavior, checks
|
||||
already-installed dependencies transitively for updates (even when
|
||||
not forced by version requirements), asking or automatically updating a
|
||||
package when an update is available.}
|
||||
package when an update is available. When a package is updated or installed,
|
||||
unless @DFlag{skip-implies} is specified, any package that
|
||||
it implies (see @secref["metadata"]) is automatically updated independent of the behavior
|
||||
requested via @DFlag{update-deps} and @DFlag{deps}.}
|
||||
|
||||
@item{@DFlag{skip-implies} --- Disables special treatment of dependencies that are listed
|
||||
in @racketidfont{implies} (see @secref["metadata"]) for an installed or updated package.}
|
||||
|
||||
@item{@DFlag{link} --- Implies @exec{--type dir} (and overrides any specified type),
|
||||
and links the existing directory as an installed package, instead of copying the
|
||||
|
|
@ -457,6 +463,7 @@ the given @nonterm{pkg-source}s.
|
|||
@item{@DFlag{auto} --- Shorthand for @exec{@DFlag{deps} search-auto} plus @DFlag{update-deps}.}
|
||||
@item{@DFlag{update-deps} --- Same as for @command-ref{install}, but
|
||||
implied by @DFlag{auto} only for @command-ref{update}.}
|
||||
@item{@DFlag{skip-implies} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{link} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{static-link} --- Same as for @command-ref{install}.}
|
||||
@item{@DFlag{binary} --- Same as for @command-ref{install}.}
|
||||
|
|
@ -778,11 +785,14 @@ The following @filepath{info.rkt} fields are used by the package manager:
|
|||
@item{@racketidfont{implies} --- a list of strings and
|
||||
@racket['core]. Each string refers to a package listed in the
|
||||
@racketidfont{deps} and indicates that a dependency on the
|
||||
current package counts as a dependency on named package; for
|
||||
example, the @pkgname{gui} package is defined to ensure access
|
||||
to all of the libraries provided by @pkgname{gui-lib}, so the
|
||||
@filepath{info.rkt} file of @pkgname{gui} lists
|
||||
@racket["gui-lib"] in @racketidfont{implies}. The special value
|
||||
current package counts as a dependency on the named package;
|
||||
for example, the @pkgname{gui} package is defined to ensure
|
||||
access to all of the libraries provided by @pkgname{gui-lib},
|
||||
so the @filepath{info.rkt} file of @pkgname{gui} lists
|
||||
@racket["gui-lib"] in @racketidfont{implies}. Packages listed
|
||||
in @racketidfont{implies} list are treated specially by
|
||||
updating: implied packages are automatically updated whenever
|
||||
the implying package is updated. The special value
|
||||
@racket['core] is intended for use by an appropriate
|
||||
@pkgname{base} package to declare it as the representative of
|
||||
core Racket libraries.}
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
#lang racket/base
|
||||
'implied-1
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
#lang racket/base
|
||||
'implied-2
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
#lang info
|
||||
|
||||
(define deps '("pkg-implied"))
|
||||
(define implies '("pkg-implied"))
|
||||
|
|
@ -35,7 +35,7 @@
|
|||
"name"
|
||||
"basic" "create" "install" "permissions"
|
||||
"conflicts" "checksums"
|
||||
"deps" "update"
|
||||
"deps" "update" "implies"
|
||||
"remove"
|
||||
"promote"
|
||||
"locking"
|
||||
|
|
|
|||
73
pkgs/racket-pkgs/racket-test/tests/pkg/tests-implies.rkt
Normal file
73
pkgs/racket-pkgs/racket-test/tests/pkg/tests-implies.rkt
Normal file
|
|
@ -0,0 +1,73 @@
|
|||
#lang racket/base
|
||||
(require racket/file
|
||||
"shelly.rkt"
|
||||
"util.rkt")
|
||||
|
||||
(pkg-tests
|
||||
(shelly-begin
|
||||
(initialize-catalogs)
|
||||
|
||||
(shelly-case
|
||||
"create packages"
|
||||
$ "raco pkg create --format zip test-pkgs/pkg-implied-one"
|
||||
$ "raco pkg create --format zip test-pkgs/pkg-implied-two"
|
||||
$ "raco pkg create --format zip test-pkgs/pkg-implies")
|
||||
|
||||
(define (implied-version! s)
|
||||
(hash-set! *index-ht-1* "pkg-implied"
|
||||
(hasheq 'checksum
|
||||
(file->string (format "test-pkgs/pkg-implied-~a.zip.CHECKSUM" s))
|
||||
'source
|
||||
(format "http://localhost:9999/pkg-implied-~a.zip" s))))
|
||||
(implied-version! "one")
|
||||
(hash-set! *index-ht-1* "pkg-implies"
|
||||
(hasheq 'checksum
|
||||
(file->string "test-pkgs/pkg-implies.zip.CHECKSUM")
|
||||
'source
|
||||
"http://localhost:9999/pkg-implies.zip"))
|
||||
|
||||
(with-fake-root
|
||||
(shelly-begin
|
||||
$ "raco pkg config --set catalogs http://localhost:9990")
|
||||
|
||||
(shelly-case
|
||||
"install with auto-dependencies"
|
||||
$ "raco pkg install --auto pkg-implies"
|
||||
$ "racket -l pkg-implied" =stdout> #rx"implied-1")
|
||||
(shelly-case
|
||||
"update checks implied, but does nothing"
|
||||
$ "raco pkg update pkg-implies" =stdout> #rx"pkg-implied.*No updates available")
|
||||
|
||||
(implied-version! "two") ; << UPDATE version
|
||||
(shelly-case
|
||||
"update does not auto-update implies when disabled"
|
||||
$ "raco pkg update --ignore-implies pkg-implies" =stdout> #rx"^(?!pkg-implied).*No updates available"
|
||||
$ "racket -l pkg-implied" =stdout> #rx"implied-1")
|
||||
(shelly-case
|
||||
"update auto-updates implied by default"
|
||||
$ "raco pkg update pkg-implies" =stdout> #rx"pkg-implied"
|
||||
$ "racket -l pkg-implied" =stdout> #rx"implied-2")
|
||||
|
||||
(implied-version! "one") ; << UPDATE version
|
||||
(shelly-case
|
||||
"installign a package updates its implied packages"
|
||||
$ "raco pkg remove pkg-implies"
|
||||
$ "racket -l pkg-implied" =stdout> #rx"implied-2"
|
||||
$ "raco pkg install pkg-implies" =stdout> #rx"pkg-implied"
|
||||
$ "racket -l pkg-implied" =stdout> #rx"implied-1")
|
||||
|
||||
(implied-version! "two") ; << UPDATE version
|
||||
(shelly-case
|
||||
"implied packages can be treated as normal dependencies"
|
||||
$ "raco pkg update --ignore-implies pkg-implies" =stdout> #rx"^(?!pkg-implied).*No updates available"
|
||||
$ "racket -l pkg-implied" =stdout> #rx"implied-1"
|
||||
$ "raco pkg update --ignore-implies --auto pkg-implies"
|
||||
$ "racket -l pkg-implied" =stdout> #rx"implied-2")
|
||||
|
||||
(implied-version! "one") ; << UPDATE version
|
||||
(shelly-case
|
||||
"update works ok with --all"
|
||||
$ "raco pkg update --all"
|
||||
$ "racket -l pkg-implied" =stdout> #rx"implied-1")
|
||||
|
||||
(void))))
|
||||
|
|
@ -275,6 +275,29 @@
|
|||
'build-deps (lambda () empty)
|
||||
#:checker (check-dependencies 'build-deps))))
|
||||
|
||||
(define (get-all-implies metadata-ns pkg-dir deps)
|
||||
(get-metadata metadata-ns pkg-dir
|
||||
'implies (lambda () empty)
|
||||
#:checker (lambda (l)
|
||||
(unless (null? l)
|
||||
(define deps-set (list->set
|
||||
(map dependency->name deps)))
|
||||
(unless (and (list? l)
|
||||
(andmap (lambda (v)
|
||||
(or (string? v)
|
||||
(eq? v 'core)))
|
||||
l))
|
||||
(pkg-error (~a "invalid `implies' specification\n"
|
||||
" specification: ~e")
|
||||
l))
|
||||
(unless (andmap (lambda (i)
|
||||
(or (eq? i 'core)
|
||||
(set-member? deps-set i)))
|
||||
l)
|
||||
(pkg-error (~a "`implies' is not a subset of dependencies\n"
|
||||
" specification: ~e")
|
||||
l))))))
|
||||
|
||||
(define (dependency->name dep)
|
||||
(package-source->name
|
||||
(dependency->source dep)))
|
||||
|
|
@ -1342,6 +1365,7 @@
|
|||
#:pre-succeed pre-succeed
|
||||
#:dep-behavior dep-behavior
|
||||
#:update-deps? update-deps?
|
||||
#:update-implies? update-implies?
|
||||
#:update-cache update-cache
|
||||
#:updating? updating?
|
||||
#:ignore-checksums? ignore-checksums?
|
||||
|
|
@ -1369,6 +1393,9 @@
|
|||
(if name?
|
||||
'search-ask
|
||||
'fail)))
|
||||
(define do-update-deps?
|
||||
(and update-deps?
|
||||
(member this-dep-behavior '(search-auto search-ask))))
|
||||
(define (clean!)
|
||||
(when clean?
|
||||
(delete-directory/files pkg-dir)))
|
||||
|
|
@ -1521,19 +1548,25 @@
|
|||
(clean!)
|
||||
(pkg-error "missing dependencies\n missing packages:~a" (format-list unsatisfied-deps))])]))]
|
||||
[(and
|
||||
update-deps?
|
||||
(member this-dep-behavior '(search-auto search-ask))
|
||||
(or do-update-deps?
|
||||
update-implies?)
|
||||
(let ()
|
||||
(define deps (get-all-deps metadata-ns pkg-dir))
|
||||
(define implies (list->set
|
||||
(get-all-implies metadata-ns pkg-dir deps)))
|
||||
(define update-pkgs
|
||||
(append-map (λ (dep)
|
||||
(define name (dependency->name dep))
|
||||
(define this-platform? (or all-platforms?
|
||||
(dependency-this-platform? dep)))
|
||||
(or (and this-platform?
|
||||
(or do-update-deps?
|
||||
(set-member? implies name))
|
||||
(not (hash-ref simultaneous-installs name #f))
|
||||
((packages-to-update download-printf current-scope-db
|
||||
#:must-update? #f #:deps? #t
|
||||
#:must-update? #f
|
||||
#:deps? do-update-deps?
|
||||
#:implies? update-implies?
|
||||
#:update-cache update-cache
|
||||
#:namespace metadata-ns
|
||||
#:all-platforms? all-platforms?
|
||||
|
|
@ -1549,10 +1582,13 @@
|
|||
(raise (vector #t infos pkg-name update-pkgs
|
||||
(λ () (for-each (compose (remove-package quiet?) pkg-desc-name) update-pkgs))
|
||||
conversation)))
|
||||
(match this-dep-behavior
|
||||
(match (if (andmap (lambda (dep) (set-member? implies (pkg-desc-name dep)))
|
||||
update-pkgs)
|
||||
'search-auto
|
||||
this-dep-behavior)
|
||||
['search-auto
|
||||
(show-dependencies update-pkgs #t #t)
|
||||
(continue 'always-yes)]
|
||||
(continue conversation)]
|
||||
['search-ask
|
||||
(show-dependencies update-pkgs #t #f)
|
||||
(case (if (eq? conversation 'always-yes)
|
||||
|
|
@ -1632,6 +1668,7 @@
|
|||
(define db current-scope-db)
|
||||
(let ([to-update (append-map (packages-to-update download-printf db
|
||||
#:deps? update-deps?
|
||||
#:implies? update-implies?
|
||||
#:update-cache update-cache
|
||||
#:namespace metadata-ns
|
||||
#:all-platforms? all-platforms?
|
||||
|
|
@ -1876,6 +1913,7 @@
|
|||
#:pre-succeed [pre-succeed void]
|
||||
#:dep-behavior [dep-behavior #f]
|
||||
#:update-deps? [update-deps? #f]
|
||||
#:update-implies? [update-implies? #t]
|
||||
#:update-cache [update-cache (make-hash)]
|
||||
#:updating? [updating? #f]
|
||||
#:quiet? [quiet? #f]
|
||||
|
|
@ -1910,6 +1948,7 @@
|
|||
#:use-cache? use-cache?
|
||||
#:dep-behavior dep-behavior
|
||||
#:update-deps? update-deps?
|
||||
#:update-implies? update-implies?
|
||||
#:update-cache update-cache
|
||||
#:pre-succeed (lambda () (pre-succeed) (more-pre-succeed))
|
||||
#:updating? updating?
|
||||
|
|
@ -1930,6 +1969,7 @@
|
|||
#:skip-installed? skip-installed?
|
||||
#:dep-behavior dep-behavior
|
||||
#:update-deps? update-deps?
|
||||
#:update-implies? update-implies?
|
||||
#:update-cache update-cache
|
||||
#:pre-succeed pre-succeed
|
||||
#:updating? updating?
|
||||
|
|
@ -1968,7 +2008,8 @@
|
|||
(define ((packages-to-update download-printf db
|
||||
#:must-installed? [must-installed? #t]
|
||||
#:must-update? [must-update? #t]
|
||||
#:deps? [deps? #f]
|
||||
#:deps? deps?
|
||||
#:implies? implies?
|
||||
#:namespace metadata-ns
|
||||
#:update-cache update-cache
|
||||
#:all-platforms? all-platforms?
|
||||
|
|
@ -2014,16 +2055,18 @@
|
|||
(pkg-desc-checksum pkg-name)
|
||||
(pkg-desc-auto? pkg-name))))
|
||||
;; No update needed, but maybe check dependencies:
|
||||
(if deps?
|
||||
(if (or deps?
|
||||
implies?)
|
||||
((packages-to-update download-printf db
|
||||
#:must-update? #f
|
||||
#:deps? #t
|
||||
#:deps? deps?
|
||||
#:implies? implies?
|
||||
#:update-cache update-cache
|
||||
#:namespace metadata-ns
|
||||
#:all-platforms? all-platforms?
|
||||
#:ignore-checksums? ignore-checksums?
|
||||
#:use-cache? use-cache?)
|
||||
pkg-name)
|
||||
name)
|
||||
null))]
|
||||
[(eq? #t (hash-ref update-cache pkg-name #f))
|
||||
;; package is already being updated
|
||||
|
|
@ -2076,18 +2119,21 @@
|
|||
;; FIXME: the type shouldn't be #f here; it should be
|
||||
;; preseved from install time:
|
||||
(list (pkg-desc orig-pkg-source #f pkg-name #f auto?))))
|
||||
(if deps?
|
||||
(if (or deps? implies?)
|
||||
;; Check dependencies
|
||||
(append-map
|
||||
(packages-to-update download-printf db
|
||||
#:must-update? #f
|
||||
#:deps? #t
|
||||
#:deps? deps?
|
||||
#:implies? implies?
|
||||
#:update-cache update-cache
|
||||
#:namespace metadata-ns
|
||||
#:all-platforms? all-platforms?
|
||||
#:ignore-checksums? ignore-checksums?
|
||||
#:use-cache? use-cache?)
|
||||
((package-dependencies metadata-ns db all-platforms?) pkg-name))
|
||||
((package-dependencies metadata-ns db all-platforms?
|
||||
#:only-implies? (not deps?))
|
||||
pkg-name))
|
||||
null))]))]
|
||||
[else null]))
|
||||
|
||||
|
|
@ -2098,12 +2144,22 @@
|
|||
(for ([k (in-list l)]) (hash-remove! update-cache k)))
|
||||
|
||||
|
||||
(define ((package-dependencies metadata-ns db all-platforms?) pkg-name)
|
||||
(define ((package-dependencies metadata-ns db all-platforms?
|
||||
#:only-implies? [only-implies? #f])
|
||||
pkg-name)
|
||||
(define pkg-dir (pkg-directory* pkg-name #:db db))
|
||||
(define deps
|
||||
(map dependency->name
|
||||
(let ([l (get-all-deps metadata-ns (pkg-directory* pkg-name #:db db))])
|
||||
(let ([l (get-all-deps metadata-ns pkg-dir)])
|
||||
(if all-platforms?
|
||||
l
|
||||
(filter dependency-this-platform? l)))))
|
||||
(if only-implies?
|
||||
(let ([implies (list->set (get-all-implies metadata-ns pkg-dir deps))])
|
||||
(filter (lambda (dep)
|
||||
(set-member? implies dep))
|
||||
deps))
|
||||
deps))
|
||||
|
||||
(define (pkg-update in-pkgs
|
||||
#:all? [all? #f]
|
||||
|
|
@ -2113,6 +2169,7 @@
|
|||
#:ignore-checksums? [ignore-checksums? #f]
|
||||
#:use-cache? [use-cache? #t]
|
||||
#:update-deps? [update-deps? #f]
|
||||
#:update-implies? [update-implies? #t]
|
||||
#:quiet? [quiet? #f]
|
||||
#:strip [strip-mode #f]
|
||||
#:link-dirs? [link-dirs? #f])
|
||||
|
|
@ -2128,6 +2185,7 @@
|
|||
#:must-update? (not all-mode?)
|
||||
#:deps? (or update-deps?
|
||||
all-mode?) ; avoid races
|
||||
#:implies? update-implies?
|
||||
#:update-cache update-cache
|
||||
#:namespace metadata-ns
|
||||
#:all-platforms? all-platforms?
|
||||
|
|
@ -2154,6 +2212,7 @@
|
|||
#:pre-succeed (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update))
|
||||
#:dep-behavior dep-behavior
|
||||
#:update-deps? update-deps?
|
||||
#:update-implies? update-implies?
|
||||
#:update-cache update-cache
|
||||
#:quiet? quiet?
|
||||
#:strip strip-mode
|
||||
|
|
@ -2978,6 +3037,7 @@
|
|||
(#:dep-behavior dep-behavior/c
|
||||
#:all? boolean?
|
||||
#:update-deps? boolean?
|
||||
#:update-implies? boolean?
|
||||
#:quiet? boolean?
|
||||
#:all-platforms? boolean?
|
||||
#:force? boolean?
|
||||
|
|
@ -3002,6 +3062,7 @@
|
|||
(->* ((listof pkg-desc?))
|
||||
(#:dep-behavior dep-behavior/c
|
||||
#:update-deps? boolean?
|
||||
#:update-implies? boolean?
|
||||
#:all-platforms? boolean?
|
||||
#:force? boolean?
|
||||
#:ignore-checksums? boolean?
|
||||
|
|
|
|||
|
|
@ -185,6 +185,7 @@
|
|||
#:use-cache? (not no-cache)
|
||||
#:skip-installed? skip-installed
|
||||
#:update-deps? update-deps
|
||||
#:update-implies? (not ignore-implies)
|
||||
#:strip (or (and source 'source) (and binary 'binary))
|
||||
#:link-dirs? link-dirs?
|
||||
(for/list ([p (in-list sources)])
|
||||
|
|
@ -240,6 +241,7 @@
|
|||
#:ignore-checksums? ignore-checksums
|
||||
#:use-cache? (not no-cache)
|
||||
#:update-deps? (or update-deps auto)
|
||||
#:update-implies? (not ignore-implies)
|
||||
#:strip (or (and source 'source) (and binary 'binary))
|
||||
#:link-dirs? link-dirs?))))
|
||||
(setup no-setup setup-collects jobs)))]
|
||||
|
|
@ -475,7 +477,8 @@
|
|||
[#:bool ignore-checksums () "Ignore checksums"]
|
||||
[#:bool no-cache () "Disable download cache"])
|
||||
#:update-deps-flags
|
||||
([#:bool update-deps () "For `search-ask' or `search-auto', also update dependencies"])
|
||||
([#:bool update-deps () "For `search-ask' or `search-auto', also update dependencies"]
|
||||
[#:bool ignore-implies () "When updating, treat `implies' like other dependencies"])
|
||||
#:install-copy-flags
|
||||
([#:bool link () ("Link a directory package source in place (default for a directory)")]
|
||||
[#:bool static-link () ("Link in place, promising collections do not change")]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user