r5347: *** empty log message ***

diff --git a/README b/README
index f81655c..754cc97 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 b8cecda..18c3a94 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 07253f2..af10e80 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 edb8afa..eaf599a 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 eb16a1b..a8a1b6c 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)