Changeset 12617 in project
- Timestamp:
- 11/27/08 21:28:16 (12 years ago)
- Location:
- release/3/uri-generic/trunk
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
release/3/uri-generic/trunk
- Property svn:mergeinfo changed
/release/4/uri-generic/trunk merged: 12614-12615
- Property svn:mergeinfo changed
-
release/3/uri-generic/trunk/tests/run.scm
r12604 r12617 1 1 (require-extension srfi-1) 2 ( require-extension uri-generic)2 (load "../uri-generic.scm") 3 3 4 4 (require-extension test) … … 181 181 update-cases)) 182 182 183 (define normalize-case-cases 184 '(("http://exa%2fmple/FOO%2fbar" "http://exa%2Fmple/FOO%2Fbar") 185 ("http://EXA%2fMPLE/FOO%2fbar" "http://exa%2Fmple/FOO%2Fbar") 186 ("HTTP://example/" "http://example/") 187 ("http://user:PASS@example/FOO%2fbar" "http://user:PASS@example/FOO%2Fbar") 188 ("http://uS%2fer:PA%2fSS@example/FOO%2fbar" "http://uS%2Fer:PA%2FSS@example/FOO%2Fbar") 189 ("HTTP://example/?mooH=MUMBLe%2f" "http://example/?mooH=MUMBLe%2F") 190 ("http://example/#baR%2f" "http://example/#baR%2F"))) 191 192 (test-group "normalize-case test" 193 (for-each (lambda (p) 194 (let ((case-normalized (uri-normalize-case (uri-reference (first p)))) 195 (expected (second p))) 196 (test (sprintf "~S -> ~S" (first p) (second p)) expected (uri->string case-normalized (lambda (user pass) (conc user ":" pass)))))) 197 normalize-case-cases)) -
release/3/uri-generic/trunk/uri-generic.scm
r12600 r12617 528 528 529 529 (define reg-name 530 (count-min-max 0 255 (lambda (c) (or ( unreserved-char? c)531 ( pct-encoded? c)530 (count-min-max 0 255 (lambda (c) (or (pct-encoded? c) 531 (unreserved-char? c) 532 532 (char-set-contains? char-set:sub-delims c) )))) 533 533 … … 1052 1052 ;; 1053 1053 ;; Case normalization; cf. RFC3986 section 6.2.2.1 1054 ;; NOTE: authority case normalization is not performed1055 1054 1056 1055 (define (uri-normalize-case uri) 1057 (let ((u1 (udup uri)) 1058 (scheme (string->symbol (string-downcase (->string (uri-scheme uri))))) 1059 (path (map (lambda (c) (match c (('% h1 h2) `(% ,(char-upcase h1) ,(char-upcase h2))) 1060 (else c))) (uri-path uri)))) 1061 (URI-scheme-set! u1 scheme) 1062 (URI-path-set! u1 path) 1063 u1)) 1064 1056 (let* ((normalized-uri (uri-reference (normalize-pct-encoding (uri->string uri (lambda (user pass) (conc user ":" pass)))))) 1057 (scheme (string->symbol (string-downcase (->string (uri-scheme uri))))) 1058 (host (normalize-pct-encoding (string-downcase (uri-host uri))))) 1059 (update-uri normalized-uri scheme: scheme host: host))) 1060 1061 (define (normalize-pct-encoding str) 1062 (uri-char-list->string 1063 (map (lambda (c) (match c 1064 ((#\% h1 h2) `(#\% ,(char-upcase h1) ,(char-upcase h2))) 1065 (else c))) 1066 (uri-string->normalized-char-list str)))) 1065 1067 1066 1068 ;; Path segment normalization; cf. RFC3986 section 6.2.2.4
Note: See TracChangeset
for help on using the changeset viewer.