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

Allowing github URLs from PNRs to use illegal package names

Browse Source
This commit is contained in:
Jay McCarthy 2013-02-08 08:22:12 -07:00
parent 1420ce4ed2
commit 2e7f4ba54a
3 changed files with 5 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/planet2/lib.rkt
View File

@ -401,7 +401,7 @@
(define (install-package pkg (define (install-package pkg
given-type given-type
given-pkg-name given-pkg-name
#:given-checksum [given-checksum #f]) #:given-checksum [given-checksum #f])
(define-values (inferred-pkg-name type) (define-values (inferred-pkg-name type)
(if (path? pkg) (if (path? pkg)
(package-source->name+type (path->string pkg) (package-source->name+type (path->string pkg)
@ -420,7 +420,7 @@
(not (regexp-match? #rx"^github://" pkg))) (not (regexp-match? #rx"^github://" pkg)))
;; Add "github://github.com/" ;; Add "github://github.com/"
(install-package (string-append "github://github.com/" pkg) type (install-package (string-append "github://github.com/" pkg) type
pkg-name)] pkg-name #:given-checksum given-checksum)]
[(or (eq? type 'file-url) (eq? type 'dir-url) (eq? type 'github)) [(or (eq? type 'file-url) (eq? type 'dir-url) (eq? type 'github))
(define pkg-url (string->url pkg)) (define pkg-url (string->url pkg))
(define scheme (url-scheme pkg-url)) (define scheme (url-scheme pkg-url))

4
collects/planet2/name.rkt
View File

@ -67,7 +67,7 @@
(if (= (length p) 3) (if (= (length p) 3)
(path/param-path (second (reverse p))) (path/param-path (second (reverse p)))
(path/param-path (last-non-empty p)))))))) (path/param-path (last-non-empty p))))))))
(values name (or type (and name 'github)))] (values name (or type 'github))]
[(if type [(if type
(eq? type 'file-url) (eq? type 'file-url)
(and (pair? p) (and (pair? p)
@ -78,7 +78,7 @@
[else [else
(values (validate-name (path/param-path (last-non-empty p))) 'dir-url)])) (values (validate-name (path/param-path (last-non-empty p))) 'dir-url)]))
(values #f #f))) (values #f #f)))
(values (validate-name name) (or type (and name name-type)))] (values (validate-name name) (or type (and name-type)))]
[(and (not type) [(and (not type)
(regexp-match? #rx"^[a-zA-Z]*://" s)) (regexp-match? #rx"^[a-zA-Z]*://" s))
(values #f #f)] (values #f #f)]

1
collects/tests/planet2/tests-name.rkt
View File

@ -54,6 +54,7 @@
(check-equal-values? (package-source->name+type "http://racket-lang.org/fish" #f) (values "fish" 'dir-url)) (check-equal-values? (package-source->name+type "http://racket-lang.org/fish" #f) (values "fish" 'dir-url))
(check-equal-values? (package-source->name+type "github://github.com/racket/fish/master" #f) (values "fish" 'github)) (check-equal-values? (package-source->name+type "github://github.com/racket/fish/master" #f) (values "fish" 'github))
(check-equal-values? (package-source->name+type "github://github.com/racket/fish.rkt/master" #f) (values #f 'github))
(check-equal-values? (package-source->name+type "github://github.com/racket/fish/release" #f) (values "fish" 'github)) (check-equal-values? (package-source->name+type "github://github.com/racket/fish/release" #f) (values "fish" 'github))
(check-equal-values? (package-source->name+type "github://github.com/racket/fish/release/catfish" #f) (values "catfish" 'github)) (check-equal-values? (package-source->name+type "github://github.com/racket/fish/release/catfish" #f) (values "catfish" 'github))
(check-equal-values? (package-source->name+type "github://github.com/racket/fish/release/catfish/" #f) (values "catfish" 'github)) (check-equal-values? (package-source->name+type "github://github.com/racket/fish/release/catfish/" #f) (values "catfish" 'github))