From 138e16e80ff8905fc8503cc02246786898f9a7c7 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 29 Jun 2015 17:06:39 -0600 Subject: [PATCH] fix clone-linked package update on evolving to a multi-package repo When a package "p" is clone-linked and the repo for "p" changes to be a multi-package repository (e.g., with "p-lib", "p-doc", and "p"), a `raco update` would get confused. Unofrtunately, a plain `raco pkg update p` can't work in that case, because the clone link would still be a pathless repo URL; the repairs make `raco pkg update --lookup --clone ..../p` work as is should. Related: fix inference of package names in the early check for whether a package is installed. --- pkgs/racket-doc/pkg/scribblings/lib.scrbl | 2 +- pkgs/racket-test/tests/pkg/tests-clone.rkt | 60 +++++++++++++++++++++- racket/collects/pkg/main.rkt | 2 +- racket/collects/pkg/private/install.rkt | 53 ++++++++++++------- 4 files changed, 94 insertions(+), 23 deletions(-) diff --git a/pkgs/racket-doc/pkg/scribblings/lib.scrbl b/pkgs/racket-doc/pkg/scribblings/lib.scrbl index e537ab175f..c5f74772e7 100644 --- a/pkgs/racket-doc/pkg/scribblings/lib.scrbl +++ b/pkgs/racket-doc/pkg/scribblings/lib.scrbl @@ -161,7 +161,7 @@ the package is should be treated as installed automatically for a dependency. The optional @racket[path] argument is intended for use when -@racket[type] is @racket['clone], in which case it specifies< a +@racket[type] is @racket['clone], in which case it specifies a directory containing the repository clone (where the repository itself is a directory within @racket[path]). diff --git a/pkgs/racket-test/tests/pkg/tests-clone.rkt b/pkgs/racket-test/tests/pkg/tests-clone.rkt index cfc4fb382c..0d63d22afa 100644 --- a/pkgs/racket-test/tests/pkg/tests-clone.rkt +++ b/pkgs/racket-test/tests/pkg/tests-clone.rkt @@ -44,14 +44,15 @@ (define a-dir (build-path tmp-dir "a")) + (define (commit-changes-cmd [a-dir a-dir]) + (~a "cd " a-dir "; git add .; git commit -m change; git update-server-info")) + ;; ---------------------------------------- ;; Single-package repository (make-directory a-dir) $ (~a "cd " a-dir "; git init") (set-file (build-path a-dir "main.rkt") "#lang racket/base 1") - (define (commit-changes-cmd [a-dir a-dir]) - (~a "cd " a-dir "; git add .; git commit -m change; git update-server-info")) $ (commit-changes-cmd) (with-fake-root @@ -186,6 +187,61 @@ (delete-directory/files (build-path clone-dir "a")) (delete-directory/files a-dir) + ;; ---------------------------------------- + ;; Single-package repository that becomes multi-package + + (define (check-changing try-bogus?) + (shelly-case + "Single-package repository that becomes multi-package" + (make-directory a-dir) + $ (~a "cd " a-dir "; git init") + (set-file (build-path a-dir "main.rkt") "#lang racket/base 1") + $ (commit-changes-cmd) + + (with-fake-root + (shelly-begin + (shelly-case + "--clone installation with path into repository" + $ (~a "raco pkg install --clone " (build-path clone-dir "a") " --name one http://localhost:9998/a/.git") + $ "racket -l one" =stdout> "1\n" + $ (~a "ls " (build-path clone-dir "a"))) + + $ (~a "cd " a-dir "; git rm main.rkt") + (make-directory* (build-path a-dir "one")) + (set-file (build-path a-dir "one" "main.rkt") "#lang racket/base 1") + (set-file (build-path a-dir "one" "info.rkt") "#lang info (define deps '(\"http://localhost:9998/a/.git?path=two\"))") + (make-directory* (build-path a-dir "two")) + (set-file (build-path a-dir "two" "main.rkt") "#lang racket/base 2") + $ (commit-changes-cmd) + + (when try-bogus? + ;; A `raco pkg update one` at this point effectively + ;; breaks the package installation, because the package + ;; source will remain pathless. We only try this sometimes, + ;; so that we check the next step with an without creating + ;; paths "one" and "two" before that step. + (shelly-begin + $ "raco pkg update one" + $ "racket -l one" =exit> 1)) + + $ (~a "raco pkg update --clone " (build-path clone-dir "a") " --auto --multi-clone convert http://localhost:9998/a/.git?path=one") + + $ "racket -l one" =stdout> "1\n" + $ "racket -l two" =stdout> "2\n" + + (set-file (build-path a-dir "two" "main.rkt") "#lang racket/base 2.0") + $ (commit-changes-cmd) + + $ "racket -l two" =stdout> "2\n" + $ "raco pkg update two" + $ "racket -l two" =stdout> "2.0\n")) + + (delete-directory/files (build-path clone-dir "a")) + (delete-directory/files a-dir))) + + (check-changing #f) + (check-changing #t) + ;; ---------------------------------------- ;; Using local changes for metadata diff --git a/racket/collects/pkg/main.rkt b/racket/collects/pkg/main.rkt index bc27f75fd3..5921518356 100644 --- a/racket/collects/pkg/main.rkt +++ b/racket/collects/pkg/main.rkt @@ -128,7 +128,7 @@ " package: ~a\n" " given path: ~a\n") pkg - name) + clone) (list pkg)] [else ((pkg-error cmd) diff --git a/racket/collects/pkg/private/install.rkt b/racket/collects/pkg/private/install.rkt index d188f147ff..c2d129f929 100644 --- a/racket/collects/pkg/private/install.rkt +++ b/racket/collects/pkg/private/install.rkt @@ -83,17 +83,21 @@ pkg-path pkg-name))) ;; Check installed packages: - (for ([f (in-directory simple-pkg-path)]) - (define found-pkg (path->pkg f #:cache path-pkg-cache)) - (when (and found-pkg - (not (equal? found-pkg pkg-name))) - (pkg-error (~a "cannot link a directory that overlaps with existing packages\n" - " existing package: ~a\n" - " overlapping path: ~a\n" - " attempted package: ~a") - found-pkg - f - pkg-name))) + (when (directory-exists? simple-pkg-path) ; might not exist for a clone shifting to a subdir + (for ([f (in-directory simple-pkg-path)]) + (define found-pkg (path->pkg f #:cache path-pkg-cache)) + (when (and found-pkg + (not (equal? found-pkg pkg-name)) + ;; In case a new clone dir would overlap with an old one that is being + ;; relocated (and if simultaneous installs really overlap, it's caught below): + (not (hash-ref simultaneous-installs found-pkg #f))) + (pkg-error (~a "cannot link a directory that overlaps with existing packages\n" + " existing package: ~a\n" + " overlapping path: ~a\n" + " attempted package: ~a") + found-pkg + f + pkg-name)))) ;; Check simultaneous installs: (for ([(other-pkg other-dir) (in-hash simultaneous-installs)]) (unless (equal? other-pkg pkg-name) @@ -993,7 +997,7 @@ (pkg-desc-type pkg-name) #:link-dirs? link-dirs? #:must-infer-name? (not (pkg-desc-name pkg-name)) - #:complain (complain-about-source (pkg-desc-name pkg-name)))) + #:complain (complain-about-source (pkg-desc-name pkg-name)))) (define name (or (pkg-desc-name pkg-name) inferred-name)) ;; Check that the package is installed, and get current checksum: @@ -1296,14 +1300,25 @@ (define (early-check-for-installed in-pkgs db #:wanted? wanted?) (for ([d (in-list in-pkgs)]) - (define name + (define-values (name ignored-type) (if (pkg-desc? d) - (or (pkg-desc-name d) - (package-source->name (pkg-desc-source d) - (if (eq? 'clone (pkg-desc-type d)) - 'name - (pkg-desc-type d)))) - (package-source->name d))) + ;; For install of update: + (cond + [(pkg-desc-name d) + (values (pkg-desc-name d) #f)] + [(and (eq? (pkg-desc-type d) 'clone) + ;; If syntax of the source is a package name, then it's a package name: + (let-values ([(name type) (package-source->name+type (pkg-desc-source d) 'name)]) + name)) + => (lambda (name) + (values name #f))] + [else + (package-source->name+type (pkg-desc-source d) + (pkg-desc-type d) + #:must-infer-name? #t + #:complain (complain-about-source #f))]) + ;; Must be a string package name for update: + (values d #f))) (define info (package-info name wanted? #:db db)) (when (and info (not wanted?)