diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl index 08968f88ea..3bcf6df21f 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl @@ -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.} diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-implied-one/main.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-implied-one/main.rkt new file mode 100644 index 0000000000..7f33c96444 --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-implied-one/main.rkt @@ -0,0 +1,2 @@ +#lang racket/base +'implied-1 diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-implied-two/main.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-implied-two/main.rkt new file mode 100644 index 0000000000..1daa6e9efc --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-implied-two/main.rkt @@ -0,0 +1,2 @@ +#lang racket/base +'implied-2 diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-implies/info.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-implies/info.rkt new file mode 100644 index 0000000000..5db3ab869e --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-implies/info.rkt @@ -0,0 +1,4 @@ +#lang info + +(define deps '("pkg-implied")) +(define implies '("pkg-implied")) diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/test.rkt index 682a61743f..2a9f12e31e 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/test.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test.rkt @@ -35,7 +35,7 @@ "name" "basic" "create" "install" "permissions" "conflicts" "checksums" - "deps" "update" + "deps" "update" "implies" "remove" "promote" "locking" diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-implies.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-implies.rkt new file mode 100644 index 0000000000..5aba83725f --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-implies.rkt @@ -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)))) diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index 90d3f80bd5..3946cf4945 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -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) - (map dependency->name - (let ([l (get-all-deps metadata-ns (pkg-directory* pkg-name #:db db))]) - (if all-platforms? - l - (filter dependency-this-platform? l))))) +(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-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? diff --git a/racket/collects/pkg/main.rkt b/racket/collects/pkg/main.rkt index 0527f4097d..014e422874 100644 --- a/racket/collects/pkg/main.rkt +++ b/racket/collects/pkg/main.rkt @@ -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")]