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

Last change on this file since 31010 was 31010, checked in by sjamaan, 6 years ago

uri-common: Keep around the port but reset it in the generic object when it's the default for the supplied scheme (and when switching schemes)

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