r5347: *** empty log message ***

diff --git a/README b/README
index f81655c8ab70c6f8ed145bb7e18ec70a78983281..754cc9760ade50b1ac710e0012ab7d613d8b50f5 100644 (file)
--- a/README
+++ b/README
@@ -1,8 +1,25 @@
 PURI - Portable URI Library
+===========================
 
+AUTHORS
+-------
 Franz, Inc <http://www.franz.com>
 Kevin Rosenberg <kevin@rosenberg.net>
 
+
+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 b8cecda7c2844dff2d9e31dfb7531907b8b1e73f..18c3a9493909d1ecc46a59b3b781dac11671f34d 100644 (file)
--- 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 <kmr@debian.org>  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 07253f201fd390a850a371dd677f7c02aa02f8d4..af10e80103474342a4cb71e4f35ac71c2a24e4f5 100644 (file)
--- 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 edb8afa5d8ef99b67eed37f8ac13283f9ca184ea..eaf599a8b4953bacdb77b290f2cc26f1a33765f5 100644 (file)
--- 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 eb16a1b11a74aaa9209e0d24a8f52242f097cd0a..a8a1b6c3d25e25d414fe25a2750b027409fe4f18 100644 (file)
--- 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 "<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 "<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 "%")
+                                :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)