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

fix clone-linked package update on evolving to a multi-package repo

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2015-06-29 17:06:39 -06:00
parent 6f6a792d06
commit 138e16e80f
4 changed files with 94 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/racket-doc/pkg/scribblings/lib.scrbl
View File

@ -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]).

60
pkgs/racket-test/tests/pkg/tests-clone.rkt
View File

@ -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

2
racket/collects/pkg/main.rkt
View File

@ -128,7 +128,7 @@
" package: ~a\n"
" given path: ~a\n")
pkg
name)
clone)
(list pkg)]
[else
((pkg-error cmd)

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

@ -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?)