source: project/release/5/uri-common/tags/2.0/tests/run.scm @ 35625

Last change on this file since 35625 was 35625, checked in by sjamaan, 2 years ago

Release uri-common 2.0 for CHICKEN 5

File size: 11.5 KB
Line 
1(load "../uri-common.scm")
2(import uri-common test (chicken format) (chicken string) srfi-1)
3
4(test-begin "uri-common")
5
6(define internal-representation-cases
7  `(("scheme" ,uri-scheme ; Only a few tests; uri-common doesn't do much
8     ("http:" http)
9     ("" #f))
10    ("host" ,uri-host
11     ("http://a" "a")
12     ("http://a:8080" "a")
13     ("//a" "a")
14     ("/foo" #f)
15     ("http://" "") ; Correct?  Seems so, considering the next example
16     ("http://:123" ""))
17    ("port" ,uri-port
18     ("http://a" 80)
19     ("http://a:8080" 8080)
20     ("https://a" 443)
21     ("https://a:1" 1)
22     ("//a" #f))
23    ("username" ,uri-username
24     ("//foo" #f)
25     ("//@" "")
26     ("//foo@" "foo")
27     ("//foo:bar@" "foo")
28     ("//foo:bar:qux@" "foo")
29     ("//foo%20bar@" "foo bar")
30     ("//foo%3Abar:qux@" "foo:bar")
31     ("//foo%2Ebar@" "foo.bar" "//foo.bar@"))
32    ("password ",uri-password
33     ("//foo" #f)
34     ("//@" #f)
35     ("//foo@" #f)
36     ("//foo:bar@" "bar")
37     ("//foo:bar:qux@" "bar:qux")
38     ("//foo:bar%20qux@" "bar qux")
39     ("//foo:bar%2Equx@" "bar.qux" "//foo:bar.qux@"))
40    ("path" ,uri-path
41     ("http://foo" (/ ""))
42     ("http://foo/" (/ ""))
43     ("//foo" ()) ; Correct? No scheme, so we can't know normalization rules
44     ("//foo/" (/ ""))
45     ("foo%20bar" ("foo bar"))
46     ("foo%2Fbar" ("foo/bar"))
47     ("foo%2ebar" ("foo.bar") "foo.bar")
48     ("foo/bar%2Fqux" ("foo" "bar/qux"))
49     ("foo/" ("foo" ""))
50     ("foo/bar:qux" ("foo" "bar:qux"))
51     ("/foo%2Fbar" (/ "foo/bar"))
52     ("/foo/" (/ "foo" ""))
53     ("/foo:bar" (/ "foo:bar")))
54    ("query ",uri-query
55     ("//" ())
56     ("?" ((|| . #t)))
57     ("?foo" ((foo . #t)))
58     ("?foo?bar" ((foo?bar . #t)))
59     ("?foo/bar" ((foo/bar . #t)))
60     ("?foo%3Fbar" ((foo?bar . #t)))
61     ("?foo%2Ebar" ((foo.bar . #t)) "?foo.bar"))
62    ("fragment" ,uri-fragment
63     ("?foo" #f)
64     ("#bar" "bar")
65     ("?foo#bar" "bar")
66     ("#foo?bar" "foo?bar")
67     ("#foo%3Fbar" "foo?bar")
68     ("#foo/bar" "foo/bar")
69     ("#foo%2Ebar" "foo.bar" "#foo.bar"))))
70
71(test-group "internal representations"
72  (for-each (lambda (p)
73              (test-group (car p)
74                (for-each (lambda (u)
75                            (let ((in (first u))
76                                  (internal (second u))
77                                  (out (if (null? (cddr u))
78                                           (first u)
79                                           (third u)))
80                                  (uri (uri-reference (first u))))
81                              (test (sprintf "~S decoded as ~S" in internal)
82                                    internal ((cadr p) uri))
83                              (test (sprintf "~S encoded to ~S" internal out)
84                                    out (uri->string
85                                         uri
86                                         (lambda (u p)
87                                           (if p (conc u ":" p) u))))))
88                          (cddr p))))
89            internal-representation-cases))
90
91(define update-cases
92  `(("query" query:
93     ;; www-form-urlencoded (hoehrmann):
94     ;; ("" ((foo . "bar?qux")) "?foo=bar?qux")
95     ;; ("" ((foo?bar . "qux")) "?foo?bar=qux")
96     ;; x-www-form-urlencoded:
97     ("" ((foo . "bar?qux")) "?foo=bar%3Fqux")
98     ("" ((foo?bar . "qux")) "?foo%3Fbar=qux")
99     ("" ((foo . "bar&qux")) "?foo=bar%26qux")
100     ("" ((foo&bar . "qux")) "?foo%26bar=qux")
101     ("" ((foo . "bar=qux")) "?foo=bar%3Dqux")
102     ("" ((foo=bar . "qux")) "?foo%3Dbar=qux")
103     ("" ((foo . "bar") (foo . "qux")) "?foo=bar;foo=qux")) ; duplicate keys ok
104    ("port" port:
105     ("http://a" 80 "http://a")
106     ("http://a:80" 80 "http://a")     ; More or less the same as prev
107     ("http://a:1234" 8080 "http://a:8080"))
108    ("scheme" scheme:
109     ("https://a" http "http://a")  ; Port was #f
110     ;; Port is kept around when non-#f
111     ("https://a:443" http "http://a:443") ; Port was explicitly provided
112     ("https://a:80" http "http://a")      ; Not printed when default
113     ("https://a:123" http "http://a:123")
114     ("http://a:8080" https "https://a:8080"))
115    ))
116
117(test-group "updating"
118  (for-each (lambda (p)
119              (test-group (car p)
120               (for-each (lambda (u)
121                           (let* ((slotname (cadr p))
122                                  (input (second u))
123                                  (oexp (third u))
124                                  (oact (update-uri
125                                         (uri-reference (first u))
126                                         slotname input)))
127                             (test (sprintf "~S -> ~S" input oexp)
128                                   oexp (uri->string oact))))
129                         (cddr p))))
130            update-cases))
131
132(define make-cases
133  `(("http://example.com:123/foo/bar?a=b;c=d#location"
134     scheme: http host: "example.com" port: 123 path: (/ "foo" "bar")
135     query: ((a . "b") (c . "d")) fragment: "location")
136    ("//example.com:123/foo/bar?a=b;c=d#location"
137     host: "example.com" port: 123 path: (/ "foo" "bar")
138     query: ((a . "b") (c . "d")) fragment: "location")
139    ("/foo/bar?a=b;c=d#location"
140     port: 123 path: (/ "foo" "bar") query: ((a . "b") (c . "d")) fragment: "location")
141    ("foo/bar?a=b;c=d#location"
142     path: ("foo" "bar") query: ((a . "b") (c . "d")) fragment: "location")
143    ("/?a=b;c=d#location"
144     path: (/ "") query: ((a . "b") (c . "d")) fragment: "location")
145    ("?a=b;c=d#location"
146     query: ((a . "b") (c . "d")) fragment: "location")
147    ("#location"
148     fragment: "location")
149    ("//example.com?a=b;c=d"
150     host: "example.com" query: ((a . "b") (c . "d")))
151    ("//example.com#location"
152     host: "example.com" fragment: "location")
153    ("/"
154     path: (/ ""))
155    ("/"
156     path: (/))                         ; Not sure if this works by accident
157    (""
158     path: ())
159    ("")
160    ;; Pointed out by Andy Bennett, in #998.  In my reading of the
161    ;; relevant specs, reserved characters _must_ be encoded because
162    ;; they may have special meaning on the server, and encoded/unencoded
163    ;; reserved characters produce distinct URIs between which you must be
164    ;; able to differentiate (which uri-generic can, but uri-common cannot).
165    ("5%3A123"
166     path: ("5:123"))))
167
168(test-group "manual constructor"
169  (for-each (lambda (u)
170              (let* ((input (cdr u))
171                     (oexp (first u))
172                     (oact (apply make-uri input)))
173                (test (sprintf "~S -> ~S" input oexp)
174                      oexp (uri->string oact))))
175            make-cases))
176
177;; These are more specific tests for the query cases above, but
178;; on the direct low-level interface to make it less cumbersome
179(define form-urlencoded-hoehrmann-draft-cases
180  `(;; This set is straight from Section 5 ("examples") in the 2006
181    ;; Hoehrmann Internet-Draft for application/www-form-urlencoded,
182    ;; plus two fixes for mistakes in the alternative representations
183    ;; of the first testcase (missing spaces before and after the =).
184    (((| a b c | . " 1  3 "))
185     "+a+b+c+=+1++3+"
186     "%20a%20b%20c%20=%201%20%203%20"
187     "\u0020a\u0020b\u0020c\u0020=\u00201\u0020\u00203\u0020")
188    (((Text . "Line1\u000ALine2"))
189     "Text=Line1%0ALine2"
190     "Text=Line1\u000ALine2"
191     ;; !! "Text=Line1%0D%0ALine2"
192     ;; !! "Text=Line1%0A%0DLine2"
193     )
194    ;; XXX The following 2 examples break.
195    ;; Look into encoding for IRI's in uri-generic
196    #;(((Chevron3 . "Bo\u00F6tes")) ; broken
197     "Chevron3=Bo\u00F6tes"
198     "Chevron3=Bo%C3%B6tes"
199     ;; !! "Chevron3=Boo\u0308tes"
200     )
201    #;(((Lookup . "\u0000,\u2323,\u20AC")) ; broken
202     "Lookup=%00,\u2323,\u20AC"
203     "Lookup=\u0000,\u2323,\u20AC"
204     ;; !! "Lookup=,\u2323,\u20AC"
205     ;; !! "Lookup="
206     )
207    (((Cipher . "c=(m^e)%n"))
208     ;; www-form-urlencoded (hoehrmann):
209     ;; "Cipher=c%3D(m%5Ee)%25n"
210     ;; x-www-form-urlencoded:
211     "Cipher=c%3D%28m%5Ee%29%25n"
212     "Cipher=c=(m%5Ee)%25n"
213     "Cipher=c=(m^e)%n"
214     "%43%69%70%68%65%72=%63%3d%28%6D%5E%65%29%25%6e"
215     ;; !! "Cipher%3Dc%3D(m%5Ee)%25n"
216     ;; !! "Cipher=c=(m^e)"
217     ;; !! "Cipher=c"
218     )
219    (((|| . #t) (|| . #t)) ";")
220    (((|| . #t) (|| . "")) ";=")
221    (((|| . "") (|| . #t)) "=;")
222    (((|| . "") (|| . "")) "=;=")
223    (((|| . "")) "=")
224    (((|| . #t)) "")
225    (((a&b . "1") (c . "2;3") (e . "4"))
226     "a%26b=1;c=2%3B3;e=4"
227     "a%26b=1&c=2%3B3&e=4"
228     "a%26b=1;c=2%3B3&e=4"
229     "a%26b=1&c=2%3B3;e=4"
230     ;; !! "a&b=1;c=2%3B3;e=4"
231     ;; !! "a%26b=1&c=2;3&e=4"
232     )
233    (((img . #t) (avail . #t) (name . #t) (price . #t))
234     "img;avail;name;price")
235    (((foo+bar . "mooh+qux") (|foo bar| . "mooh qux"))
236     "foo%2Bbar=mooh%2Bqux;foo+bar=mooh+qux")
237    (((no+value . #t) (|no value| . #t))
238     "no%2Bvalue;no+value")))
239
240(test-group "form-urlencoding-hoehrmann-draft-cases"
241  (for-each (lambda (u)
242              (let* ((alist (first u))
243                     (primary (second u))
244                     (alternatives (cddr u)))
245                (test (sprintf "encode ~S -> ~S" alist primary)
246                      primary (form-urlencode alist))
247                (for-each (lambda (a)
248                            (test (sprintf "decode ~S -> ~S" a alist)
249                                  alist (form-urldecode a)))
250                          (cons primary alternatives))))
251            form-urlencoded-hoehrmann-draft-cases))
252
253;; Slightly different from the uri-generic tests: URIs with a host but no
254;; succeeding path are treated as if they had an absolute path of "/".
255;; This is "scheme-based normalization", see RFC 3986, section 6.2.3
256(define absolute-paths
257  '("/"
258    "/foo"
259    "/foo/bar"
260    "//foo/"
261    "http://foo/bar"
262    "http://foo"
263    "http://foo/"
264    "http://foo#qux"
265    "http://foo/#qux"
266    "http://foo/?bar=qux"))
267
268(define relative-paths
269  '(""
270    "//foo"     ; Iffy, but strictly correct: we don't know the scheme
271    "foo/bar"
272    "bar#qux"
273    "bar?qux=mooh"))
274
275(test-group "absolute/relative path distinction"
276  (for-each (lambda (s)
277              (test-assert (sprintf "~S is not a relative path" s)
278                           (not (uri-path-relative? (uri-reference s))))
279              (test-assert (sprintf "~S is an absolute path" s)
280                           (uri-path-absolute? (uri-reference s))))
281            absolute-paths)
282  (for-each (lambda (s)
283              (test-assert (sprintf "~S is a relative path" s)
284                           (uri-path-relative? (uri-reference s)))
285              (test-assert (sprintf "~S is not an absolute path" s)
286                           (not (uri-path-absolute? (uri-reference s)))))
287            relative-paths))
288
289(test-group "miscellaneous"
290  (test "scheme doesn't reset port if port given"
291        (uri-reference "https://foo:123")
292        (update-uri (uri-reference "http://foo:8080")
293                    port: 123 scheme: 'https))
294  (test "port is no longer printed when it's the default for a new scheme"
295        "http://foo"
296        (uri->string (update-uri (make-uri scheme: 'https port: 80 host: "foo")
297                                 scheme: 'http)))
298  (test "port is kept around even if default for scheme"
299        "https://foo:80"
300        (uri->string (update-uri (make-uri scheme: 'http port: 80 host: "foo")
301                                 scheme: 'https)))
302  (test "separator string order is maintained in form-urlencode"
303        '("foo=bar&qux=mooh" "foo=bar;qux=mooh")
304        (list (form-urlencode '((foo . "bar") (qux . "mooh")) separator: "&;")
305              (form-urlencode '((foo . "bar") (qux . "mooh")) separator: ";&")))
306  (test "False values can't be distinguished from missing values"
307        #f
308        (form-urlencode '((foo . #f)))))
309
310(test-end)
311
312(unless (zero? (test-failure-count)) (exit 1))
Note: See TracBrowser for help on using the repository browser.