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

Normalize path to have a trailing slash

Browse Source 
The regexp-based helper did not work correctly for
a path like the one in the following use:

  raco pkg install -n foo /
This commit is contained in:
Asumu Takikawa 2016-02-19 19:15:20 -05:00
parent 9494216a9b
commit 98ba277948
3 changed files with 42 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
racket/collects/pkg/private/orig-pkg.rkt
View File

@ -19,7 +19,9 @@
[(link static-link) `(,type
,(path->string
(find-relative-path (pkg-installed-dir)
(simple-form-path src)
;; normalize with ending slash
(path->directory-path
(simple-form-path src))
#:more-than-root? #t)))]
[(clone)
(define-values (transport host port repo branch path)

3
racket/collects/pkg/private/path.rkt
View File

@ -15,9 +15,6 @@
[(bytes? pkg)
pkg]))
(define (directory-path-no-slash pkg)
(bytes->path (regexp-replace* #rx#"/$" (path->bytes* pkg) #"")))
(define (directory-list* d)
(append-map
(λ (pp)

79
racket/collects/pkg/private/stage.rkt
View File

@ -609,47 +609,46 @@
(package-source->path pkg type)))
(unless (directory-exists? pkg-path)
(pkg-error "no such directory\n path: ~a" pkg-path))
(let ([pkg-path (directory-path-no-slash pkg-path)])
(cond
[(or (eq? type 'link)
(eq? type 'static-link))
(install-info pkg-name
(desc->orig-pkg type pkg-path #f)
pkg-path
#f ; no git-dir
#f ; no clean?
given-checksum ; if a checksum is provided, just use it
(directory->module-paths pkg-path pkg-name metadata-ns)
(directory->additional-installs pkg-path pkg-name metadata-ns))]
[else
(define pkg-dir
(if in-place?
(cond
[(or (eq? type 'link)
(eq? type 'static-link))
(install-info pkg-name
(desc->orig-pkg type pkg-path #f)
pkg-path
#f ; no git-dir
#f ; no clean?
given-checksum ; if a checksum is provided, just use it
(directory->module-paths pkg-path pkg-name metadata-ns)
(directory->additional-installs pkg-path pkg-name metadata-ns))]
[else
(define pkg-dir
(if in-place?
(if strip-mode
(pkg-error "cannot strip directory in place")
pkg-path)
(let ([pkg-dir (make-temporary-file "pkg~a" 'directory)])
(delete-directory pkg-dir)
(if strip-mode
(pkg-error "cannot strip directory in place")
pkg-path)
(let ([pkg-dir (make-temporary-file "pkg~a" 'directory)])
(delete-directory pkg-dir)
(if strip-mode
(begin
(unless force-strip?
(check-strip-compatible strip-mode pkg-name pkg pkg-error))
(make-directory* pkg-dir)
(generate-stripped-directory strip-mode pkg pkg-dir))
(begin
(make-parent-directory* pkg-dir)
(copy-directory/files pkg-path pkg-dir #:keep-modify-seconds? #t)))
pkg-dir)))
(when (or (not in-place?)
in-place-clean?)
(drop-redundant-files pkg-dir))
(install-info pkg-name
`(dir ,(simple-form-path* pkg-path))
pkg-dir
#f ; no git-dir
(or (not in-place?) in-place-clean?)
given-checksum ; if a checksum is provided, just use it
(directory->module-paths pkg-dir pkg-name metadata-ns)
(directory->additional-installs pkg-dir pkg-name metadata-ns))]))]
(begin
(unless force-strip?
(check-strip-compatible strip-mode pkg-name pkg pkg-error))
(make-directory* pkg-dir)
(generate-stripped-directory strip-mode pkg pkg-dir))
(begin
(make-parent-directory* pkg-dir)
(copy-directory/files pkg-path pkg-dir #:keep-modify-seconds? #t)))
pkg-dir)))
(when (or (not in-place?)
in-place-clean?)
(drop-redundant-files pkg-dir))
(install-info pkg-name
`(dir ,(simple-form-path* pkg-path))
pkg-dir
#f ; no git-dir
(or (not in-place?) in-place-clean?)
given-checksum ; if a checksum is provided, just use it
(directory->module-paths pkg-dir pkg-name metadata-ns)
(directory->additional-installs pkg-dir pkg-name metadata-ns))])]
[(eq? type 'name)
(define catalog-info (package-catalog-lookup pkg #f catalog-lookup-cache
download-printf))