Allowing github URLs from PNRs to use illegal package names

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

View File

@ -420,7 +420,7 @@
(not (regexp-match? #rx"^github://" pkg)))
;; Add "github://github.com/"
(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))
(define pkg-url (string->url pkg))
(define scheme (url-scheme pkg-url))

View File

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

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 "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/catfish" #f) (values "catfish" 'github))
(check-equal-values? (package-source->name+type "github://github.com/racket/fish/release/catfish/" #f) (values "catfish" 'github))