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

PR 7976 fixed

Browse Source 
svn: r2473
This commit is contained in:
Robby Findler 2006-03-21 02:11:14 +00:00
parent 8c3234f112
commit e2d053bac1
2 changed files with 24 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/net/uri-codec-unit.ss
View File

@ -102,8 +102,7 @@
;; The characters that always map to themselves ;; The characters that always map to themselves
(define alphanumeric-mapping (define alphanumeric-mapping
(map (lambda (char) (map (lambda (char) (cons char char))
(cons char char))
'(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J
#\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T
@ -190,17 +189,23 @@
[() (list)] [() (list)]
[(#\% (? hex-digit? char1) (? hex-digit? char2) . rest) [(#\% (? hex-digit? char1) (? hex-digit? char2) . rest)
;; This used to consult the table again, but I think that's ;; This used to consult the table again, but I think that's
;; wrong. For exmaple %2b should produce +, not a space. ;; wrong. For example %2b should produce +, not a space.
(cons (string->number (string char1 char2) 16) (cons (string->number (string char1 char2) 16)
(internal-decode rest))] (internal-decode rest))]
[(char . rest) [((? ascii-char? char) . rest)
(cons (cons
(vector-ref table (vector-ref table (char->integer char))
(char->integer char)) (internal-decode rest))]
[(char . rest)
(append
(bytes->list (string->bytes/utf-8 (string char)))
(internal-decode rest))])) (internal-decode rest))]))
(bytes->string/utf-8 (bytes->string/utf-8
(apply bytes (internal-decode (string->list str))))) (apply bytes (internal-decode (string->list str)))))
(define (ascii-char? c)
(<= (char->integer c) 127))
(define (hex-digit? c) (define (hex-digit? c)
(or (char<=? #\0 c #\9) (or (char<=? #\0 c #\9)
(char<=? #\a c #\f) (char<=? #\a c #\f)
@ -259,11 +264,11 @@
;; http://www.w3.org/TR/html401/appendix/notes.html#ampersands-in-uris ;; http://www.w3.org/TR/html401/appendix/notes.html#ampersands-in-uris
(define form-urlencoded->alist (define form-urlencoded->alist
(opt-lambda (str) (opt-lambda (str)
(define key-regexp (regexp "[^=]*")) (define key-regexp #rx"[^=]*")
(define value-regexp (case (current-alist-separator-mode) (define value-regexp (case (current-alist-separator-mode)
[(semi) (regexp "[^;]*")] [(semi) #rx"[^;]*"]
[(amp) (regexp "[^&]*")] [(amp) #rx"[^&]*"]
[else (regexp "[^&;]*")])) [else #rx"[^&;]*"]))
(define (next-key str start) (define (next-key str start)
(if (>= start (string-length str)) (if (>= start (string-length str))
#f #f

8
collects/tests/mzscheme/net.ss
View File

@ -255,6 +255,14 @@
(test-s->u (vector "mailto" #f #f #f #f '(#("robby@plt-scheme.org")) '() #f) (test-s->u (vector "mailto" #f #f #f #f '(#("robby@plt-scheme.org")) '() #f)
"mailto:robby@plt-scheme.org") "mailto:robby@plt-scheme.org")
(test (vector "http" #f "www.drscheme.org" #f #f '() '((bar . "馨慧")) #f)
string->url/vec
"http://www.drscheme.org?bar=馨慧")
(test (vector "http" #f "www.drscheme.org" #f #f '() '((bár . "é")) #f)
string->url/vec
"http://www.drscheme.org?bár=é")
(let ([empty-url (make-url #f #f #f #f #f '() '() #f)]) (let ([empty-url (make-url #f #f #f #f #f '() '() #f)])
(test-c-u/r (string->url "http://www.drscheme.org") (test-c-u/r (string->url "http://www.drscheme.org")
empty-url empty-url