From ccfeb8799cab1bba23f41ab1e18bd6d1700ab731 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sun, 20 Jul 2003 18:56:55 +0000 Subject: [PATCH] r5347: *** empty log message *** --- README | 32 ++++++++-- debian/changelog | 5 +- puri.asd | 2 +- src.lisp | 31 +++++---- tests.lisp | 162 +++++++++++++++++++++++------------------------ 5 files changed, 127 insertions(+), 105 deletions(-) diff --git a/README b/README index f81655c..754cc97 100644 --- a/README +++ b/README @@ -1,8 +1,25 @@ PURI - Portable URI Library +=========================== +AUTHORS +------- Franz, Inc Kevin Rosenberg + +DOWNLOAD +-------- +Puri home: http://files.b9.com/puri/ +Portable tester home: http://files.b9.com/tester/ + + +SUPPORTED PLATFORMS +------------------- + AllegroCL, CLISP, CMUCL, Lispworks, OpenMCL, SBCL + + +OVERVIEW +-------- This is portable Universal Resource Identifier library for Common Lisp programs. It parses URI according to the RFC 2396 specification. It's is based on Franz, Inc's opensource URI package and has been ported to @@ -14,11 +31,16 @@ library. I've ported that library for use on other CL implementations. Puri completes 126/126 regression tests successfully. Franz's unmodified documentation file is included in the file -uri.html. The only divergence in usage between Puri and Franz's -package is that Puri's symbols are located in the package PURI while -Franz's original uses the package NET.URI. +uri.html. -Puri home: http://files.b9.com/puri/ -Portable tester home: http://files.b9.com/tester/ +DIFFERENCES BETWEEN PURI and NET.URI +------------------------------------ + +* Puri uses the package 'puri while NET.URI uses the package 'net.uri +* To signal an error parsing a URI, Puri uses the condition + :uri-parse-error while NET.URI uses the condition :parse-error. This + divergence occurs because Franz's parse-error condition uses + :format-control and :format-arguments slots which are not in the ANSI + specification for the parse-error condition. diff --git a/debian/changelog b/debian/changelog index b8cecda..18c3a94 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,8 +1,9 @@ cl-puri (1.2.6-1) unstable; urgency=low - * Fix .parse-error + * Change parse-error condition to uri-parse-error for + cross-implementation compatibility. - -- + -- Kevin M. Rosenberg Sun, 20 Jul 2003 11:52:03 -0600 cl-puri (1.2.5-1) unstable; urgency=low diff --git a/puri.asd b/puri.asd index 07253f2..af10e80 100644 --- a/puri.asd +++ b/puri.asd @@ -20,7 +20,7 @@ (oos 'test-op 'puri-tests)) (defsystem puri-tests - :depends-on (:puri :tester) + :depends-on (:puri :ptester) :components ((:file "tests"))) diff --git a/src.lisp b/src.lisp index edb8afa..eaf599a 100644 --- a/src.lisp +++ b/src.lisp @@ -22,7 +22,7 @@ ;; Original version from ACL 6.1: ;; uri.cl,v 2.3.6.4.2.1 2001/08/09 17:42:39 layer ;; -;; $Id: src.lisp,v 1.8 2003/07/20 16:25:21 kevin Exp $ +;; $Id: src.lisp,v 1.9 2003/07/20 18:51:48 kevin Exp $ (defpackage #:puri (:use #:cl) @@ -55,13 +55,14 @@ #:uri= #:intern-uri #:unintern-uri - #:do-all-uris)) + #:do-all-uris -(in-package #:puri) + #:uri-parse-error ;; Added by KMR + )) -(eval-when (:compile-toplevel) - (declaim (optimize (speed 3)))) +(in-package #:puri) +(eval-when (:compile-toplevel) (declaim (optimize (speed 3)))) #-allegro @@ -97,19 +98,18 @@ (subseq str 0 size)) -#-(or allegro lispworks) -(define-condition parse-error (error) - ((fmt-control :initarg :fmt-control - :reader fmt-control) - (fmt-args :initarg :fmt-args - :reader fmt-args)) +;; KMR: Added new condition to handle cross-implementation variances +;; in the parse-error condition many implementations define + +(define-condition uri-parse-error (parse-error) + ((fmt-control :initarg :fmt-control :accessor fmt-control) + (fmt-arguments :initarg :fmt-arguments :accessor fmt-arguments )) (:report (lambda (c stream) - (format stream "Parse error: ") - (apply #'format stream (fmt-control c) (fmt-args c))))) + (format stream "Parse error:") + (apply #'format stream (fmt-control c) (fmt-arguments c))))) -#-allegro (defun .parse-error (fmt &rest args) - (error (make-condition 'parse-error :fmt-control fmt :fmt-args args))) + (error 'uri-parse-error :fmt-control fmt :fmt-arguments args)) #-allegro (defun internal-reader-error (stream fmt &rest args) @@ -119,7 +119,6 @@ #+allegro (eval-when (:compile-toplevel :load-toplevel :execute) (import '(excl:*current-case-mode* excl:delimited-string-to-list - excl::.parse-error excl::parse-body excl::internal-reader-error excl:if*))) diff --git a/tests.lisp b/tests.lisp index eb16a1b..a8a1b6c 100644 --- a/tests.lisp +++ b/tests.lisp @@ -20,10 +20,10 @@ ;; 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.4 2003/07/18 23:33:53 kevin Exp $ +;; $Id: tests.lisp,v 1.5 2003/07/20 18:51:48 kevin Exp $ -(defpackage #:puri-tests (:use #:puri #:cl #:util.test)) +(defpackage #:puri-tests (:use #:puri #:cl #:ptester)) (in-package #:puri-tests) (unintern-uri t) @@ -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,130 +285,130 @@ ;;;; 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)))) (defun do-tests () - (let ((util.test:*break-on-test-failures* t)) + (let ((*break-on-test-failures* t)) (with-tests (:name "puri") (gen-test-forms))) t) -- 2.34.1