source: project/release/4/uri-common/trunk/tests/run.scm @ 20244

Last change on this file since 20244 was 20244, checked in by sjamaan, 10 years ago

Fix #373 (query alists encoded according to x-www-form-urlencoded rather than www-form-urlencoded)

File size: 7.6 KB
Line 
1(load "../uri-common.scm")
2(import uri-common)
3(use test)
4
5(test-begin "uri-common")
6
7(define internal-representation-cases
8  `(("scheme" ,uri-scheme ; Only a few tests; uri-common doesn't do much
9     ("http:" http)
10     ("" #f))
11    ("port" ,uri-port
12     ("http://a" 80)
13     ("http://a:8080" 8080)
14     ("https://a" 443)
15     ("https://a:1" 1)
16     ("//a" #f))
17    ("username" ,uri-username
18     ("//foo" #f)
19     ("//@" "")
20     ("//foo@" "foo")
21     ("//foo:bar@" "foo")
22     ("//foo:bar:qux@" "foo")
23     ("//foo%20bar@" "foo bar")
24     ("//foo%3Abar:qux@" "foo:bar")
25     ("//foo%2Ebar@" "foo.bar" "//foo.bar@"))
26    ("password ",uri-password
27     ("//foo" #f)
28     ("//@" #f)
29     ("//foo@" #f)
30     ("//foo:bar@" "bar")
31     ("//foo:bar:qux@" "bar:qux")
32     ("//foo:bar%20qux@" "bar qux")
33     ("//foo:bar%2Equx@" "bar.qux" "//foo:bar.qux@"))
34    ("path" ,uri-path
35     ("http://foo" (/ ""))
36     ("http://foo/" (/ ""))
37     ("//foo" ()) ; Correct? No scheme, so we can't know normalization rules
38     ("//foo/" (/ ""))
39     ("foo%20bar" ("foo bar"))
40     ("foo%2Fbar" ("foo/bar"))
41     ("foo%2ebar" ("foo.bar") "foo.bar")
42     ("foo/bar%2Fqux" ("foo" "bar/qux"))
43     ("foo/" ("foo" ""))
44     ("foo/bar:qux" ("foo" "bar:qux"))
45     ("/foo%2Fbar" (/ "foo/bar"))
46     ("/foo/" (/ "foo" ""))
47     ("/foo:bar" (/ "foo:bar")))
48    ("query ",uri-query
49     ("//" ())
50     ("?" ((|| . #t)))
51     ("?foo" ((foo . #t)))
52     ("?foo?bar" ((foo?bar . #t)))
53     ("?foo/bar" ((foo/bar . #t)))
54     ("?foo%3Fbar" ((foo?bar . #t)))
55     ("?foo%2Ebar" ((foo.bar . #t)) "?foo.bar"))
56    ("fragment" ,uri-fragment
57     ("?foo" #f)
58     ("#bar" "bar")
59     ("?foo#bar" "bar")
60     ("#foo?bar" "foo?bar")
61     ("#foo%3Fbar" "foo?bar")
62     ("#foo/bar" "foo/bar")
63     ("#foo%2Ebar" "foo.bar" "#foo.bar"))))
64
65(test-group "internal representations"
66  (for-each (lambda (p)
67              (test-group (car p)
68                (for-each (lambda (u)
69                            (let ((in (first u))
70                                  (internal (second u))
71                                  (out (if (null? (cddr u))
72                                           (first u)
73                                           (third u)))
74                                  (uri (uri-reference (first u))))
75                              (test (sprintf "~S decoded as ~S" in internal)
76                                    internal ((cadr p) uri))
77                              (test (sprintf "~S encoded to ~S" internal out)
78                                    out (uri->string
79                                         uri
80                                         (lambda (u p)
81                                           (if p (conc u ":" p) u))))))
82                          (cddr p))))
83            internal-representation-cases))
84
85(define update-cases
86  `(("query" query:
87     ;; www-form-urlencoded (hoehrmann):
88     ;; ("" ((foo . "bar?qux")) "?foo=bar?qux")
89     ;; ("" ((foo?bar . "qux")) "?foo?bar=qux")
90     ;; x-www-form-urlencoded:
91     ("" ((foo . "bar?qux")) "?foo=bar%3Fqux")
92     ("" ((foo?bar . "qux")) "?foo%3Fbar=qux")
93     ("" ((foo . "bar&qux")) "?foo=bar%26qux")
94     ("" ((foo&bar . "qux")) "?foo%26bar=qux")
95     ("" ((foo . "bar=qux")) "?foo=bar%3Dqux")
96     ("" ((foo=bar . "qux")) "?foo%3Dbar=qux")
97     ("" ((foo . "bar") (foo . "qux")) "?foo=bar;foo=qux")) ; duplicate keys ok
98    ("port" port:
99     ("http://a" 80 "http://a")
100     ("http://a:1234" 8080 "http://a:8080"))
101    ("scheme" scheme:    ;; scheme causes reset of port, in all cases
102     ("https://a" http "http://a")
103     ("https://a:80" http "http://a")
104     ("https://a:123" http "http://a")
105     ("http://a:8080" https "https://a"))
106    ))
107
108(test-group "updating"
109  (for-each (lambda (p)
110              (test-group (car p)
111               (for-each (lambda (u)
112                           (let* ((slotname (cadr p))
113                                  (input (second u))
114                                  (oexp (third u))
115                                  (oact (update-uri
116                                         (uri-reference (first u))
117                                         slotname input)))
118                             (test (sprintf "~S -> ~S" input oexp)
119                                   oexp (uri->string oact))))
120                         (cddr p))))
121            update-cases))
122
123;; These are more specific tests for the query cases above, but
124;; on the direct low-level interface to make it less cumbersome
125(define form-urlencoded-hoehrmann-draft-cases
126  `(;; This set is straight from Section 5 ("examples") in the 2006
127    ;; Hoehrmann Internet-Draft for application/www-form-urlencoded,
128    ;; plus two fixes for mistakes in the alternative representations
129    ;; of the first testcase (missing spaces before and after the =).
130    (((| a b c | . " 1  3 "))
131     "+a+b+c+=+1++3+"
132     "%20a%20b%20c%20=%201%20%203%20"
133     "\u0020a\u0020b\u0020c\u0020=\u00201\u0020\u00203\u0020")
134    (((Text . "Line1\u000ALine2"))
135     "Text=Line1%0ALine2"
136     "Text=Line1\u000ALine2"
137     ;; !! "Text=Line1%0D%0ALine2"
138     ;; !! "Text=Line1%0A%0DLine2"
139     )
140    ;; XXX The following 2 examples break.
141    ;; Look into encoding for IRI's in uri-generic
142    (((Chevron3 . "Bo\u00F6tes")) ; broken
143     "Chevron3=Bo\u00F6tes"
144     "Chevron3=Bo%C3%B6tes"
145     ;; !! "Chevron3=Boo\u0308tes"
146     )
147    (((Lookup . "\u0000,\u2323,\u20AC")) ; broken
148     "Lookup=%00,\u2323,\u20AC"
149     "Lookup=\u0000,\u2323,\u20AC"
150     ;; !! "Lookup=,\u2323,\u20AC"
151     ;; !! "Lookup="
152     )
153    (((Cipher . "c=(m^e)%n"))
154     ;; www-form-urlencoded (hoehrmann):
155     ;; "Cipher=c%3D(m%5Ee)%25n"
156     ;; x-www-form-urlencoded:
157     "Cipher=c%3D%28m%5Ee%29%25n"
158     "Cipher=c=(m%5Ee)%25n"
159     "Cipher=c=(m^e)%n"
160     "%43%69%70%68%65%72=%63%3d%28%6D%5E%65%29%25%6e"
161     ;; !! "Cipher%3Dc%3D(m%5Ee)%25n"
162     ;; !! "Cipher=c=(m^e)"
163     ;; !! "Cipher=c"
164     )
165    (((|| . #t) (|| . #t)) ";")
166    (((|| . #t) (|| . "")) ";=")
167    (((|| . "") (|| . #t)) "=;")
168    (((|| . "") (|| . "")) "=;=")
169    (((|| . "")) "=")
170    (((|| . #t)) "")
171    (((a&b . "1") (c . "2;3") (e . "4"))
172     "a%26b=1;c=2%3B3;e=4"
173     "a%26b=1&c=2%3B3&e=4"
174     "a%26b=1;c=2%3B3&e=4"
175     "a%26b=1&c=2%3B3;e=4"
176     ;; !! "a&b=1;c=2%3B3;e=4"
177     ;; !! "a%26b=1&c=2;3&e=4"
178     )
179    (((img . #t) (avail . #t) (name . #t) (price . #t))
180     "img;avail;name;price")
181    (((foo+bar . "mooh+qux") (|foo bar| . "mooh qux"))
182     "foo%2Bbar=mooh%2Bqux;foo+bar=mooh+qux")
183    (((no+value . #t) (|no value| . #t))
184     "no%2Bvalue;no+value")))
185
186(test-group "form-urlencoding-hoehrmann-draft-cases"
187  (for-each (lambda (u)
188              (let* ((alist (first u))
189                     (primary (second u))
190                     (alternatives (cddr u)))
191                (test (sprintf "encode ~S -> ~S" alist primary)
192                      primary (form-urlencode alist))
193                (for-each (lambda (a)
194                            (test (sprintf "decode ~S -> ~S" a alist)
195                                  alist (form-urldecode a)))
196                          (cons primary alternatives))))
197            form-urlencoded-hoehrmann-draft-cases))
198
199(test-group "miscellaneous"
200  (test "scheme doesn't reset port if port given"
201        (uri-reference "https://foo:123")
202        (update-uri (uri-reference "http://foo:8080")
203                    port: 123 scheme: 'https))
204  (test "separator string order is maintained in form-urlencode"
205        '("foo=bar&qux=mooh" "foo=bar;qux=mooh")
206        (list (form-urlencode '((foo . "bar") (qux . "mooh")) separator: "&;")
207              (form-urlencode '((foo . "bar") (qux . "mooh")) separator: ";&")))
208  (test "False values can't be distinguished from missing values"
209        #f
210        (form-urlencode '((foo . #f)))))
211
212(test-end)
Note: See TracBrowser for help on using the repository browser.