From 9b9546c0bf6f7bfb00ec41a8f1d0f0271e50aa6a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 16 Dec 2014 13:19:08 -0700 Subject: [PATCH] raco pkg update: adjust `--update-deps` handling, again Still trying to get the dependencies-have-changed-for-a-link case right without breaking other cases. --- .../tests/pkg/tests-update-deps.rkt | 41 +++- racket/collects/pkg/private/install.rkt | 180 +++++++++--------- 2 files changed, 131 insertions(+), 90 deletions(-) diff --git a/pkgs/racket-test/tests/pkg/tests-update-deps.rkt b/pkgs/racket-test/tests/pkg/tests-update-deps.rkt index 5e8757de00..8234fc76dd 100644 --- a/pkgs/racket-test/tests/pkg/tests-update-deps.rkt +++ b/pkgs/racket-test/tests/pkg/tests-update-deps.rkt @@ -1,5 +1,6 @@ #lang racket/base (require racket/file + racket/format "shelly.rkt" "util.rkt") @@ -109,4 +110,42 @@ $ "raco pkg update pkg-a" =exit> 1 $ "racket -e '(require pkg-a)'" =exit> 0 $ "racket -e '(require pkg-b)'" =exit> 43 - $ "racket -e '(require pkg-b/contains-dep)'" =exit> 0))) + $ "racket -e '(require pkg-b/contains-dep)'" =exit> 0)) + + (with-fake-root + (shelly-case + "dependency changes for a link" + + $ "raco pkg config --set catalogs http://localhost:9990" + (hash-set! *index-ht-1* "pkg-a" + (hasheq 'checksum + (file->string "test-pkgs/pkg-a-first.plt.CHECKSUM") + 'source + "http://localhost:9997/pkg-a-first.plt")) + + (define b-dir (make-temporary-file "~a-b" 'directory)) + (copy-directory/files "test-pkgs/pkg-b-first" (build-path b-dir "pkg-b")) + $ (~a "raco pkg install " (build-path b-dir "pkg-b")) + + (delete-directory/files (build-path b-dir "pkg-b")) + (copy-directory/files "test-pkgs/pkg-b-second" (build-path b-dir "pkg-b")) + $ "raco pkg update pkg-b" + =exit> 1 + =stderr> #rx"cannot update linked packages" + $ (~a "raco pkg update --deps force " (build-path b-dir "pkg-b")) + $ (~a "raco pkg update --batch --update-deps " (build-path b-dir "pkg-b")) + =exit> 1 + =stderr> #rx"missing dependencies" + + $ (~a "raco pkg update --deps search-auto --update-deps " (build-path b-dir "pkg-b")) + + (delete-directory/files b-dir))) + + (with-fake-root + (shelly-case + "using --update-deps with dependency changes doesn't break update" + + (init-update-deps-test) + + $ "raco pkg update --auto pkg-b" + $ "racket -e '(require pkg-a)'"))) diff --git a/racket/collects/pkg/private/install.rkt b/racket/collects/pkg/private/install.rkt index b6dd66e305..94ce6f7f64 100644 --- a/racket/collects/pkg/private/install.rkt +++ b/racket/collects/pkg/private/install.rkt @@ -1000,96 +1000,98 @@ pkg-name) null)) - (define missing-deps - (for/list ([dep (in-list deps)] - #:unless (equal? dep "racket") - #:unless (package-info dep #:db db #f)) - dep)) + (define (check-missing-dependencies k) + (define missing-deps + (for/list ([dep (in-list deps)] + #:unless (equal? dep "racket") + #:unless (package-info dep #:db db #f)) + dep)) + (cond + [(pair? missing-deps) + ;; A dependency is missing. Treat the dependent package as + ;; needing an update, even if it is installed as a link, so + ;; that the user is asked about installing dependencies, etc. + (log-pkg-debug "Missing dependencies of ~s: ~s" pkg-name missing-deps) + (update-loop (pkg-info->desc pkg-name info) #f #t #t)] + [else (k)])) + + (define (update-dependencies) + (hash-set! update-cache (box pkg-name) #t) + (if (or deps? implies?) + ;; Check dependencies + (append-map + (lambda (dep) (update-loop dep #f #f #t)) + deps) + null)) - (cond - [(pair? missing-deps) - ;; A dependency is missing. Treat the dependent package as - ;; needing an update, even if it is installed as a link, so - ;; that the user is asked about installing dependencies, etc. - (log-pkg-debug "Missing dependencies of ~s: ~s" pkg-name missing-deps) - (update-loop (pkg-info->desc pkg-name info) #f #t #t)] - [else - - (define (update-dependencies) - (hash-set! update-cache (box pkg-name) #t) - (if (or deps? implies?) - ;; Check dependencies - (append-map - (lambda (dep) (update-loop dep #f #f #t)) - deps) - null)) - - (define (skip/update-dependencies kind) - (unless (or all-mode? (not report-skip?)) - (download-printf "Skipping update of ~a: ~a\n" - kind - pkg-name)) - (update-dependencies)) - - (match orig-pkg - [`(,(or 'link 'static-link) ,orig-pkg-dir) - (if must-update? - (pkg-error (~a "cannot update linked packages;\n" - " except with a replacement package source\n" - " package name: ~a\n" - " package source: ~a") - pkg-name - (simple-form-path - (path->complete-path orig-pkg-dir (pkg-installed-dir)))) - (skip/update-dependencies "linked package"))] - [`(dir ,_) - (if must-update? - (pkg-error (~a "cannot update packages installed locally;\n" - " except with a replacement package source;\n" - " package was installed via a local directory\n" - " package name: ~a") - pkg-name) - (skip/update-dependencies "package installed locally"))] - [`(file ,_) - (if must-update? - (pkg-error (~a "cannot update packages installed locally;\n" - " except with a replacement package source;\n" - " package was installed via a local file\n" - " package name: ~a") - pkg-name) - (skip/update-dependencies "package installed locally"))] - [_ - (define-values (orig-pkg-source orig-pkg-type orig-pkg-dir) - (if (eq? 'clone (car orig-pkg)) - (values (caddr orig-pkg) - 'clone - (enclosing-path-for-repo (caddr orig-pkg) - (path->complete-path - (cadr orig-pkg) - (pkg-installed-dir)))) - ;; It would be better if the type were preseved - ;; from install time, but we always make the - ;; URL unambigious: - (values (cadr orig-pkg) #f #f))) - (define new-checksum - (hash-ref update-cache pkg-name - (lambda () - (remote-package-checksum orig-pkg download-printf pkg-name - #:catalog-lookup-cache catalog-lookup-cache)))) - ;; Record downloaded checksum: - (hash-set! update-cache pkg-name new-checksum) - (or (and new-checksum - (not (equal? checksum new-checksum)) - ;; Update it: - (begin - ;; Flush cache of downloaded checksums, in case - ;; there was a race between our checkig and updates on - ;; the catalog server: - (clear-checksums-in-cache! update-cache) - (list (pkg-desc orig-pkg-source orig-pkg-type pkg-name #f auto? - orig-pkg-dir)))) - ;; Continue with dependencies, maybe - (update-dependencies))])]))] + (define (skip/update-dependencies kind) + (check-missing-dependencies + (lambda () + (unless (or all-mode? (not report-skip?)) + (download-printf "Skipping update of ~a: ~a\n" + kind + pkg-name)) + (update-dependencies)))) + + (match orig-pkg + [`(,(or 'link 'static-link) ,orig-pkg-dir) + (if must-update? + (pkg-error (~a "cannot update linked packages;\n" + " except with a replacement package source\n" + " package name: ~a\n" + " package source: ~a") + pkg-name + (simple-form-path + (path->complete-path orig-pkg-dir (pkg-installed-dir)))) + (skip/update-dependencies "linked package"))] + [`(dir ,_) + (if must-update? + (pkg-error (~a "cannot update packages installed locally;\n" + " except with a replacement package source;\n" + " package was installed via a local directory\n" + " package name: ~a") + pkg-name) + (skip/update-dependencies "package installed locally"))] + [`(file ,_) + (if must-update? + (pkg-error (~a "cannot update packages installed locally;\n" + " except with a replacement package source;\n" + " package was installed via a local file\n" + " package name: ~a") + pkg-name) + (skip/update-dependencies "package installed locally"))] + [_ + (define-values (orig-pkg-source orig-pkg-type orig-pkg-dir) + (if (eq? 'clone (car orig-pkg)) + (values (caddr orig-pkg) + 'clone + (enclosing-path-for-repo (caddr orig-pkg) + (path->complete-path + (cadr orig-pkg) + (pkg-installed-dir)))) + ;; It would be better if the type were preseved + ;; from install time, but we always make the + ;; URL unambigious: + (values (cadr orig-pkg) #f #f))) + (define new-checksum + (hash-ref update-cache pkg-name + (lambda () + (remote-package-checksum orig-pkg download-printf pkg-name + #:catalog-lookup-cache catalog-lookup-cache)))) + ;; Record downloaded checksum: + (hash-set! update-cache pkg-name new-checksum) + (or (and new-checksum + (not (equal? checksum new-checksum)) + ;; Update it: + (begin + ;; Flush cache of downloaded checksums, in case + ;; there was a race between our checkig and updates on + ;; the catalog server: + (clear-checksums-in-cache! update-cache) + (list (pkg-desc orig-pkg-source orig-pkg-type pkg-name #f auto? + orig-pkg-dir)))) + ;; Continue with dependencies, maybe + (check-missing-dependencies update-dependencies))]))] [else null]))) (define (pkg-update in-pkgs