1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;; copyright (c) 1999-2001 Franz Inc, Berkeley, CA - All rights reserved.
3 ;; copyright (c) 2003 Kevin Rosenberg (significant fixes for using
6 ;; The software, data and information contained herein are proprietary
7 ;; to, and comprise valuable trade secrets of, Franz, Inc. They are
8 ;; given in confidence by Franz, Inc. pursuant to a written license
9 ;; agreement, and may be stored and used only in accordance with the terms
12 ;; Restricted Rights Legend
13 ;; ------------------------
14 ;; Use, duplication, and disclosure of the software, data and information
15 ;; contained herein by any agency, department or entity of the U.S.
16 ;; Government are subject to restrictions of Restricted Rights for
17 ;; Commercial Software developed at private expense as specified in
18 ;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
20 ;; Original version from ACL 6.1:
21 ;; t-uri.cl,v 1.3.6.3.2.1 2001/08/09 17:42:43 layer
23 ;; $Id: tests.lisp,v 1.4 2003/07/18 23:33:53 kevin Exp $
26 (defpackage #:puri-tests (:use #:puri #:cl #:util.test))
27 (in-package #:puri-tests)
31 (defmacro gen-test-forms ()
33 (base-uri "http://a/b/c/d;p?q"))
35 (dolist (x `(;; (relative-uri result base-uri compare-function)
36 ;;;; RFC Appendix C.1 (normal examples)
37 ("g:h" "g:h" ,base-uri)
38 ("g" "http://a/b/c/g" ,base-uri)
39 ("./g" "http://a/b/c/g" ,base-uri)
40 ("g/" "http://a/b/c/g/" ,base-uri)
41 ("/g" "http://a/g" ,base-uri)
42 ("//g" "http://g" ,base-uri)
43 ("?y" "http://a/b/c/?y" ,base-uri)
44 ("g?y" "http://a/b/c/g?y" ,base-uri)
45 ("#s" "http://a/b/c/d;p?q#s" ,base-uri)
46 ("g#s" "http://a/b/c/g#s" ,base-uri)
47 ("g?y#s" "http://a/b/c/g?y#s" ,base-uri)
48 (";x" "http://a/b/c/;x" ,base-uri)
49 ("g;x" "http://a/b/c/g;x" ,base-uri)
50 ("g;x?y#s" "http://a/b/c/g;x?y#s" ,base-uri)
51 ("." "http://a/b/c/" ,base-uri)
52 ("./" "http://a/b/c/" ,base-uri)
53 (".." "http://a/b/" ,base-uri)
54 ("../" "http://a/b/" ,base-uri)
55 ("../g" "http://a/b/g" ,base-uri)
56 ("../.." "http://a/" ,base-uri)
57 ("../../" "http://a/" ,base-uri)
58 ("../../g" "http://a/g" ,base-uri)
59 ;;;; RFC Appendix C.2 (abnormal examples)
60 ("" "http://a/b/c/d;p?q" ,base-uri)
61 ("../../../g" "http://a/../g" ,base-uri)
62 ("../../../../g" "http://a/../../g" ,base-uri)
63 ("/./g" "http://a/./g" ,base-uri)
64 ("/../g" "http://a/../g" ,base-uri)
65 ("g." "http://a/b/c/g." ,base-uri)
66 (".g" "http://a/b/c/.g" ,base-uri)
67 ("g.." "http://a/b/c/g.." ,base-uri)
68 ("..g" "http://a/b/c/..g" ,base-uri)
69 ("./../g" "http://a/b/g" ,base-uri)
70 ("./g/." "http://a/b/c/g/" ,base-uri)
71 ("g/./h" "http://a/b/c/g/h" ,base-uri)
72 ("g/../h" "http://a/b/c/h" ,base-uri)
73 ("g;x=1/./y" "http://a/b/c/g;x=1/y" ,base-uri)
74 ("g;x=1/../y" "http://a/b/c/y" ,base-uri)
75 ("g?y/./x" "http://a/b/c/g?y/./x" ,base-uri)
76 ("g?y/../x" "http://a/b/c/g?y/../x" ,base-uri)
77 ("g#s/./x" "http://a/b/c/g#s/./x" ,base-uri)
78 ("g#s/../x" "http://a/b/c/g#s/../x" ,base-uri)
79 ("http:g" "http:g" ,base-uri)
81 ("foo/bar/baz.htm#foo"
82 "http://a/b/foo/bar/baz.htm#foo"
84 ("foo/bar/baz.htm#foo"
85 "http://a/b/foo/bar/baz.htm#foo"
87 ("foo/bar/baz.htm#foo"
88 "http://a/foo/bar/baz.htm#foo"
90 ("foo/bar;x;y/bam.htm"
91 "http://a/b/c/foo/bar;x;y/bam.htm"
93 (push `(util.test:test (intern-uri ,(second x))
94 (intern-uri (merge-uris (intern-uri ,(first x))
95 (intern-uri ,(third x))))
100 (dolist (x '(;; default port and specifying the default port are
101 ;; supposed to compare the same:
102 ("http://www.franz.com:80" "http://www.franz.com")
103 ("http://www.franz.com:80" "http://www.franz.com" eq)
104 ;; make sure they're `eq':
105 ("http://www.franz.com:80" "http://www.franz.com" eq)
106 ("http://www.franz.com" "http://www.franz.com" eq)
107 ("http://www.franz.com/foo" "http://www.franz.com/foo" eq)
108 ("http://www.franz.com/foo?bar"
109 "http://www.franz.com/foo?bar" eq)
110 ("http://www.franz.com/foo?bar#baz"
111 "http://www.franz.com/foo?bar#baz" eq)
112 ("http://WWW.FRANZ.COM" "http://www.franz.com" eq)
113 ("http://www.FRANZ.com" "http://www.franz.com" eq)
114 ("http://www.franz.com" "http://www.franz.com/" eq)
115 (;; %72 is "r", %2f is "/", %3b is ";"
116 "http://www.franz.com/ba%72%2f%3b;x;y;z/baz/"
117 "http://www.franz.com/bar%2f%3b;x;y;z/baz/" eq)))
118 (push `(util.test:test (intern-uri ,(second x))
119 (intern-uri ,(first x))
120 :test ',(if (third x)
125 ;;;; parsing and equivalence tests
126 (push `(util.test:test
127 (parse-uri "http://foo+bar?baz=b%26lob+bof")
128 (parse-uri (parse-uri "http://foo+bar?baz=b%26lob+bof"))
131 (push '(util.test:test
132 (parse-uri "http://www.foo.com")
133 (parse-uri (parse-uri "http://www.foo.com?")) ; allow ? at end
136 (push `(util.test:test
138 (uri-query (parse-uri "http://foo+bar?baz=b%26lob+bof"))
141 (push `(util.test:test
143 (uri-query (parse-uri "http://foo+bar?baz=b%26lob+bof%3d"))
147 `(util.test:test (parse-uri "xxx?%41") (parse-uri "xxx?A") :test 'uri=)
150 `(util.test:test "A" (uri-query (parse-uri "xxx?%41")) :test 'string=)
153 (push `(util.test:test-error (parse-uri " ")
154 :condition-type 'parse-error)
156 (push `(util.test:test-error (parse-uri "foo ")
157 :condition-type 'parse-error)
159 (push `(util.test:test-error (parse-uri " foo ")
160 :condition-type 'parse-error)
162 (push `(util.test:test-error (parse-uri "<foo")
163 :condition-type 'parse-error)
165 (push `(util.test:test-error (parse-uri "foo>")
166 :condition-type 'parse-error)
168 (push `(util.test:test-error (parse-uri "<foo>")
169 :condition-type 'parse-error)
171 (push `(util.test:test-error (parse-uri "%")
172 :condition-type 'parse-error)
174 (push `(util.test:test-error (parse-uri "foo%xyr")
175 :condition-type 'parse-error)
177 (push `(util.test:test-error (parse-uri "\"foo\"")
178 :condition-type 'parse-error)
180 (push `(util.test:test "%20" (format nil "~a" (parse-uri "%20"))
183 (push `(util.test:test "&" (format nil "~a" (parse-uri "%26"))
187 `(util.test:test "foo%23bar" (format nil "~a" (parse-uri "foo%23bar"))
191 `(util.test:test "foo%23bar#foobar"
192 (format nil "~a" (parse-uri "foo%23bar#foobar"))
196 `(util.test:test "foo%23bar#foobar#baz"
197 (format nil "~a" (parse-uri "foo%23bar#foobar#baz"))
201 `(util.test:test "foo%23bar#foobar#baz"
202 (format nil "~a" (parse-uri "foo%23bar#foobar%23baz"))
206 `(util.test:test "foo%23bar#foobar/baz"
207 (format nil "~a" (parse-uri "foo%23bar#foobar%2fbaz"))
210 (push `(util.test:test-error (parse-uri "foobar??")
211 :condition-type 'parse-error)
213 (push `(util.test:test-error (parse-uri "foobar?foo?")
214 :condition-type 'parse-error)
216 (push `(util.test:test "foobar?%3f"
217 (format nil "~a" (parse-uri "foobar?%3f"))
220 (push `(util.test:test
221 "http://foo/bAr;3/baz?baf=3"
222 (format nil "~a" (parse-uri "http://foo/b%41r;3/baz?baf=3"))
225 (push `(util.test:test
226 '(:absolute ("/bAr" "3") "baz")
227 (uri-parsed-path (parse-uri "http://foo/%2fb%41r;3/baz?baf=3"))
230 (push `(util.test:test
232 (let ((u (parse-uri "http://foo/%2fb%41r;3/baz?baf=3")))
233 (setf (uri-parsed-path u) '(:absolute ("/bAr" "3") "baz"))
237 (push `(util.test:test
238 "http://www.verada.com:8010/kapow?name=foo%3Dbar%25"
241 "http://www.verada.com:8010/kapow?name=foo%3Dbar%25"))
244 (push `(util.test:test
245 "ftp://parcftp.xerox.com/pub/pcl/mop/"
247 (parse-uri "ftp://parcftp.xerox.com:/pub/pcl/mop/"))
251 ;;;; enough-uri tests
252 (dolist (x `(("http://www.franz.com/foo/bar/baz.htm"
253 "http://www.franz.com/foo/bar/"
255 ("http://www.franz.com/foo/bar/baz.htm"
256 "http://www.franz.com/foo/bar"
258 ("http://www.franz.com:80/foo/bar/baz.htm"
259 "http://www.franz.com:80/foo/bar"
261 ("http:/foo/bar/baz.htm" "http:/foo/bar" "baz.htm")
262 ("http:/foo/bar/baz.htm" "http:/foo/bar/" "baz.htm")
263 ("/foo/bar/baz.htm" "/foo/bar" "baz.htm")
264 ("/foo/bar/baz.htm" "/foo/bar/" "baz.htm")
265 ("/foo/bar/baz.htm#foo" "/foo/bar/" "baz.htm#foo")
266 ("/foo/bar/baz.htm?bar#foo" "/foo/bar/" "baz.htm?bar#foo")
268 ("http://www.dnai.com/~layer/foo.htm"
269 "http://www.known.net"
270 "http://www.dnai.com/~layer/foo.htm")
271 ("http://www.dnai.com/~layer/foo.htm"
272 "http://www.dnai.com:8000/~layer/"
273 "http://www.dnai.com/~layer/foo.htm")
274 ("http://www.dnai.com:8000/~layer/foo.htm"
275 "http://www.dnai.com/~layer/"
276 "http://www.dnai.com:8000/~layer/foo.htm")
277 ("http://www.franz.com"
278 "http://www.franz.com"
280 (push `(util.test:test (parse-uri ,(third x))
281 (enough-uri (parse-uri ,(first x))
282 (parse-uri ,(second x)))
286 ;;;; urn tests, ideas of which are from rfc2141
287 (let ((urn "urn:com:foo-the-bar"))
288 (push `(util.test:test "com" (urn-nid (parse-uri ,urn))
291 (push `(util.test:test "foo-the-bar" (urn-nss (parse-uri ,urn))
294 (push `(util.test:test-error (parse-uri "urn:")
295 :condition-type 'parse-error)
297 (push `(util.test:test-error (parse-uri "urn:foo")
298 :condition-type 'parse-error)
300 (push `(util.test:test-error (parse-uri "urn:foo$")
301 :condition-type 'parse-error)
303 (push `(util.test:test-error (parse-uri "urn:foo_")
304 :condition-type 'parse-error)
306 (push `(util.test:test-error (parse-uri "urn:foo:foo&bar")
307 :condition-type 'parse-error)
309 (push `(util.test:test (parse-uri "URN:foo:a123,456")
310 (parse-uri "urn:foo:a123,456")
313 (push `(util.test:test (parse-uri "URN:foo:a123,456")
314 (parse-uri "urn:FOO:a123,456")
317 (push `(util.test:test (parse-uri "urn:foo:a123,456")
318 (parse-uri "urn:FOO:a123,456")
321 (push `(util.test:test (parse-uri "URN:FOO:a123%2c456")
322 (parse-uri "urn:foo:a123%2C456")
325 (push `(util.test:test
327 (uri= (parse-uri "urn:foo:A123,456")
328 (parse-uri "urn:FOO:a123,456")))
330 (push `(util.test:test
332 (uri= (parse-uri "urn:foo:A123,456")
333 (parse-uri "urn:foo:a123,456")))
335 (push `(util.test:test
337 (uri= (parse-uri "urn:foo:A123,456")
338 (parse-uri "URN:foo:a123,456")))
340 (push `(util.test:test
342 (uri= (parse-uri "urn:foo:a123%2C456")
343 (parse-uri "urn:FOO:a123,456")))
345 (push `(util.test:test
347 (uri= (parse-uri "urn:foo:a123%2C456")
348 (parse-uri "urn:foo:a123,456")))
350 (push `(util.test:test
352 (uri= (parse-uri "URN:FOO:a123%2c456")
353 (parse-uri "urn:foo:a123,456")))
355 (push `(util.test:test
357 (uri= (parse-uri "urn:FOO:a123%2c456")
358 (parse-uri "urn:foo:a123,456")))
360 (push `(util.test:test
362 (uri= (parse-uri "urn:foo:a123%2c456")
363 (parse-uri "urn:foo:a123,456")))
366 (push `(util.test:test t
367 (uri= (parse-uri "foo") (parse-uri "foo#")))
371 '(let ((puri::*strict-parse* nil))
372 (util.test:test-no-error
374 "http://foo.com/bar?a=zip|zop")))
377 '(util.test:test-error
378 (puri:parse-uri "http://foo.com/bar?a=zip|zop")
379 :condition-type 'parse-error)
383 '(let ((puri::*strict-parse* nil))
384 (util.test:test-no-error
386 "http://arc3.msn.com/ADSAdClient31.dll?GetAd?PG=NBCSBU?SC=D2?AN=1.0586041")))
389 '(util.test:test-error
391 "http://arc3.msn.com/ADSAdClient31.dll?GetAd?PG=NBCSBU?SC=D2?AN=1.0586041")
392 :condition-type 'parse-error)
396 '(let ((puri::*strict-parse* nil))
397 (util.test:test-no-error
399 "http://scbc.booksonline.com/cgi-bin/ndCGI.exe/Develop/pagClubHome.hrfTIOLI_onWebEvent(hrfTIOLI)?selGetClubOffer.TB_OFFER_ID_OFFER=344879%2e0&selGetClubOffer.TB_OFFER_ID_ITEM=34487%2e0&selGetClubOffer.TB_OFFER_ID_OFFER=344879%2e0&^CSpCommand.currRowNumber=5&hrfTIOLI=The+Visual+Basic+6+Programmer%27s+Toolkit&SPIDERSESSION=%3f%3f%3f%3f%3f%5f%3f%3f%3f%40%5b%3f%3f%3f%3fBOs%5cH%3f%3f%3f%3f%3f%3f%3f%3f%3fMMpXO%5f%40JG%7d%40%5c%5f%3f%3f%3fECK%5dt%3fLDT%3fTBD%3fDDTxPEToBS%40%5f%5dBDgXVoKBSDs%7cDT%3fK%3fd%3fTIb%7ceHbkeMfh%60LRpO%5cact%5eUC%7bMu%5fyWUGzLUhP%5ebpdWRka%5dFO%3f%5dBopW%3f%40HMrxbMRd%60LOpuMVga%3fv%3fTS%3fpODT%40O&%5euniqueValue=977933764843")))
402 '(util.test:test-error
404 "http://scbc.booksonline.com/cgi-bin/ndCGI.exe/Develop/pagClubHome.hrfTIOLI_onWebEvent(hrfTIOLI)?selGetClubOffer.TB_OFFER_ID_OFFER=344879%2e0&selGetClubOffer.TB_OFFER_ID_ITEM=34487%2e0&selGetClubOffer.TB_OFFER_ID_OFFER=344879%2e0&^CSpCommand.currRowNumber=5&hrfTIOLI=The+Visual+Basic+6+Programmer%27s+Toolkit&SPIDERSESSION=%3f%3f%3f%3f%3f%5f%3f%3f%3f%40%5b%3f%3f%3f%3fBOs%5cH%3f%3f%3f%3f%3f%3f%3f%3f%3fMMpXO%5f%40JG%7d%40%5c%5f%3f%3f%3fECK%5dt%3fLDT%3fTBD%3fDDTxPEToBS%40%5f%5dBDgXVoKBSDs%7cDT%3fK%3fd%3fTIb%7ceHbkeMfh%60LRpO%5cact%5eUC%7bMu%5fyWUGzLUhP%5ebpdWRka%5dFO%3f%5dBopW%3f%40HMrxbMRd%60LOpuMVga%3fv%3fTS%3fpODT%40O&%5euniqueValue=977933764843")
405 :condition-type 'parse-error)
408 `(progn ,@(nreverse res))))
411 (let ((util.test:*break-on-test-failures* t))
412 (with-tests (:name "puri")