source: project/release/3/uri-generic/trunk/tests/run.scm @ 12361

Last change on this file since 12361 was 12361, checked in by sjamaan, 12 years ago

Backport patches to uri-generic release 3

File size: 6.1 KB
Line 
1(require-extension srfi-1)
2(require-extension uri-generic)
3(require-extension test)
4
5;; test cases from Python URI implementation
6
7(define  path-cases
8  '(("foo:xyz" "bar:abc" "bar:abc")
9     ("http://example/x/y/z" "http://example/x/abc" "../abc")
10     ("http://example2/x/y/z" "http://example/x/abc" "//example/x/abc")
11     ("http://ex/x/y/z" "http://ex/x/r" "../r")
12
13    ("http://ex/x/y"  "http://ex/x/q/r" "./q/r")
14    ("http://ex/x/y"  "http://ex/x/q/r#s" "./q/r#s")
15    ("http://ex/x/y"  "http://ex/x/q/r#s/t" "./q/r#s/t")
16    ("http://ex/x/y"  "ftp://ex/x/q/r" "ftp://ex/x/q/r")
17    ("http://ex/x/y"  "http://ex/x/y"   "")
18    ("http://ex/x/y/" "http://ex/x/y/"  "")
19    ("http://ex/x/y/pdq" "http://ex/x/y/pdq" "")
20    ("http://ex/x/y/" "http://ex/x/y/z/" "./z/")
21    ("file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "#Animal")
22    ("file:/e/x/y/z" "file:/e/x/abc" "../abc")
23    ("file:/example2/x/y/z" "file:/example/x/abc" "/example/x/abc")   
24    ("file:/ex/x/y/z" "file:/ex/x/r" "../r")
25    ("file:/ex/x/y/z" "file:/r" "/r")       
26    ("file:/ex/x/y" "file:/ex/x/q/r" "./q/r")
27    ("file:/ex/x/y" "file:/ex/x/q/r#s" "./q/r#s")
28    ("file:/ex/x/y" "file:/ex/x/q/r#" "./q/r#")
29    ("file:/ex/x/y" "file:/ex/x/q/r#s/t" "./q/r#s/t")
30    ("file:/ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r")
31    ("file:/ex/x/y" "file:/ex/x/y" "")
32    ("file:/ex/x/y/" "file:/ex/x/y/" "")
33    ("file:/ex/x/y/pdq" "file:/ex/x/y/pdq" "")
34    ("file:/ex/x/y/" "file:/ex/x/y/z/" "./z/")
35    ("file:/devel/WWW/2000/10/swap/test/reluri-1.n3" "file://meetings.example.com/cal#m1" 
36     "//meetings.example.com/cal#m1")
37    ("file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3" "file://meetings.example.com/cal#m1" 
38     "//meetings.example.com/cal#m1")
39    ("file:/some/dir/foo" "file:/some/dir/#blort" "./#blort")
40    ("file:/some/dir/foo" "file:/some/dir/#" "./#")
41    ;; From Graham Klyne Thu 20 Feb 2003 18:08:17 +0000
42   ("http://example/x/y%2Fz"  "http://example/x/abc"     "./abc")
43   ("http://example/x/y/z"    "http://example/x%2Fabc"   "/x%2Fabc")
44   ("http://example/x/y%2Fz"  "http://example/x%2Fabc"   "/x%2Fabc")
45   ("http://example/x%2Fy/z"  "http://example/x%2Fy/abc" "./abc")
46   ;; Ryan Lee
47   ("http://example/x/abc.efg" "http://example/x/" "./")
48   ))
49
50(define base "http://a/b/c/d;p?q")
51
52(define rfc-cases
53  `((,base "g:h" "g:h")
54    (,base "g" "http://a/b/c/g")
55    (,base "./g" "http://a/b/c/g")
56    (,base "g/" "http://a/b/c/g/")
57    (,base "/g" "http://a/g")
58    (,base "//g" "http://g")
59    (,base "?y" "http://a/b/c/?y") 
60    (,base "g?y" "http://a/b/c/g?y")
61    (,base "#s" "http://a/b/c/d;p?q#s") 
62    (,base "g#s" "http://a/b/c/g#s")
63    (,base "g?y#s" "http://a/b/c/g?y#s")
64    (,base ";x" "http://a/b/c/;x")
65    (,base "g;x" "http://a/b/c/g;x")
66    (,base "g;x?y#s" "http://a/b/c/g;x?y#s")
67    (,base "."  "http://a/b/c/")
68    (,base "./" "http://a/b/c/")
69    (,base ".." "http://a/b/")
70    (,base "../" "http://a/b/")
71    (,base "../g" "http://a/b/g")
72    (,base "../.." "http://a/")
73    (,base "../../" "http://a/")
74    (,base "../../g" "http://a/g")
75    ))
76
77(define extra-cases
78  `((,base "" ,base)
79    (,base "../../../g" "http://a/g") 
80    (,base "../../../../g" "http://a/g") 
81    (,base "/./g" "http://a/g")
82    (,base "/../g" "http://a/g")
83    (,base "g.." "http://a/b/c/g..")
84    (,base "..g" "http://a/b/c/..g")
85   
86    (,base "./../g" "http://a/b/g")
87    (,base "./g/." "http://a/b/c/g/") 
88    (,base "g/./h" "http://a/b/c/g/h") 
89    (,base "g/../h" "http://a/b/c/h")
90    (,base "g;x=1/./y" "http://a/b/c/g;x=1/y") 
91    (,base "g;x=1/../y" "http://a/b/c/y") 
92   
93    (,base "g?y/./x" "http://a/b/c/g?y/./x")
94    (,base "g?y/../x" "http://a/b/c/g?y/../x")
95    (,base "g#s/./x" "http://a/b/c/g#s/./x")
96    (,base "g#s/../x" "http://a/b/c/g#s/../x")
97   
98    ("?a=b&c=d" "" "?a=b&c=d")
99    (,base "" "http://a/b/c/d;p?q")
100    ("" ,base "http://a/b/c/d;p?q")
101    ))
102
103(test-group "uri test"
104  (for-each (lambda (p)
105              (let ((ubase (uri-reference (first p)))
106                    (urabs  (uri-reference (second p)))
107                    (uabs  (absolute-uri (second p)))
108                    (uex   (uri-reference (third p))))
109                (let* ((from (uri-relative-from urabs ubase))
110                       (to    (uri-relative-to from ubase)))
111                  (test (apply sprintf "~S * ~S -> ~S" p) uex from)
112                  (test (apply sprintf "~S * ~S -> ~S" p) urabs to)
113                  (if (not (uri-fragment urabs))
114                      (test (sprintf "~S = ~S" uabs urabs) urabs uabs))
115                  ))
116              (for-each
117               (lambda (s)
118                 (test (sprintf "~S = ~S" s (uri->string (uri-reference s)))
119                       s (uri->string (uri-reference s))))
120               p))
121            path-cases))
122
123(test-group "rfc test"
124  (for-each (lambda (p)
125              (let ((ubase (uri-reference (first p)))
126                    (urabs  (uri-reference (second p)))
127                    (uex   (uri-reference (third p))))
128                (let* ((to    (uri-relative-to urabs ubase)))
129                  (test (apply sprintf "~S * ~S -> ~S" p) uex to)
130                  )))
131            rfc-cases))
132
133(test-group "extra-test"
134  (for-each (lambda (p)
135              (let ((ubase (uri-reference (first p)))
136                    (urabs  (uri-reference (second p)))
137                    (uex   (uri-reference (third p))))
138                (let* ((to    (uri-relative-to urabs ubase)))
139                  (test (apply sprintf "~S * ~S -> ~S" p) uex to)
140                  )))
141            extra-cases))
142
143(define encode/decode-cases
144  '(("foo?bar" "foo%3fbar")
145    ("foo&bar" "foo%26bar")
146    ("foo%20bar" "foo%2520bar")))
147
148(test-group "uri-encode-string test"
149  (for-each (lambda (p)
150              (let ((expected (second p))
151                    (encoded (uri-encode-string (first p))))
152                  (test (sprintf "~S -> ~S" (first p) expected) expected encoded)))
153            encode/decode-cases))
154
155(test-group "uri-decode-string test"
156  (for-each (lambda (p)
157              (let ((expected (first p))
158                    (decoded (uri-decode-string (second p))))
159                  (test (sprintf "~S -> ~S" (second p) expected) expected decoded)))
160            encode/decode-cases))
Note: See TracBrowser for help on using the repository browser.