Changeset 12614 in project


Ignore:
Timestamp:
11/27/08 20:56:03 (11 years ago)
Author:
sjamaan
Message:

Fix bugs in normalize-case and add regression tests for it

Location:
release/4/uri-generic/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/uri-generic/trunk/tests/run.scm

    r12582 r12614  
    180180                  (test (sprintf "~S * ~S -> ~S" (first p) (second p) (third p)) expected updated)))
    181181            update-cases))
     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/4/uri-generic/trunk/uri-generic.scm

    r12599 r12614  
    516516
    517517(define reg-name
    518   (count-min-max 0 255 (lambda (c) (or (unreserved-char? c)
    519                                        (pct-encoded? c)
     518  (count-min-max 0 255 (lambda (c) (or (pct-encoded? c)
     519                                       (unreserved-char? c)
    520520                                       (char-set-contains? char-set:sub-delims c) ))))
    521521
     
    10181018;;
    10191019;; Case normalization; cf. RFC3986 section 6.2.2.1
    1020 ;; NOTE:  authority case normalization is not performed
    10211020
    10221021(define (uri-normalize-case uri)
    1023   (let ((scheme  (string->symbol (string-downcase (->string (uri-scheme uri)))))
    1024         (path    (map (lambda (c) (match c (('% h1 h2)  `(% ,(char-upcase h1) ,(char-upcase h2)))
    1025                                          (else c))) (uri-path uri))))
    1026     (update-URI uri scheme: scheme path: path)))
    1027 
     1022  (let* ((normalized-uri (uri-reference (normalize-pct-encoding (uri->string uri (lambda (user pass) (conc user ":" pass))))))
     1023         (scheme         (string->symbol (string-downcase (->string (uri-scheme uri)))))
     1024         (host           (normalize-pct-encoding (string-downcase (uri-host uri)))))
     1025    (update-uri normalized-uri scheme: scheme host: host)))
     1026
     1027(define (normalize-pct-encoding str)
     1028  (uri-char-list->string
     1029   (map (lambda (c) (match c
     1030                           ((#\% h1 h2)  `(#\% ,(char-upcase h1) ,(char-upcase h2)))
     1031                           (else c)))
     1032        (uri-string->normalized-char-list str))))
    10281033
    10291034;;  Path segment normalization; cf. RFC3986 section 6.2.2.4
Note: See TracChangeset for help on using the changeset viewer.