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

pkg/lib: fix pkg-catalog-update-local version selection

Browse Source 
Also fixes problems with using a relative target path
with `raco pkg catalog-archive`.
This commit is contained in:
Matthew Flatt 2014-05-29 11:15:56 +01:00
parent bf504bbaaf
commit 11aca05fb5
2 changed files with 8 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
racket/collects/pkg/db.rkt
View File

@ -130,8 +130,9 @@
(lambda () (lambda ()
(define file (current-pkg-catalog-file)) (define file (current-pkg-catalog-file))
(define dir (path-only file)) (define dir (path-only file))
(unless (directory-exists? dir) (when dir
(make-directory* dir)) (unless (directory-exists? dir)
(make-directory* dir)))
(set! db (sqlite3-connect #:database file (set! db (sqlite3-connect #:database file
#:mode 'create #:mode 'create
#:busy-retry-limit +inf.0))) #:busy-retry-limit +inf.0)))

8
racket/collects/pkg/lib.rkt
View File

@ -460,7 +460,7 @@
(let-values ([(base name dir?) (split-path path)]) (let-values ([(base name dir?) (split-path path)])
base) base)
path)) path))
(path->string (simplify-path (path->complete-path s dir)))] (path->string (simplify-path (path->complete-path s (path->complete-path dir))))]
[else [else
(url->string (combine-url/relative i s))])) (url->string (combine-url/relative i s))]))
(hash-set ht 'source full-path)] (hash-set ht 'source full-path)]
@ -2579,7 +2579,8 @@
(newline))))] (newline))))]
[else [else
(define pkg (format "~a.~a" pkg-name create:format)) (define pkg (format "~a.~a" pkg-name create:format))
(define actual-dest-dir (or dest-dir (define actual-dest-dir (if dest-dir
(path->complete-path dest-dir)
(let-values ([(base name dir?) (split-path dir)]) (let-values ([(base name dir?) (split-path dir)])
(cond (cond
[(path? base) (path->complete-path base)] [(path? base) (path->complete-path base)]
@ -3147,7 +3148,8 @@
(unless quiet? (unless quiet?
(printf/flush "Updating from ~a\n" catalog)) (printf/flush "Updating from ~a\n" catalog))
(parameterize ([current-pkg-catalogs (list (string->url catalog))]) (parameterize ([current-pkg-catalogs (list (string->url catalog))])
(define details (get-all-pkg-details-from-catalogs)) (define details (for/hash ([(name ht) (get-all-pkg-details-from-catalogs)])
(values name (select-info-version ht))))
;; set packages: ;; set packages:
(db:set-pkgs! catalog (for/list ([(name ht) (in-hash details)]) (db:set-pkgs! catalog (for/list ([(name ht) (in-hash details)])
(db:pkg name (db:pkg name