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

raco pkg update: implies package dependencies are always updated

Browse Source 
.. where "always" means "unless `--ignore-implies` is specified".
This commit is contained in:
Matthew Flatt 2013-11-12 06:53:29 -07:00
parent 298385a4a6
commit cb943909e4
8 changed files with 181 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -363,7 +363,13 @@ sub-commands.
@item{@DFlag{update-deps} --- With @exec{search-ask} or @exec{search-auto} dependency behavior, checks @item{@DFlag{update-deps} --- With @exec{search-ask} or @exec{search-auto} dependency behavior, checks
already-installed dependencies transitively for updates (even when already-installed dependencies transitively for updates (even when
not forced by version requirements), asking or automatically updating a 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), @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 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{auto} --- Shorthand for @exec{@DFlag{deps} search-auto} plus @DFlag{update-deps}.}
@item{@DFlag{update-deps} --- Same as for @command-ref{install}, but @item{@DFlag{update-deps} --- Same as for @command-ref{install}, but
implied by @DFlag{auto} only for @command-ref{update}.} 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{link} --- Same as for @command-ref{install}.}
@item{@DFlag{static-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}.} @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 @item{@racketidfont{implies} --- a list of strings and
@racket['core]. Each string refers to a package listed in the @racket['core]. Each string refers to a package listed in the
@racketidfont{deps} and indicates that a dependency on the @racketidfont{deps} and indicates that a dependency on the
current package counts as a dependency on named package; for current package counts as a dependency on the named package;
example, the @pkgname{gui} package is defined to ensure access for example, the @pkgname{gui} package is defined to ensure
to all of the libraries provided by @pkgname{gui-lib}, so the access to all of the libraries provided by @pkgname{gui-lib},
@filepath{info.rkt} file of @pkgname{gui} lists so the @filepath{info.rkt} file of @pkgname{gui} lists
@racket["gui-lib"] in @racketidfont{implies}. The special value @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 @racket['core] is intended for use by an appropriate
@pkgname{base} package to declare it as the representative of @pkgname{base} package to declare it as the representative of
core Racket libraries.} core Racket libraries.}

2
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-implied-one/main.rkt Normal file
View File

@ -0,0 +1,2 @@
#lang racket/base
'implied-1

2
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-implied-two/main.rkt Normal file
View File

@ -0,0 +1,2 @@
#lang racket/base
'implied-2

4
pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-implies/info.rkt Normal file
View File

@ -0,0 +1,4 @@
#lang info
(define deps '("pkg-implied"))
(define implies '("pkg-implied"))

2
pkgs/racket-pkgs/racket-test/tests/pkg/test.rkt
View File

@ -35,7 +35,7 @@
"name" "name"
"basic" "create" "install" "permissions" "basic" "create" "install" "permissions"
"conflicts" "checksums" "conflicts" "checksums"
"deps" "update" "deps" "update" "implies"
"remove" "remove"
"promote" "promote"
"locking" "locking"

73
pkgs/racket-pkgs/racket-test/tests/pkg/tests-implies.rkt Normal file
View 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))))

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

@ -275,6 +275,29 @@
'build-deps (lambda () empty) 'build-deps (lambda () empty)
#:checker (check-dependencies 'build-deps)))) #: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) (define (dependency->name dep)
(package-source->name (package-source->name
(dependency->source dep))) (dependency->source dep)))
@ -1342,6 +1365,7 @@
#:pre-succeed pre-succeed #:pre-succeed pre-succeed
#:dep-behavior dep-behavior #:dep-behavior dep-behavior
#:update-deps? update-deps? #:update-deps? update-deps?
#:update-implies? update-implies?
#:update-cache update-cache #:update-cache update-cache
#:updating? updating? #:updating? updating?
#:ignore-checksums? ignore-checksums? #:ignore-checksums? ignore-checksums?
@ -1369,6 +1393,9 @@
(if name? (if name?
'search-ask 'search-ask
'fail))) 'fail)))
(define do-update-deps?
(and update-deps?
(member this-dep-behavior '(search-auto search-ask))))
(define (clean!) (define (clean!)
(when clean? (when clean?
(delete-directory/files pkg-dir))) (delete-directory/files pkg-dir)))
@ -1521,19 +1548,25 @@
(clean!) (clean!)
(pkg-error "missing dependencies\n missing packages:~a" (format-list unsatisfied-deps))])]))] (pkg-error "missing dependencies\n missing packages:~a" (format-list unsatisfied-deps))])]))]
[(and [(and
update-deps? (or do-update-deps?
(member this-dep-behavior '(search-auto search-ask)) update-implies?)
(let () (let ()
(define deps (get-all-deps metadata-ns pkg-dir)) (define deps (get-all-deps metadata-ns pkg-dir))
(define implies (list->set
(get-all-implies metadata-ns pkg-dir deps)))
(define update-pkgs (define update-pkgs
(append-map (λ (dep) (append-map (λ (dep)
(define name (dependency->name dep)) (define name (dependency->name dep))
(define this-platform? (or all-platforms? (define this-platform? (or all-platforms?
(dependency-this-platform? dep))) (dependency-this-platform? dep)))
(or (and this-platform? (or (and this-platform?
(or do-update-deps?
(set-member? implies name))
(not (hash-ref simultaneous-installs name #f)) (not (hash-ref simultaneous-installs name #f))
((packages-to-update download-printf current-scope-db ((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 #:update-cache update-cache
#:namespace metadata-ns #:namespace metadata-ns
#:all-platforms? all-platforms? #:all-platforms? all-platforms?
@ -1549,10 +1582,13 @@
(raise (vector #t infos pkg-name update-pkgs (raise (vector #t infos pkg-name update-pkgs
(λ () (for-each (compose (remove-package quiet?) pkg-desc-name) update-pkgs)) (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) update-pkgs))
conversation))) 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 ['search-auto
(show-dependencies update-pkgs #t #t) (show-dependencies update-pkgs #t #t)
(continue 'always-yes)] (continue conversation)]
['search-ask ['search-ask
(show-dependencies update-pkgs #t #f) (show-dependencies update-pkgs #t #f)
(case (if (eq? conversation 'always-yes) (case (if (eq? conversation 'always-yes)
@ -1632,6 +1668,7 @@
(define db current-scope-db) (define db current-scope-db)
(let ([to-update (append-map (packages-to-update download-printf db (let ([to-update (append-map (packages-to-update download-printf db
#:deps? update-deps? #:deps? update-deps?
#:implies? update-implies?
#:update-cache update-cache #:update-cache update-cache
#:namespace metadata-ns #:namespace metadata-ns
#:all-platforms? all-platforms? #:all-platforms? all-platforms?
@ -1876,6 +1913,7 @@
#:pre-succeed [pre-succeed void] #:pre-succeed [pre-succeed void]
#:dep-behavior [dep-behavior #f] #:dep-behavior [dep-behavior #f]
#:update-deps? [update-deps? #f] #:update-deps? [update-deps? #f]
#:update-implies? [update-implies? #t]
#:update-cache [update-cache (make-hash)] #:update-cache [update-cache (make-hash)]
#:updating? [updating? #f] #:updating? [updating? #f]
#:quiet? [quiet? #f] #:quiet? [quiet? #f]
@ -1910,6 +1948,7 @@
#:use-cache? use-cache? #:use-cache? use-cache?
#:dep-behavior dep-behavior #:dep-behavior dep-behavior
#:update-deps? update-deps? #:update-deps? update-deps?
#:update-implies? update-implies?
#:update-cache update-cache #:update-cache update-cache
#:pre-succeed (lambda () (pre-succeed) (more-pre-succeed)) #:pre-succeed (lambda () (pre-succeed) (more-pre-succeed))
#:updating? updating? #:updating? updating?
@ -1930,6 +1969,7 @@
#:skip-installed? skip-installed? #:skip-installed? skip-installed?
#:dep-behavior dep-behavior #:dep-behavior dep-behavior
#:update-deps? update-deps? #:update-deps? update-deps?
#:update-implies? update-implies?
#:update-cache update-cache #:update-cache update-cache
#:pre-succeed pre-succeed #:pre-succeed pre-succeed
#:updating? updating? #:updating? updating?
@ -1968,7 +2008,8 @@
(define ((packages-to-update download-printf db (define ((packages-to-update download-printf db
#:must-installed? [must-installed? #t] #:must-installed? [must-installed? #t]
#:must-update? [must-update? #t] #:must-update? [must-update? #t]
#:deps? [deps? #f] #:deps? deps?
#:implies? implies?
#:namespace metadata-ns #:namespace metadata-ns
#:update-cache update-cache #:update-cache update-cache
#:all-platforms? all-platforms? #:all-platforms? all-platforms?
@ -2014,16 +2055,18 @@
(pkg-desc-checksum pkg-name) (pkg-desc-checksum pkg-name)
(pkg-desc-auto? pkg-name)))) (pkg-desc-auto? pkg-name))))
;; No update needed, but maybe check dependencies: ;; No update needed, but maybe check dependencies:
(if deps? (if (or deps?
implies?)
((packages-to-update download-printf db ((packages-to-update download-printf db
#:must-update? #f #:must-update? #f
#:deps? #t #:deps? deps?
#:implies? implies?
#:update-cache update-cache #:update-cache update-cache
#:namespace metadata-ns #:namespace metadata-ns
#:all-platforms? all-platforms? #:all-platforms? all-platforms?
#:ignore-checksums? ignore-checksums? #:ignore-checksums? ignore-checksums?
#:use-cache? use-cache?) #:use-cache? use-cache?)
pkg-name) name)
null))] null))]
[(eq? #t (hash-ref update-cache pkg-name #f)) [(eq? #t (hash-ref update-cache pkg-name #f))
;; package is already being updated ;; package is already being updated
@ -2076,18 +2119,21 @@
;; FIXME: the type shouldn't be #f here; it should be ;; FIXME: the type shouldn't be #f here; it should be
;; preseved from install time: ;; preseved from install time:
(list (pkg-desc orig-pkg-source #f pkg-name #f auto?)))) (list (pkg-desc orig-pkg-source #f pkg-name #f auto?))))
(if deps? (if (or deps? implies?)
;; Check dependencies ;; Check dependencies
(append-map (append-map
(packages-to-update download-printf db (packages-to-update download-printf db
#:must-update? #f #:must-update? #f
#:deps? #t #:deps? deps?
#:implies? implies?
#:update-cache update-cache #:update-cache update-cache
#:namespace metadata-ns #:namespace metadata-ns
#:all-platforms? all-platforms? #:all-platforms? all-platforms?
#:ignore-checksums? ignore-checksums? #:ignore-checksums? ignore-checksums?
#:use-cache? use-cache?) #: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))]))] null))]))]
[else null])) [else null]))
@ -2098,12 +2144,22 @@
(for ([k (in-list l)]) (hash-remove! update-cache k))) (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?
(map dependency->name #:only-implies? [only-implies? #f])
(let ([l (get-all-deps metadata-ns (pkg-directory* pkg-name #:db db))]) pkg-name)
(if all-platforms? (define pkg-dir (pkg-directory* pkg-name #:db db))
l (define deps
(filter dependency-this-platform? l))))) (map dependency->name
(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 (define (pkg-update in-pkgs
#:all? [all? #f] #:all? [all? #f]
@ -2113,6 +2169,7 @@
#:ignore-checksums? [ignore-checksums? #f] #:ignore-checksums? [ignore-checksums? #f]
#:use-cache? [use-cache? #t] #:use-cache? [use-cache? #t]
#:update-deps? [update-deps? #f] #:update-deps? [update-deps? #f]
#:update-implies? [update-implies? #t]
#:quiet? [quiet? #f] #:quiet? [quiet? #f]
#:strip [strip-mode #f] #:strip [strip-mode #f]
#:link-dirs? [link-dirs? #f]) #:link-dirs? [link-dirs? #f])
@ -2128,6 +2185,7 @@
#:must-update? (not all-mode?) #:must-update? (not all-mode?)
#:deps? (or update-deps? #:deps? (or update-deps?
all-mode?) ; avoid races all-mode?) ; avoid races
#:implies? update-implies?
#:update-cache update-cache #:update-cache update-cache
#:namespace metadata-ns #:namespace metadata-ns
#:all-platforms? all-platforms? #:all-platforms? all-platforms?
@ -2154,6 +2212,7 @@
#:pre-succeed (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update)) #:pre-succeed (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update))
#:dep-behavior dep-behavior #:dep-behavior dep-behavior
#:update-deps? update-deps? #:update-deps? update-deps?
#:update-implies? update-implies?
#:update-cache update-cache #:update-cache update-cache
#:quiet? quiet? #:quiet? quiet?
#:strip strip-mode #:strip strip-mode
@ -2978,6 +3037,7 @@
(#:dep-behavior dep-behavior/c (#:dep-behavior dep-behavior/c
#:all? boolean? #:all? boolean?
#:update-deps? boolean? #:update-deps? boolean?
#:update-implies? boolean?
#:quiet? boolean? #:quiet? boolean?
#:all-platforms? boolean? #:all-platforms? boolean?
#:force? boolean? #:force? boolean?
@ -3002,6 +3062,7 @@
(->* ((listof pkg-desc?)) (->* ((listof pkg-desc?))
(#:dep-behavior dep-behavior/c (#:dep-behavior dep-behavior/c
#:update-deps? boolean? #:update-deps? boolean?
#:update-implies? boolean?
#:all-platforms? boolean? #:all-platforms? boolean?
#:force? boolean? #:force? boolean?
#:ignore-checksums? boolean? #:ignore-checksums? boolean?

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

@ -185,6 +185,7 @@
#:use-cache? (not no-cache) #:use-cache? (not no-cache)
#:skip-installed? skip-installed #:skip-installed? skip-installed
#:update-deps? update-deps #:update-deps? update-deps
#:update-implies? (not ignore-implies)
#:strip (or (and source 'source) (and binary 'binary)) #:strip (or (and source 'source) (and binary 'binary))
#:link-dirs? link-dirs? #:link-dirs? link-dirs?
(for/list ([p (in-list sources)]) (for/list ([p (in-list sources)])
@ -240,6 +241,7 @@
#:ignore-checksums? ignore-checksums #:ignore-checksums? ignore-checksums
#:use-cache? (not no-cache) #:use-cache? (not no-cache)
#:update-deps? (or update-deps auto) #:update-deps? (or update-deps auto)
#:update-implies? (not ignore-implies)
#:strip (or (and source 'source) (and binary 'binary)) #:strip (or (and source 'source) (and binary 'binary))
#:link-dirs? link-dirs?)))) #:link-dirs? link-dirs?))))
(setup no-setup setup-collects jobs)))] (setup no-setup setup-collects jobs)))]
@ -475,7 +477,8 @@
[#:bool ignore-checksums () "Ignore checksums"] [#:bool ignore-checksums () "Ignore checksums"]
[#:bool no-cache () "Disable download cache"]) [#:bool no-cache () "Disable download cache"])
#:update-deps-flags #: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 #:install-copy-flags
([#:bool link () ("Link a directory package source in place (default for a directory)")] ([#: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 static-link () ("Link in place, promising collections do not change")]