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

raco pkg update: adjust --update-deps handling, again

Browse Source 
Still trying to get the dependencies-have-changed-for-a-link case
right without breaking other cases.
This commit is contained in:
Matthew Flatt 2014-12-16 13:19:08 -07:00
parent ebd817f278
commit 9b9546c0bf
2 changed files with 131 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
pkgs/racket-test/tests/pkg/tests-update-deps.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base #lang racket/base
(require racket/file (require racket/file
racket/format
"shelly.rkt" "shelly.rkt"
"util.rkt") "util.rkt")
@ -109,4 +110,42 @@
$ "raco pkg update pkg-a" =exit> 1 $ "raco pkg update pkg-a" =exit> 1
$ "racket -e '(require pkg-a)'" =exit> 0 $ "racket -e '(require pkg-a)'" =exit> 0
$ "racket -e '(require pkg-b)'" =exit> 43 $ "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)'")))

180
racket/collects/pkg/private/install.rkt
View File

@ -1000,96 +1000,98 @@
pkg-name) pkg-name)
null)) null))
(define missing-deps (define (check-missing-dependencies k)
(for/list ([dep (in-list deps)] (define missing-deps
#:unless (equal? dep "racket") (for/list ([dep (in-list deps)]
#:unless (package-info dep #:db db #f)) #:unless (equal? dep "racket")
dep)) #: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 (define (skip/update-dependencies kind)
[(pair? missing-deps) (check-missing-dependencies
;; A dependency is missing. Treat the dependent package as (lambda ()
;; needing an update, even if it is installed as a link, so (unless (or all-mode? (not report-skip?))
;; that the user is asked about installing dependencies, etc. (download-printf "Skipping update of ~a: ~a\n"
(log-pkg-debug "Missing dependencies of ~s: ~s" pkg-name missing-deps) kind
(update-loop (pkg-info->desc pkg-name info) #f #t #t)] pkg-name))
[else (update-dependencies))))
(define (update-dependencies) (match orig-pkg
(hash-set! update-cache (box pkg-name) #t) [`(,(or 'link 'static-link) ,orig-pkg-dir)
(if (or deps? implies?) (if must-update?
;; Check dependencies (pkg-error (~a "cannot update linked packages;\n"
(append-map " except with a replacement package source\n"
(lambda (dep) (update-loop dep #f #f #t)) " package name: ~a\n"
deps) " package source: ~a")
null)) pkg-name
(simple-form-path
(define (skip/update-dependencies kind) (path->complete-path orig-pkg-dir (pkg-installed-dir))))
(unless (or all-mode? (not report-skip?)) (skip/update-dependencies "linked package"))]
(download-printf "Skipping update of ~a: ~a\n" [`(dir ,_)
kind (if must-update?
pkg-name)) (pkg-error (~a "cannot update packages installed locally;\n"
(update-dependencies)) " except with a replacement package source;\n"
" package was installed via a local directory\n"
(match orig-pkg " package name: ~a")
[`(,(or 'link 'static-link) ,orig-pkg-dir) pkg-name)
(if must-update? (skip/update-dependencies "package installed locally"))]
(pkg-error (~a "cannot update linked packages;\n" [`(file ,_)
" except with a replacement package source\n" (if must-update?
" package name: ~a\n" (pkg-error (~a "cannot update packages installed locally;\n"
" package source: ~a") " except with a replacement package source;\n"
pkg-name " package was installed via a local file\n"
(simple-form-path " package name: ~a")
(path->complete-path orig-pkg-dir (pkg-installed-dir)))) pkg-name)
(skip/update-dependencies "linked package"))] (skip/update-dependencies "package installed locally"))]
[`(dir ,_) [_
(if must-update? (define-values (orig-pkg-source orig-pkg-type orig-pkg-dir)
(pkg-error (~a "cannot update packages installed locally;\n" (if (eq? 'clone (car orig-pkg))
" except with a replacement package source;\n" (values (caddr orig-pkg)
" package was installed via a local directory\n" 'clone
" package name: ~a") (enclosing-path-for-repo (caddr orig-pkg)
pkg-name) (path->complete-path
(skip/update-dependencies "package installed locally"))] (cadr orig-pkg)
[`(file ,_) (pkg-installed-dir))))
(if must-update? ;; It would be better if the type were preseved
(pkg-error (~a "cannot update packages installed locally;\n" ;; from install time, but we always make the
" except with a replacement package source;\n" ;; URL unambigious:
" package was installed via a local file\n" (values (cadr orig-pkg) #f #f)))
" package name: ~a") (define new-checksum
pkg-name) (hash-ref update-cache pkg-name
(skip/update-dependencies "package installed locally"))] (lambda ()
[_ (remote-package-checksum orig-pkg download-printf pkg-name
(define-values (orig-pkg-source orig-pkg-type orig-pkg-dir) #:catalog-lookup-cache catalog-lookup-cache))))
(if (eq? 'clone (car orig-pkg)) ;; Record downloaded checksum:
(values (caddr orig-pkg) (hash-set! update-cache pkg-name new-checksum)
'clone (or (and new-checksum
(enclosing-path-for-repo (caddr orig-pkg) (not (equal? checksum new-checksum))
(path->complete-path ;; Update it:
(cadr orig-pkg) (begin
(pkg-installed-dir)))) ;; Flush cache of downloaded checksums, in case
;; It would be better if the type were preseved ;; there was a race between our checkig and updates on
;; from install time, but we always make the ;; the catalog server:
;; URL unambigious: (clear-checksums-in-cache! update-cache)
(values (cadr orig-pkg) #f #f))) (list (pkg-desc orig-pkg-source orig-pkg-type pkg-name #f auto?
(define new-checksum orig-pkg-dir))))
(hash-ref update-cache pkg-name ;; Continue with dependencies, maybe
(lambda () (check-missing-dependencies update-dependencies))]))]
(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))])]))]
[else null]))) [else null])))
(define (pkg-update in-pkgs (define (pkg-update in-pkgs