;; Original version from ACL 6.1:
;; t-uri.cl,v 1.3.6.3.2.1 2001/08/09 17:42:43 layer
;;
-;; $Id: tests.lisp,v 1.3 2003/07/18 23:11:37 kevin Exp $
+;; $Id$
-(defpackage #:puri-tests (:use #:puri #:cl #:util.test))
+(defpackage #:puri-tests (:use #:puri #:cl #:ptester))
(in-package #:puri-tests)
(unintern-uri t)
-(defparameter *tests*
+(defmacro gen-test-forms ()
(let ((res '())
- (base-uri "http://a/b/c/d;p?q"))
+ (base-uri "http://a/b/c/d;p?q"))
(dolist (x `(;; (relative-uri result base-uri compare-function)
;;;; RFC Appendix C.1 (normal examples)
- ("g:h" "g:h" ,base-uri)
- ("g" "http://a/b/c/g" ,base-uri)
- ("./g" "http://a/b/c/g" ,base-uri)
- ("g/" "http://a/b/c/g/" ,base-uri)
- ("/g" "http://a/g" ,base-uri)
- ("//g" "http://g" ,base-uri)
- ("?y" "http://a/b/c/?y" ,base-uri)
- ("g?y" "http://a/b/c/g?y" ,base-uri)
- ("#s" "http://a/b/c/d;p?q#s" ,base-uri)
- ("g#s" "http://a/b/c/g#s" ,base-uri)
- ("g?y#s" "http://a/b/c/g?y#s" ,base-uri)
- (";x" "http://a/b/c/;x" ,base-uri)
- ("g;x" "http://a/b/c/g;x" ,base-uri)
- ("g;x?y#s" "http://a/b/c/g;x?y#s" ,base-uri)
- ("." "http://a/b/c/" ,base-uri)
- ("./" "http://a/b/c/" ,base-uri)
- (".." "http://a/b/" ,base-uri)
- ("../" "http://a/b/" ,base-uri)
- ("../g" "http://a/b/g" ,base-uri)
- ("../.." "http://a/" ,base-uri)
- ("../../" "http://a/" ,base-uri)
- ("../../g" "http://a/g" ,base-uri)
+ ("g:h" "g:h" ,base-uri)
+ ("g" "http://a/b/c/g" ,base-uri)
+ ("./g" "http://a/b/c/g" ,base-uri)
+ ("g/" "http://a/b/c/g/" ,base-uri)
+ ("/g" "http://a/g" ,base-uri)
+ ("//g" "http://g" ,base-uri)
+ ;; Following was changed from appendix C of RFC 2396
+ ;; http://www.apache.org/~fielding/uri/rev-2002/issues.html#003-relative-query
+ #-ignore ("?y" "http://a/b/c/d;p?y" ,base-uri)
+ #+ignore ("?y" "http://a/b/c/?y" ,base-uri)
+ ("g?y" "http://a/b/c/g?y" ,base-uri)
+ ("#s" "http://a/b/c/d;p?q#s" ,base-uri)
+ ("g#s" "http://a/b/c/g#s" ,base-uri)
+ ("g?y#s" "http://a/b/c/g?y#s" ,base-uri)
+ (";x" "http://a/b/c/;x" ,base-uri)
+ ("g;x" "http://a/b/c/g;x" ,base-uri)
+ ("g;x?y#s" "http://a/b/c/g;x?y#s" ,base-uri)
+ ("." "http://a/b/c/" ,base-uri)
+ ("./" "http://a/b/c/" ,base-uri)
+ (".." "http://a/b/" ,base-uri)
+ ("../" "http://a/b/" ,base-uri)
+ ("../g" "http://a/b/g" ,base-uri)
+ ("../.." "http://a/" ,base-uri)
+ ("../../" "http://a/" ,base-uri)
+ ("../../g" "http://a/g" ,base-uri)
;;;; RFC Appendix C.2 (abnormal examples)
- ("" "http://a/b/c/d;p?q" ,base-uri)
- ("../../../g" "http://a/../g" ,base-uri)
- ("../../../../g" "http://a/../../g" ,base-uri)
- ("/./g" "http://a/./g" ,base-uri)
- ("/../g" "http://a/../g" ,base-uri)
- ("g." "http://a/b/c/g." ,base-uri)
- (".g" "http://a/b/c/.g" ,base-uri)
- ("g.." "http://a/b/c/g.." ,base-uri)
- ("..g" "http://a/b/c/..g" ,base-uri)
- ("./../g" "http://a/b/g" ,base-uri)
- ("./g/." "http://a/b/c/g/" ,base-uri)
- ("g/./h" "http://a/b/c/g/h" ,base-uri)
- ("g/../h" "http://a/b/c/h" ,base-uri)
- ("g;x=1/./y" "http://a/b/c/g;x=1/y" ,base-uri)
- ("g;x=1/../y" "http://a/b/c/y" ,base-uri)
- ("g?y/./x" "http://a/b/c/g?y/./x" ,base-uri)
- ("g?y/../x" "http://a/b/c/g?y/../x" ,base-uri)
- ("g#s/./x" "http://a/b/c/g#s/./x" ,base-uri)
- ("g#s/../x" "http://a/b/c/g#s/../x" ,base-uri)
- ("http:g" "http:g" ,base-uri)
+ ("" "http://a/b/c/d;p?q" ,base-uri)
+ ("../../../g" "http://a/../g" ,base-uri)
+ ("../../../../g" "http://a/../../g" ,base-uri)
+ ("/./g" "http://a/./g" ,base-uri)
+ ("/../g" "http://a/../g" ,base-uri)
+ ("g." "http://a/b/c/g." ,base-uri)
+ (".g" "http://a/b/c/.g" ,base-uri)
+ ("g.." "http://a/b/c/g.." ,base-uri)
+ ("..g" "http://a/b/c/..g" ,base-uri)
+ ("./../g" "http://a/b/g" ,base-uri)
+ ("./g/." "http://a/b/c/g/" ,base-uri)
+ ("g/./h" "http://a/b/c/g/h" ,base-uri)
+ ("g/../h" "http://a/b/c/h" ,base-uri)
+ ("g;x=1/./y" "http://a/b/c/g;x=1/y" ,base-uri)
+ ("g;x=1/../y" "http://a/b/c/y" ,base-uri)
+ ("g?y/./x" "http://a/b/c/g?y/./x" ,base-uri)
+ ("g?y/../x" "http://a/b/c/g?y/../x" ,base-uri)
+ ("g#s/./x" "http://a/b/c/g#s/./x" ,base-uri)
+ ("g#s/../x" "http://a/b/c/g#s/../x" ,base-uri)
+ ("http:g" "http:g" ,base-uri)
- ("foo/bar/baz.htm#foo"
- "http://a/b/foo/bar/baz.htm#foo"
- "http://a/b/c.htm")
- ("foo/bar/baz.htm#foo"
- "http://a/b/foo/bar/baz.htm#foo"
- "http://a/b/")
- ("foo/bar/baz.htm#foo"
- "http://a/foo/bar/baz.htm#foo"
- "http://a/b")
- ("foo/bar;x;y/bam.htm"
- "http://a/b/c/foo/bar;x;y/bam.htm"
- "http://a/b/c/")))
- (push `(util.test:test (intern-uri ,(second x))
- (intern-uri (merge-uris (intern-uri ,(first x))
- (intern-uri ,(third x))))
- :test 'uri=)
- res))
+ ("foo/bar/baz.htm#foo"
+ "http://a/b/foo/bar/baz.htm#foo"
+ "http://a/b/c.htm")
+ ("foo/bar/baz.htm#foo"
+ "http://a/b/foo/bar/baz.htm#foo"
+ "http://a/b/")
+ ("foo/bar/baz.htm#foo"
+ "http://a/foo/bar/baz.htm#foo"
+ "http://a/b")
+ ("foo/bar;x;y/bam.htm"
+ "http://a/b/c/foo/bar;x;y/bam.htm"
+ "http://a/b/c/")))
+ (push `(test (intern-uri ,(second x))
+ (intern-uri (merge-uris (intern-uri ,(first x))
+ (intern-uri ,(third x))))
+ :test 'uri=)
+ res))
;;;; intern tests
(dolist (x '(;; default port and specifying the default port are
- ;; supposed to compare the same:
- ("http://www.franz.com:80" "http://www.franz.com")
- ("http://www.franz.com:80" "http://www.franz.com" eq)
- ;; make sure they're `eq':
- ("http://www.franz.com:80" "http://www.franz.com" eq)
- ("http://www.franz.com" "http://www.franz.com" eq)
- ("http://www.franz.com/foo" "http://www.franz.com/foo" eq)
- ("http://www.franz.com/foo?bar"
- "http://www.franz.com/foo?bar" eq)
- ("http://www.franz.com/foo?bar#baz"
- "http://www.franz.com/foo?bar#baz" eq)
- ("http://WWW.FRANZ.COM" "http://www.franz.com" eq)
- ("http://www.FRANZ.com" "http://www.franz.com" eq)
- ("http://www.franz.com" "http://www.franz.com/" eq)
- (;; %72 is "r", %2f is "/", %3b is ";"
- "http://www.franz.com/ba%72%2f%3b;x;y;z/baz/"
- "http://www.franz.com/bar%2f%3b;x;y;z/baz/" eq)))
- (push `(util.test:test (intern-uri ,(second x))
- (intern-uri ,(first x))
- :test ',(if (third x)
- (third x)
- 'uri=))
- res))
+ ;; supposed to compare the same:
+ ("http://www.franz.com:80" "http://www.franz.com")
+ ("http://www.franz.com:80" "http://www.franz.com" eq)
+ ;; make sure they're `eq':
+ ("http://www.franz.com:80" "http://www.franz.com" eq)
+ ("http://www.franz.com" "http://www.franz.com" eq)
+ ("http://www.franz.com/foo" "http://www.franz.com/foo" eq)
+ ("http://www.franz.com/foo?bar"
+ "http://www.franz.com/foo?bar" eq)
+ ("http://www.franz.com/foo?bar#baz"
+ "http://www.franz.com/foo?bar#baz" eq)
+ ("http://WWW.FRANZ.COM" "http://www.franz.com" eq)
+ ("http://www.FRANZ.com" "http://www.franz.com" eq)
+ ("http://www.franz.com" "http://www.franz.com/" eq)
+ (;; %72 is "r", %2f is "/", %3b is ";"
+ "http://www.franz.com/ba%72%2f%3b;x;y;z/baz/"
+ "http://www.franz.com/bar%2f%3b;x;y;z/baz/" eq)))
+ (push `(test (intern-uri ,(second x))
+ (intern-uri ,(first x))
+ :test ',(if (third x)
+ (third x)
+ 'uri=))
+ res))
;;;; parsing and equivalence tests
- (push `(util.test:test
- (parse-uri "http://foo+bar?baz=b%26lob+bof")
- (parse-uri (parse-uri "http://foo+bar?baz=b%26lob+bof"))
- :test 'uri=)
- res)
- (push '(util.test:test
- (parse-uri "http://www.foo.com")
- (parse-uri (parse-uri "http://www.foo.com?")) ; allow ? at end
- :test 'uri=)
- res)
- (push `(util.test:test
- "baz=b%26lob+bof"
- (uri-query (parse-uri "http://foo+bar?baz=b%26lob+bof"))
- :test 'string=)
- res)
- (push `(util.test:test
- "baz=b%26lob+bof%3d"
- (uri-query (parse-uri "http://foo+bar?baz=b%26lob+bof%3d"))
- :test 'string=)
- res)
+ (push `(test
+ (parse-uri "http://foo+bar?baz=b%26lob+bof")
+ (parse-uri (parse-uri "http://foo+bar?baz=b%26lob+bof"))
+ :test 'uri=)
+ res)
+ (push '(test
+ (parse-uri "http://www.foo.com")
+ (parse-uri (parse-uri "http://www.foo.com?")) ; allow ? at end
+ :test 'uri=)
+ res)
+ (push `(test
+ "baz=b%26lob+bof"
+ (uri-query (parse-uri "http://foo+bar?baz=b%26lob+bof"))
+ :test 'string=)
+ res)
+ (push `(test
+ "baz=b%26lob+bof%3d"
+ (uri-query (parse-uri "http://foo+bar?baz=b%26lob+bof%3d"))
+ :test 'string=)
+ res)
(push
- `(util.test:test (parse-uri "xxx?%41") (parse-uri "xxx?A") :test 'uri=)
+ `(test (parse-uri "xxx?%41") (parse-uri "xxx?A") :test 'uri=)
res)
(push
- `(util.test:test "A" (uri-query (parse-uri "xxx?%41")) :test 'string=)
+ `(test "A" (uri-query (parse-uri "xxx?%41")) :test 'string=)
res)
- (push `(util.test:test-error (parse-uri " ")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test-error (parse-uri "foo ")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test-error (parse-uri " foo ")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test-error (parse-uri "<foo")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test-error (parse-uri "foo>")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test-error (parse-uri "<foo>")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test-error (parse-uri "%")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test-error (parse-uri "foo%xyr")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test-error (parse-uri "\"foo\"")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test "%20" (format nil "~a" (parse-uri "%20"))
- :test 'string=)
- res)
- (push `(util.test:test "&" (format nil "~a" (parse-uri "%26"))
- :test 'string=)
- res)
+ (push `(test-error (parse-uri " ")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "foo ")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri " foo ")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "<foo")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "foo>")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "<foo>")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "%")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "foo%xyr")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "\"foo\"")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test "%20" (format nil "~a" (parse-uri "%20"))
+ :test 'string=)
+ res)
+ (push `(test "&" (format nil "~a" (parse-uri "%26"))
+ :test 'string=)
+ res)
(push
- `(util.test:test "foo%23bar" (format nil "~a" (parse-uri "foo%23bar"))
- :test 'string=)
+ `(test "foo%23bar" (format nil "~a" (parse-uri "foo%23bar"))
+ :test 'string=)
res)
(push
- `(util.test:test "foo%23bar#foobar"
- (format nil "~a" (parse-uri "foo%23bar#foobar"))
- :test 'string=)
+ `(test "foo%23bar#foobar"
+ (format nil "~a" (parse-uri "foo%23bar#foobar"))
+ :test 'string=)
res)
(push
- `(util.test:test "foo%23bar#foobar#baz"
- (format nil "~a" (parse-uri "foo%23bar#foobar#baz"))
- :test 'string=)
+ `(test "foo%23bar#foobar#baz"
+ (format nil "~a" (parse-uri "foo%23bar#foobar#baz"))
+ :test 'string=)
res)
(push
- `(util.test:test "foo%23bar#foobar#baz"
- (format nil "~a" (parse-uri "foo%23bar#foobar%23baz"))
- :test 'string=)
+ `(test "foo%23bar#foobar#baz"
+ (format nil "~a" (parse-uri "foo%23bar#foobar%23baz"))
+ :test 'string=)
res)
(push
- `(util.test:test "foo%23bar#foobar/baz"
- (format nil "~a" (parse-uri "foo%23bar#foobar%2fbaz"))
- :test 'string=)
+ `(test "foo%23bar#foobar/baz"
+ (format nil "~a" (parse-uri "foo%23bar#foobar%2fbaz"))
+ :test 'string=)
res)
- (push `(util.test:test-error (parse-uri "foobar??")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test-error (parse-uri "foobar?foo?")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test "foobar?%3f"
- (format nil "~a" (parse-uri "foobar?%3f"))
- :test 'string=)
- res)
- (push `(util.test:test
- "http://foo/bAr;3/baz?baf=3"
- (format nil "~a" (parse-uri "http://foo/b%41r;3/baz?baf=3"))
- :test 'string=)
- res)
- (push `(util.test:test
- '(:absolute ("/bAr" "3") "baz")
- (uri-parsed-path (parse-uri "http://foo/%2fb%41r;3/baz?baf=3"))
- :test 'equal)
- res)
- (push `(util.test:test
- "/%2fbAr;3/baz"
- (let ((u (parse-uri "http://foo/%2fb%41r;3/baz?baf=3")))
- (setf (uri-parsed-path u) '(:absolute ("/bAr" "3") "baz"))
- (uri-path u))
- :test 'string=)
- res)
- (push `(util.test:test
- "http://www.verada.com:8010/kapow?name=foo%3Dbar%25"
- (format nil "~a"
- (parse-uri
- "http://www.verada.com:8010/kapow?name=foo%3Dbar%25"))
- :test 'string=)
- res)
- (push `(util.test:test
- "ftp://parcftp.xerox.com/pub/pcl/mop/"
- (format nil "~a"
- (parse-uri "ftp://parcftp.xerox.com:/pub/pcl/mop/"))
- :test 'string=)
- res)
+ (push `(test-error (parse-uri "foobar??")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "foobar?foo?")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test "foobar?%3f"
+ (format nil "~a" (parse-uri "foobar?%3f"))
+ :test 'string=)
+ res)
+ (push `(test
+ "http://foo/bAr;3/baz?baf=3"
+ (format nil "~a" (parse-uri "http://foo/b%41r;3/baz?baf=3"))
+ :test 'string=)
+ res)
+ (push `(test
+ '(:absolute ("/bAr" "3") "baz")
+ (uri-parsed-path (parse-uri "http://foo/%2fb%41r;3/baz?baf=3"))
+ :test 'equal)
+ res)
+ (push `(test
+ "/%2fbAr;3/baz"
+ (let ((u (parse-uri "http://foo/%2fb%41r;3/baz?baf=3")))
+ (setf (uri-parsed-path u) '(:absolute ("/bAr" "3") "baz"))
+ (uri-path u))
+ :test 'string=)
+ res)
+ (push `(test
+ "http://www.verada.com:8010/kapow?name=foo%3Dbar%25"
+ (format nil "~a"
+ (parse-uri
+ "http://www.verada.com:8010/kapow?name=foo%3Dbar%25"))
+ :test 'string=)
+ res)
+ (push `(test
+ "ftp://parcftp.xerox.com/pub/pcl/mop/"
+ (format nil "~a"
+ (parse-uri "ftp://parcftp.xerox.com:/pub/pcl/mop/"))
+ :test 'string=)
+ res)
;;;; enough-uri tests
(dolist (x `(("http://www.franz.com/foo/bar/baz.htm"
- "http://www.franz.com/foo/bar/"
- "baz.htm")
- ("http://www.franz.com/foo/bar/baz.htm"
- "http://www.franz.com/foo/bar"
- "baz.htm")
- ("http://www.franz.com:80/foo/bar/baz.htm"
- "http://www.franz.com:80/foo/bar"
- "baz.htm")
- ("http:/foo/bar/baz.htm" "http:/foo/bar" "baz.htm")
- ("http:/foo/bar/baz.htm" "http:/foo/bar/" "baz.htm")
- ("/foo/bar/baz.htm" "/foo/bar" "baz.htm")
- ("/foo/bar/baz.htm" "/foo/bar/" "baz.htm")
- ("/foo/bar/baz.htm#foo" "/foo/bar/" "baz.htm#foo")
- ("/foo/bar/baz.htm?bar#foo" "/foo/bar/" "baz.htm?bar#foo")
-
- ("http://www.dnai.com/~layer/foo.htm"
- "http://www.known.net"
- "http://www.dnai.com/~layer/foo.htm")
- ("http://www.dnai.com/~layer/foo.htm"
- "http://www.dnai.com:8000/~layer/"
- "http://www.dnai.com/~layer/foo.htm")
- ("http://www.dnai.com:8000/~layer/foo.htm"
- "http://www.dnai.com/~layer/"
- "http://www.dnai.com:8000/~layer/foo.htm")
- ("http://www.franz.com"
- "http://www.franz.com"
- "/")))
- (push `(util.test:test (parse-uri ,(third x))
- (enough-uri (parse-uri ,(first x))
- (parse-uri ,(second x)))
- :test 'uri=)
- res))
-
+ "http://www.franz.com/foo/bar/"
+ "baz.htm")
+ ("http://www.franz.com/foo/bar/baz.htm"
+ "http://www.franz.com/foo/bar"
+ "baz.htm")
+ ("http://www.franz.com:80/foo/bar/baz.htm"
+ "http://www.franz.com:80/foo/bar"
+ "baz.htm")
+ ("http:/foo/bar/baz.htm" "http:/foo/bar" "baz.htm")
+ ("http:/foo/bar/baz.htm" "http:/foo/bar/" "baz.htm")
+ ("/foo/bar/baz.htm" "/foo/bar" "baz.htm")
+ ("/foo/bar/baz.htm" "/foo/bar/" "baz.htm")
+ ("/foo/bar/baz.htm#foo" "/foo/bar/" "baz.htm#foo")
+ ("/foo/bar/baz.htm?bar#foo" "/foo/bar/" "baz.htm?bar#foo")
+
+ ("http://www.dnai.com/~layer/foo.htm"
+ "http://www.known.net"
+ "http://www.dnai.com/~layer/foo.htm")
+ ("http://www.dnai.com/~layer/foo.htm"
+ "http://www.dnai.com:8000/~layer/"
+ "http://www.dnai.com/~layer/foo.htm")
+ ("http://www.dnai.com:8000/~layer/foo.htm"
+ "http://www.dnai.com/~layer/"
+ "http://www.dnai.com:8000/~layer/foo.htm")
+ ("http://www.franz.com"
+ "http://www.franz.com"
+ "/")))
+ (push `(test (parse-uri ,(third x))
+ (enough-uri (parse-uri ,(first x))
+ (parse-uri ,(second x)))
+ :test 'uri=)
+ res))
+
;;;; urn tests, ideas of which are from rfc2141
(let ((urn "urn:com:foo-the-bar"))
- (push `(util.test:test "com" (urn-nid (parse-uri ,urn))
- :test #'string=)
- res)
- (push `(util.test:test "foo-the-bar" (urn-nss (parse-uri ,urn))
- :test #'string=)
- res))
- (push `(util.test:test-error (parse-uri "urn:")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test-error (parse-uri "urn:foo")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test-error (parse-uri "urn:foo$")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test-error (parse-uri "urn:foo_")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test-error (parse-uri "urn:foo:foo&bar")
- :condition-type 'parse-error)
- res)
- (push `(util.test:test (parse-uri "URN:foo:a123,456")
- (parse-uri "urn:foo:a123,456")
- :test #'uri=)
- res)
- (push `(util.test:test (parse-uri "URN:foo:a123,456")
- (parse-uri "urn:FOO:a123,456")
- :test #'uri=)
- res)
- (push `(util.test:test (parse-uri "urn:foo:a123,456")
- (parse-uri "urn:FOO:a123,456")
- :test #'uri=)
- res)
- (push `(util.test:test (parse-uri "URN:FOO:a123%2c456")
- (parse-uri "urn:foo:a123%2C456")
- :test #'uri=)
- res)
- (push `(util.test:test
- nil
- (uri= (parse-uri "urn:foo:A123,456")
- (parse-uri "urn:FOO:a123,456")))
- res)
- (push `(util.test:test
- nil
- (uri= (parse-uri "urn:foo:A123,456")
- (parse-uri "urn:foo:a123,456")))
- res)
- (push `(util.test:test
- nil
- (uri= (parse-uri "urn:foo:A123,456")
- (parse-uri "URN:foo:a123,456")))
- res)
- (push `(util.test:test
- nil
- (uri= (parse-uri "urn:foo:a123%2C456")
- (parse-uri "urn:FOO:a123,456")))
- res)
- (push `(util.test:test
- nil
- (uri= (parse-uri "urn:foo:a123%2C456")
- (parse-uri "urn:foo:a123,456")))
- res)
- (push `(util.test:test
- nil
- (uri= (parse-uri "URN:FOO:a123%2c456")
- (parse-uri "urn:foo:a123,456")))
- res)
- (push `(util.test:test
- nil
- (uri= (parse-uri "urn:FOO:a123%2c456")
- (parse-uri "urn:foo:a123,456")))
- res)
- (push `(util.test:test
- nil
- (uri= (parse-uri "urn:foo:a123%2c456")
- (parse-uri "urn:foo:a123,456")))
- res)
-
- (push `(util.test:test t
- (uri= (parse-uri "foo") (parse-uri "foo#")))
- res)
-
+ (push `(test "com" (urn-nid (parse-uri ,urn))
+ :test #'string=)
+ res)
+ (push `(test "foo-the-bar" (urn-nss (parse-uri ,urn))
+ :test #'string=)
+ res))
+ (push `(test-error (parse-uri "urn:")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "urn:foo")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "urn:foo$")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "urn:foo_")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test-error (parse-uri "urn:foo:foo&bar")
+ :condition-type 'uri-parse-error)
+ res)
+ (push `(test (parse-uri "URN:foo:a123,456")
+ (parse-uri "urn:foo:a123,456")
+ :test #'uri=)
+ res)
+ (push `(test (parse-uri "URN:foo:a123,456")
+ (parse-uri "urn:FOO:a123,456")
+ :test #'uri=)
+ res)
+ (push `(test (parse-uri "urn:foo:a123,456")
+ (parse-uri "urn:FOO:a123,456")
+ :test #'uri=)
+ res)
+ (push `(test (parse-uri "URN:FOO:a123%2c456")
+ (parse-uri "urn:foo:a123%2C456")
+ :test #'uri=)
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "urn:foo:A123,456")
+ (parse-uri "urn:FOO:a123,456")))
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "urn:foo:A123,456")
+ (parse-uri "urn:foo:a123,456")))
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "urn:foo:A123,456")
+ (parse-uri "URN:foo:a123,456")))
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "urn:foo:a123%2C456")
+ (parse-uri "urn:FOO:a123,456")))
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "urn:foo:a123%2C456")
+ (parse-uri "urn:foo:a123,456")))
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "URN:FOO:a123%2c456")
+ (parse-uri "urn:foo:a123,456")))
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "urn:FOO:a123%2c456")
+ (parse-uri "urn:foo:a123,456")))
+ res)
+ (push `(test
+ nil
+ (uri= (parse-uri "urn:foo:a123%2c456")
+ (parse-uri "urn:foo:a123,456")))
+ res)
+
+ (push `(test t
+ (uri= (parse-uri "foo") (parse-uri "foo#")))
+ res)
+
(push
'(let ((puri::*strict-parse* nil))
- (util.test:test-no-error
- (puri:parse-uri
- "http://foo.com/bar?a=zip|zop")))
+ (test-no-error
+ (puri:parse-uri
+ "http://foo.com/bar?a=zip|zop")))
res)
(push
- '(util.test:test-error
+ '(test-error
(puri:parse-uri "http://foo.com/bar?a=zip|zop")
- :condition-type 'parse-error)
+ :condition-type 'uri-parse-error)
res)
-
+
(push
'(let ((puri::*strict-parse* nil))
- (util.test:test-no-error
- (puri:parse-uri
- "http://arc3.msn.com/ADSAdClient31.dll?GetAd?PG=NBCSBU?SC=D2?AN=1.0586041")))
+ (test-no-error
+ (puri:parse-uri
+ "http://arc3.msn.com/ADSAdClient31.dll?GetAd?PG=NBCSBU?SC=D2?AN=1.0586041")))
res)
(push
- '(util.test:test-error
+ '(test-error
(puri:parse-uri
- "http://arc3.msn.com/ADSAdClient31.dll?GetAd?PG=NBCSBU?SC=D2?AN=1.0586041")
- :condition-type 'parse-error)
+ "http://arc3.msn.com/ADSAdClient31.dll?GetAd?PG=NBCSBU?SC=D2?AN=1.0586041")
+ :condition-type 'uri-parse-error)
res)
-
+
(push
'(let ((puri::*strict-parse* nil))
- (util.test:test-no-error
- (puri:parse-uri
- "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")))
+ (test-no-error
+ (puri:parse-uri
+ "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")))
res)
(push
- '(util.test:test-error
+ '(test-error
(puri:parse-uri
- "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")
- :condition-type 'parse-error)
+ "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")
+ :condition-type 'uri-parse-error)
res)
-
- `(progn ,@(nreverse res)))
- )
+
+ ;;; tests for weird control characters
+ ;; http://www.ietf.org/rfc/rfc2396.txt 2.4.3
+ (dolist (x '("https://example.com/q?foo%0abar%20baz" ;;an escaped newline
+ "https://example.com/q?%7f" ;; 7f, 127
+ ))
+ (push
+ `(let ((weird-uri ,x))
+ (test weird-uri
+ (puri:render-uri (puri:parse-uri weird-uri) nil)
+ :test #'string=)
+ ) res))
+
+ `(progn ,@(nreverse res))))
(defun do-tests ()
- (eval
- `(with-tests (:name "puri")
- ,*tests*))
+ (let ((*break-on-test-failures* t))
+ (with-tests (:name "puri")
+ (gen-test-forms)))
t)