From 2c3f13fe26503566221d386dfb4e4f675c48f69a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 7 Dec 2014 06:54:24 -0700 Subject: [PATCH] raco pkg update: make update to non-clone suggest more non-clone conversions In other words, suggestion conversions in the non-clone direction the same as conversions in the clone direction. As a way of disambiguation the right direction, the non-clone direction is only suggested for sharing that is immediately discovered from the command-line arguments (as opposed to sharing that becomes apparent as other packages are updated or installed via dependencies). --- .../racket-doc/pkg/scribblings/lib.scrbl | 5 +- .../racket-doc/pkg/scribblings/pkg.scrbl | 17 +++-- .../racket-test/tests/pkg/tests-clone.rkt | 13 +++- racket/collects/pkg/main.rkt | 2 +- racket/collects/pkg/private/clone-path.rkt | 62 ++++++++++++++----- racket/collects/pkg/private/install.rkt | 40 ++++++------ 6 files changed, 95 insertions(+), 44 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl index 30920ec53e..09c2f78a50 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl @@ -285,6 +285,7 @@ The package lock must be held; see @racket[with-pkg-lock].} [#:from-command-line? from-command-line? boolean? #f] [#:strip strip (or/c #f 'source 'binary 'binary-lib) #f] [#:force-strip? force-string? boolean? #f] + [#:lookup-for-clone? lookup-for-clone? boolean? #f] [#:multi-clone-mode multi-clone-mode (or/c 'fail 'force 'convert 'ask) 'fail] [#:link-dirs? link-dirs? boolean? #f]) (or/c 'skip @@ -301,7 +302,9 @@ indicates a package source that should replace the current installation; as an exception, if a @racket[package-desc] has the type @racket['clone] and a source with the syntax of a package name, it refers to an existing package installation that should be converted to -a Git repository clone. +a Git repository clone---unless @racket[lookup-for-clone?] is true, +in which case the package name is resolved through a catalog to +locate a Git repository clone. If @racket[from-command-line?] is true, error messages may suggest specific command-line flags for @command-ref{update}. diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl index 9970e012f5..6f25ec9d79 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl @@ -548,6 +548,11 @@ sub-commands. The following modes are available: @itemlist[ + @item{@exec{convert} --- Converts non-clone-linked packages (either newly or previously installed) + to clone-linked packages, assuming that the packages that are clone-linked + all use the same clone directory. If clone-linked packages currently use + different clone directories, installation fails.} + @item{@exec{ask} --- In the case when packages can be converted, ask the user whether to convert or allow the different clone-linking modes or clone directories. If converting is not an option, the installation fails. This clone-handling mode is the default @@ -557,11 +562,6 @@ sub-commands. @item{@exec{force} --- Allows packages to have different clone-linking modes or clone directories.} - @item{@exec{convert} --- Converts non-clone-linked packages (either newly or previously installed) - to clone-linked packages, assuming that the packages that are clone-linked - all use the same clone directory. If clone-linked packages currently use - different clone directories, installation fails.} - ]} @@ -638,7 +638,12 @@ argument. @item{@DFlag{ignore-checksums} --- Same as for @command-ref{install}.} @item{@DFlag{strict-doc-conflicts} --- Same as for @command-ref{install}.} @item{@DFlag{no-cache} --- Same as for @command-ref{install}.} - @item{@DFlag{multi-clone} @nonterm{mode} --- Same as for @command-ref{install}.} + + @item{@DFlag{multi-clone} @nonterm{mode} --- Same as for @command-ref{install}, except that when + @DFlag{lookup} is specified and @DFlag{clone} is not specified, then conversion goes from + clone to non-clone linking---but only for sharing differences implied by the immediate + command-line arguments compared against existing package installations.} + @item{@DFlag{no-setup} --- Same as for @command-ref{install}.} @item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.} @item{@DFlag{batch} --- Same as for @command-ref{install}.} diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-clone.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-clone.rkt index 2edcff7859..fae8ad0e99 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-clone.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-clone.rkt @@ -160,12 +160,12 @@ ;; A wacky merge of repsitories will happen here, but the checkout should not ;; get mangled. The package manager should bail out at the point that it would - ;; try to rebase the single "a" clone on different commits. + ;; try to fast-forward the single "a" clone on different commits. $ (~a "raco pkg install --clone " (build-path clone-dir "a") " http://localhost:9998/a/.git?path=one" " http://localhost:9998/another/a/.git?path=two") =exit> 1 - =stderr> #rx"different target commits" + =stdout> #rx"different target commits" ;; Check that the old repo checkout is not mangled: $ (~a "racket " (build-path clone-dir "a" "two" "main.rkt")) =stdout> "2\n"))) @@ -351,6 +351,15 @@ $ "racket -l three" =stdout> (if (eq? mode 'convert) "'three\n" "3\n"))) + + (when (eq? mode 'convert) + (shelly-case + "Converting back to non-clone" + $ "raco pkg update --multi-clone convert --lookup one" + $ "racket -l two" =stdout> "2\n" + (when three? + (shelly-begin + $ "racket -l three" =stdout> "3\n")))) (delete-directory/files (build-path clone-dir "a")) (delete-directory/files a-dir) diff --git a/racket/collects/pkg/main.rkt b/racket/collects/pkg/main.rkt index 65f8c28211..965dedc8a5 100644 --- a/racket/collects/pkg/main.rkt +++ b/racket/collects/pkg/main.rkt @@ -642,7 +642,7 @@ #:install-clone-flags ([(#:sym mode [fail force convert ask] #f) multi-clone () ("Specify treatment of multiple clones of a repository;" - "s: ask (interactive default), fail (other default), force, or convert")]) + "s: convert, ask (interactive default), fail (other default), or force")]) #:update-deps-flags ([#:bool update-deps () "For `search-ask' or `search-auto', also update dependencies"] [#:bool ignore-implies () "When updating, treat `implies' like other dependencies"]) diff --git a/racket/collects/pkg/private/clone-path.rkt b/racket/collects/pkg/private/clone-path.rkt index 77203ea0d3..b9b29a1dde 100644 --- a/racket/collects/pkg/private/clone-path.rkt +++ b/racket/collects/pkg/private/clone-path.rkt @@ -49,7 +49,8 @@ updating? ; update vs. install mode catalog-lookup-cache download-printf - from-command-line?) + from-command-line? + convert-to-non-clone?) ;; A `repo-descs` is (hash repo (hash pkg-name desc) ...) (define (add-repo repo-descs repo name desc) (hash-set repo-descs repo @@ -141,7 +142,15 @@ (~a " non-clone packages:" (format-list non-clones))))))) - (define (convert-to-clones new-clone-behavior) + ;; Determine a direction of conversion; we consider converting from + ;; clones only for `raco pkg update --lookup`: + (define convert-direction + (cond + [(not (= (hash-count clones) 1)) #f] + [convert-to-non-clone? 'non-clone] + [else 'clone])) + + (define (convert-to/from-clones new-clone-behavior) ;; Change `descs` to include each currently non-clone item as a clone (define clone (car (hash-keys clones))) (define ht (hash-ref repo-descs repo)) @@ -151,20 +160,30 @@ [clone-behavior new-clone-behavior] [repo-descs repo-descs] [extra-updates extra-updates]) - ([name (in-list non-clones)]) + ([name (in-list (case convert-direction + [(clone) non-clones] + [(non-clone) (car (hash-values clones))]))]) (define desc (hash-ref ht name)) - (define converted-desc (convert-desc-to-clone desc clone - catalog-lookup-cache - download-printf)) + (define converted-desc + (case convert-direction + [(clone) + (convert-desc-to-clone desc clone + catalog-lookup-cache + download-printf)] + [(non-clone) + (convert-desc-to-lookup desc name)])) (values (cons converted-desc (remove-desc-by-name name descs)) (remove-desc-by-name name done-descs) (remove-info-by-name name done-infos) clone-behavior (hash-set repo-descs repo - (hash-set (hash-ref repo-descs repo) - name - converted-desc)) + (let ([ht (hash-ref repo-descs repo)]) + (case convert-direction + [(clone) + (hash-set ht name converted-desc)] + [(non-clone) + (hash-remove ht name)]))) (if (not (hash-ref (hash-ref new-repo-descs repo) name #f)) ;; Count the conversion as an update, not an install, ;; and make sure it's removed before the re-install: @@ -176,22 +195,27 @@ (download-printf "~a\n" (msg #:would "will")) (continue)] [(or (eq? clone-behavior 'fail) - ((hash-count clones) . > . 1)) - (pkg-error "~a" (msg #:convert (if from-command-line? + (not convert-direction)) + (pkg-error "~a" (msg #:convert (if (and from-command-line? + convert-direction) ";\n use `--multi-clone ask' for automated help" "")))] [(eq? clone-behavior 'convert) - (download-printf "~a\n" (msg #:convert ";\n CONVERTING the non-clone packages to clones")) - (convert-to-clones 'convert)] + (download-printf "~a\n" (msg #:convert (format ";\n CONVERTING the ~aclone packages to ~aclones" + (if (eq? convert-direction 'clone) "non-" "") + (if (eq? convert-direction 'clone) "" "NON-")))) + (convert-to/from-clones 'convert)] [else (displayln (msg)) - (case (ask "Convert the non-clone packages to clones, too?" + (case (ask (format "Convert the ~aclone packages to ~aclones, too?" + (if (eq? convert-direction 'clone) "non-" "") + (if (eq? convert-direction 'clone) "" "NON-")) #:default-yes? #f) [(no) (continue)] [(yes) - (convert-to-clones 'ask)] + (convert-to/from-clones 'ask)] [(always-yes) - (convert-to-clones 'convert)] + (convert-to/from-clones 'convert)] [(cancel) (pkg-error "canceled")])])]))) @@ -377,3 +401,9 @@ (pkg-desc-source d)))] [type 'clone] [extra-path clone])) + +(define (convert-desc-to-lookup d name) + (struct-copy pkg-desc d + [source name] + [type 'name] + [checksum #f])) diff --git a/racket/collects/pkg/private/install.rkt b/racket/collects/pkg/private/install.rkt index dfe800caa4..9698fffcf0 100644 --- a/racket/collects/pkg/private/install.rkt +++ b/racket/collects/pkg/private/install.rkt @@ -633,7 +633,7 @@ all-descs all-infos)) - ;; collapse planned repo actions, and make sure they don't conflict: + ;; collapse planned repo actions: (define repos (for/fold ([ht (hash)]) ([repo+do-it (in-list repo+do-its)]) (define repo (car repo+do-it)) @@ -641,29 +641,28 @@ [repo (define git-dir (car repo)) (define checksum (cadr repo)) - (define prev-checksum (hash-ref ht git-dir #f)) - (when (and prev-checksum - (not (equal? prev-checksum checksum))) - (pkg-error (~a "multiple packages in the same clone have different target commits\n" - " clone: ~a\n" - " commit: ~a\n" - " other commit: ~a") - git-dir - prev-checksum - checksum)) - (hash-set ht git-dir checksum)] + (define prev-checksums (hash-ref ht git-dir null)) + (if (member checksum prev-checksums) + ht + (hash-set ht git-dir (cons checksum prev-checksums)))] [else ht]))) ;; relevant commits have been fecthed to the repos, and now we need - ;; to check them out; If a checkout fails, then we've left the + ;; to check them out; if a checkout fails, then we've left the ;; package installation in no worse shape than if a manual `git ;; pull` failed - (for ([(git-dir checksum) (in-hash repos)]) + (for ([(git-dir checksums) (in-hash repos)]) (parameterize ([current-directory git-dir]) (download-printf "Merging commits at ~a\n" git-dir) - (git #:status (lambda (s) (download-printf "~a\n" s)) - "merge" "--ff-only" checksum))) + (when ((length checksums) . > . 1) + (download-printf (~a "Multiple packages in the of the clone\n" + " " git-dir "\n" + " have different target commits; will try each commit, which will work\n" + " as long as some commit is a fast-forward of all of them\n"))) + (for ([checksum (in-list checksums)]) + (git #:status (lambda (s) (download-printf "~a\n" s)) + "merge" "--ff-only" checksum)))) ;; pre-succeed removes packages that are being updated (pre-succeed) @@ -786,7 +785,8 @@ #:multi-clone-behavior [old-clone-behavior 'fail] #:repo-descs [old-repo-descs (initial-repo-descs (read-pkg-db) - (if quiet? void printf))]) + (if quiet? void printf))] + #:convert-to-non-clone? [convert-to-non-clone? #f]) (define download-printf (if quiet? void printf)) (define descs @@ -812,7 +812,8 @@ updating? catalog-lookup-cache download-printf - from-command-line?)) + from-command-line? + convert-to-non-clone?)) (with-handlers* ([vector? (match-lambda [(vector updating? new-infos dep-pkg deps more-pre-succeed conv clone-info) @@ -1158,6 +1159,9 @@ #:use-cache? use-cache? #:link-dirs? link-dirs? #:multi-clone-behavior clone-behavior + #:convert-to-non-clone? (and lookup-for-clone? + (andmap pkg-desc? in-pkgs) + (not (ormap pkg-desc-extra-path in-pkgs))) to-update)])) ;; ----------------------------------------