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

protect package-source parsing against non-path strings

Browse Source
This commit is contained in:
Matthew Flatt 2013-08-20 15:46:04 -06:00
parent 83a813b1e5
commit f371032a34
2 changed files with 15 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt
View File

@ -79,6 +79,14 @@
(check-equal-values? (package-source->name+type "random://racket-lang.org/fish.plt" #f) (values #f #f)) (check-equal-values? (package-source->name+type "random://racket-lang.org/fish.plt" #f) (values #f #f))
(check-equal-values? (package-source->name+type "" #f) (values #f #f))
(check-equal-values? (package-source->name+type "" 'file) (values #f 'file))
(check-equal-values? (package-source->name+type "" 'link) (values #f 'link))
(check-equal-values? (package-source->name+type "" 'static-link) (values #f 'static-link))
(check-equal-values? (package-source->name+type "" 'file-url) (values #f 'file-url))
(check-equal-values? (package-source->name+type "" 'dir-url) (values #f 'dir-url))
(check-equal-values? (package-source->name+type "" 'github) (values #f 'github))
(void)) (void))
(provide run-pkg-tests) (provide run-pkg-tests)

10
racket/collects/pkg/name.rkt
View File

@ -46,15 +46,19 @@
(eq? type 'file) (eq? type 'file)
(and (path-string? s) (and (path-string? s)
(regexp-match rx:archive s))) (regexp-match rx:archive s)))
(define-values (base name+ext dir?) (split-path s)) (define-values (base name+ext dir?) (if (path-string? s)
(define name (extract-archive-name name+ext)) (split-path s)
(values #f #f #f)))
(define name (and name+ext (extract-archive-name name+ext)))
(values name 'file)] (values name 'file)]
[(if type [(if type
(or (eq? type 'dir) (or (eq? type 'dir)
(eq? type 'link) (eq? type 'link)
(eq? type 'static-link)) (eq? type 'static-link))
(path-string? s)) (path-string? s))
(define-values (base name dir?) (split-path s)) (define-values (base name dir?) (if (path-string? s)
(split-path s)
(values #f #f #f)))
(define dir-name (and (path? name) (path->string name))) (define dir-name (and (path? name) (path->string name)))
(values (validate-name dir-name) (or type (and dir-name (if link-dirs? 'link 'dir))))] (values (validate-name dir-name) (or type (and dir-name (if link-dirs? 'link 'dir))))]
[else [else