X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests.lisp;h=887a323878be0daf2e2e9fcbfec430c47ab719d1;hb=ec30187f4bc868be2b54ce0a0b911504bb3e27d9;hp=8696767ff9c6e0d65a8363682829f8b2ad335cef;hpb=583a97172bb9211d20bc6f9d6266c3f6b37a304f;p=puri.git diff --git a/tests.lisp b/tests.lisp index 8696767..887a323 100644 --- a/tests.lisp +++ b/tests.lisp @@ -20,15 +20,15 @@ ;; 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")) @@ -90,7 +90,7 @@ ("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)) + (push `(test (intern-uri ,(second x)) (intern-uri (merge-uris (intern-uri ,(first x)) (intern-uri ,(third x)))) :test 'uri=) @@ -115,7 +115,7 @@ (;; %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)) + (push `(test (intern-uri ,(second x)) (intern-uri ,(first x)) :test ',(if (third x) (third x) @@ -123,125 +123,125 @@ res)) ;;;; parsing and equivalence tests - (push `(util.test:test + (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 '(util.test:test + (push '(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 + (push `(test "baz=b%26lob+bof" (uri-query (parse-uri "http://foo+bar?baz=b%26lob+bof")) :test 'string=) res) - (push `(util.test:test + (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) + (push `(test-error (parse-uri " ") + :condition-type 'uri-parse-error) res) - (push `(util.test:test-error (parse-uri "foo ") - :condition-type 'parse-error) + (push `(test-error (parse-uri "foo ") + :condition-type 'uri-parse-error) res) - (push `(util.test:test-error (parse-uri " foo ") - :condition-type 'parse-error) + (push `(test-error (parse-uri " foo ") + :condition-type 'uri-parse-error) res) - (push `(util.test:test-error (parse-uri "") - :condition-type 'parse-error) + (push `(test-error (parse-uri "foo>") + :condition-type 'uri-parse-error) res) - (push `(util.test:test-error (parse-uri "") - :condition-type 'parse-error) + (push `(test-error (parse-uri "") + :condition-type 'uri-parse-error) res) - (push `(util.test:test-error (parse-uri "%") - :condition-type 'parse-error) + (push `(test-error (parse-uri "%") + :condition-type 'uri-parse-error) res) - (push `(util.test:test-error (parse-uri "foo%xyr") - :condition-type 'parse-error) + (push `(test-error (parse-uri "foo%xyr") + :condition-type 'uri-parse-error) res) - (push `(util.test:test-error (parse-uri "\"foo\"") - :condition-type 'parse-error) + (push `(test-error (parse-uri "\"foo\"") + :condition-type 'uri-parse-error) res) - (push `(util.test:test "%20" (format nil "~a" (parse-uri "%20")) + (push `(test "%20" (format nil "~a" (parse-uri "%20")) :test 'string=) res) - (push `(util.test:test "&" (format nil "~a" (parse-uri "%26")) + (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 "foo%23bar" (format nil "~a" (parse-uri "foo%23bar")) :test 'string=) res) (push - `(util.test:test "foo%23bar#foobar" + `(test "foo%23bar#foobar" (format nil "~a" (parse-uri "foo%23bar#foobar")) :test 'string=) res) (push - `(util.test:test "foo%23bar#foobar#baz" + `(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" + `(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" + `(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) + (push `(test-error (parse-uri "foobar??") + :condition-type 'uri-parse-error) res) - (push `(util.test:test-error (parse-uri "foobar?foo?") - :condition-type 'parse-error) + (push `(test-error (parse-uri "foobar?foo?") + :condition-type 'uri-parse-error) res) - (push `(util.test:test "foobar?%3f" + (push `(test "foobar?%3f" (format nil "~a" (parse-uri "foobar?%3f")) :test 'string=) res) - (push `(util.test:test + (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 `(util.test:test + (push `(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 + (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 `(util.test:test + (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 `(util.test:test + (push `(test "ftp://parcftp.xerox.com/pub/pcl/mop/" (format nil "~a" (parse-uri "ftp://parcftp.xerox.com:/pub/pcl/mop/")) @@ -277,7 +277,7 @@ ("http://www.franz.com" "http://www.franz.com" "/"))) - (push `(util.test:test (parse-uri ,(third x)) + (push `(test (parse-uri ,(third x)) (enough-uri (parse-uri ,(first x)) (parse-uri ,(second x))) :test 'uri=) @@ -285,133 +285,132 @@ ;;;; 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)) + (push `(test "com" (urn-nid (parse-uri ,urn)) :test #'string=) res) - (push `(util.test:test "foo-the-bar" (urn-nss (parse-uri ,urn)) + (push `(test "foo-the-bar" (urn-nss (parse-uri ,urn)) :test #'string=) res)) - (push `(util.test:test-error (parse-uri "urn:") - :condition-type 'parse-error) + (push `(test-error (parse-uri "urn:") + :condition-type 'uri-parse-error) res) - (push `(util.test:test-error (parse-uri "urn:foo") - :condition-type 'parse-error) + (push `(test-error (parse-uri "urn:foo") + :condition-type 'uri-parse-error) res) - (push `(util.test:test-error (parse-uri "urn:foo$") - :condition-type 'parse-error) + (push `(test-error (parse-uri "urn:foo$") + :condition-type 'uri-parse-error) res) - (push `(util.test:test-error (parse-uri "urn:foo_") - :condition-type 'parse-error) + (push `(test-error (parse-uri "urn:foo_") + :condition-type 'uri-parse-error) res) - (push `(util.test:test-error (parse-uri "urn:foo:foo&bar") - :condition-type 'parse-error) + (push `(test-error (parse-uri "urn:foo:foo&bar") + :condition-type 'uri-parse-error) res) - (push `(util.test:test (parse-uri "URN:foo:a123,456") + (push `(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") + (push `(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") + (push `(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") + (push `(test (parse-uri "URN:FOO:a123%2c456") (parse-uri "urn:foo:a123%2C456") :test #'uri=) res) - (push `(util.test:test + (push `(test nil (uri= (parse-uri "urn:foo:A123,456") (parse-uri "urn:FOO:a123,456"))) res) - (push `(util.test:test + (push `(test nil (uri= (parse-uri "urn:foo:A123,456") (parse-uri "urn:foo:a123,456"))) res) - (push `(util.test:test + (push `(test nil (uri= (parse-uri "urn:foo:A123,456") (parse-uri "URN:foo:a123,456"))) res) - (push `(util.test:test + (push `(test nil (uri= (parse-uri "urn:foo:a123%2C456") (parse-uri "urn:FOO:a123,456"))) res) - (push `(util.test:test + (push `(test nil (uri= (parse-uri "urn:foo:a123%2C456") (parse-uri "urn:foo:a123,456"))) res) - (push `(util.test:test + (push `(test nil (uri= (parse-uri "URN:FOO:a123%2c456") (parse-uri "urn:foo:a123,456"))) res) - (push `(util.test:test + (push `(test nil (uri= (parse-uri "urn:FOO:a123%2c456") (parse-uri "urn:foo:a123,456"))) res) - (push `(util.test:test + (push `(test nil (uri= (parse-uri "urn:foo:a123%2c456") (parse-uri "urn:foo:a123,456"))) res) - (push `(util.test:test t + (push `(test t (uri= (parse-uri "foo") (parse-uri "foo#"))) res) (push '(let ((puri::*strict-parse* nil)) - (util.test:test-no-error + (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 + (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) + :condition-type 'uri-parse-error) res) (push '(let ((puri::*strict-parse* nil)) - (util.test:test-no-error + (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) + :condition-type 'uri-parse-error) res) - `(progn ,@(nreverse 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)