  -*- Mode : LISP ; Syntax : ANSI - Common - Lisp ; Base : 10 -*-
  copyright ( c ) 1999 - 2001 Franz Inc , Berkeley , CA   - All rights reserved .
  copyright ( c ) 2003   ( significant fixes for using
;; tester package)
;;
;; The software, data and information contained herein are proprietary
  to , and comprise valuable trade secrets of , Franz , Inc.   They are
  given in confidence by Franz , Inc. pursuant to a written license
;; agreement, and may be stored and used only in accordance with the terms
;; of such license.
;;
;; Restricted Rights Legend
;; ------------------------
;; Use, duplication, and disclosure of the software, data and information
  contained herein by any agency , department or entity of the U.S.
  Government are subject to restrictions of Restricted Rights for
  Commercial Software developed at private expense as specified in
  DOD FAR Supplement 52.227 - 7013 ( c ) ( 1 ) ( ii ) , as applicable .
;;
  Original version from ACL 6.1 :
  t - uri.cl , v 1.3.6.3.2.1 2001/08/09 17:42:43 layer
;;
  $ Id$


(defpackage #:puri-tests (:use #:puri #:cl #:ptester))
(in-package #:puri-tests)

(unintern-uri t)

(defmacro gen-test-forms ()
  (let ((res '())
        (base-uri ";p?q"))

    (dolist (x `(;; (relative-uri result base-uri compare-function)
;;;; RFC Appendix C.1 (normal examples)
                 ("g:h" "g:h" ,base-uri)
                 ("g" "" ,base-uri)
                 ("./g" "" ,base-uri)
                 ("g/" "/" ,base-uri)
                 ("/g" "" ,base-uri)
                 ("//g" "" ,base-uri)
                 ;; Following was changed from appendix C of RFC 2396
                 ;; /~fielding/uri/rev-2002/issues.html#003-relative-query
                 #-ignore ("?y" ";p?y" ,base-uri)
                 #+ignore ("?y" "" ,base-uri)
                 ("g?y" "" ,base-uri)
                 ("#s" ";p?q#s" ,base-uri)
                 ("g#s" "#s" ,base-uri)
                 ("g?y#s" "#s" ,base-uri)
                 (";x" "/;x" ,base-uri)
                 ("g;x" ";x" ,base-uri)
                 ("g;x?y#s" ";x?y#s" ,base-uri)
                 ("." "/" ,base-uri)
                 ("./" "/" ,base-uri)
                 (".." "/" ,base-uri)
                 ("../" "/" ,base-uri)
                 ("../g" "" ,base-uri)
                 ("../.." "/" ,base-uri)
                 ("../../" "/" ,base-uri)
                 ("../../g" "" ,base-uri)
;;;; RFC Appendix C.2 (abnormal examples)
                 ("" ";p?q" ,base-uri)
                 ("../../../g" "" ,base-uri)
                 ("../../../../g" "" ,base-uri)
                 ("/./g" "" ,base-uri)
                 ("/../g" "" ,base-uri)
                 ("g." "." ,base-uri)
                 (".g" "" ,base-uri)
                 ("g.." ".." ,base-uri)
                 ("..g" "" ,base-uri)
                 ("./../g" "" ,base-uri)
                 ("./g/." "/" ,base-uri)
                 ("g/./h" "" ,base-uri)
                 ("g/../h" "" ,base-uri)
                 ("g;x=1/./y" ";x=1/y" ,base-uri)
                 ("g;x=1/../y" "" ,base-uri)
                 ("g?y/./x" "" ,base-uri)
                 ("g?y/../x" "" ,base-uri)
                 ("g#s/./x" "#s/./x" ,base-uri)
                 ("g#s/../x" "#s/../x" ,base-uri)
                 ("http:g" "http:g" ,base-uri)

                 ("foo/bar/baz.htm#foo"
                  "#foo"
                  "")
                 ("foo/bar/baz.htm#foo"
                  "#foo"
                  "/")
                 ("foo/bar/baz.htm#foo"
                  "#foo"
                  "")
                 ("foo/bar;x;y/bam.htm"
                  ";x;y/bam.htm"
                  "/")))
      (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:
                 (":80" "")
                 (":80" "" eq)
                 ;; make sure they're `eq':
                 (":80" "" eq)
                 ("" "" eq)
                 ("" "" eq)
                 (""
                  "" eq)
                 ("#baz"
                  "#baz" eq)
                 ("" "" eq)
                 ("" "" eq)
                 ("" "/" eq)
  % 72 is " r " , % 2f is " / " , % 3b is " ; "
                  ";x;y;z/baz/"
                  ";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 `(test
            (parse-uri "+bar?baz=b%26lob+bof")
            (parse-uri (parse-uri "+bar?baz=b%26lob+bof"))
            :test 'uri=)
          res)
    (push '(test
            (parse-uri "")
            (parse-uri (parse-uri "?")) ; allow ? at end
            :test 'uri=)
          res)
    (push `(test
            "baz=b%26lob+bof"
            (uri-query (parse-uri "+bar?baz=b%26lob+bof"))
            :test 'string=)
          res)
    (push `(test
            "baz=b%26lob+bof%3d"
            (uri-query (parse-uri "+bar?baz=b%26lob+bof%3d"))
            :test 'string=)
          res)
    (push
     `(test (parse-uri "xxx?%41") (parse-uri "xxx?A") :test 'uri=)
     res)
    (push
     `(test "A" (uri-query (parse-uri "xxx?%41")) :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
     `(test "foo%23bar" (format nil "~a" (parse-uri "foo%23bar"))
                      :test 'string=)
     res)
    (push
     `(test "foo%23bar#foobar"
                      (format nil "~a" (parse-uri "foo%23bar#foobar"))
                      :test 'string=)
     res)
    (push
     `(test "foo%23bar#foobar#baz"
                      (format nil "~a" (parse-uri "foo%23bar#foobar#baz"))
                      :test 'string=)
     res)
    (push
     `(test "foo%23bar#foobar#baz"
                      (format nil "~a" (parse-uri "foo%23bar#foobar%23baz"))
                      :test 'string=)
     res)
    (push
     `(test "foo%23bar#foobar/baz"
                      (format nil "~a" (parse-uri "foo%23bar#foobar%2fbaz"))
                      :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
            ";3/baz?baf=3"
            (format nil "~a" (parse-uri ";3/baz?baf=3"))
            :test 'string=)
          res)
    (push `(test
            '(:absolute ("/bAr" "3") "baz")
            (uri-parsed-path (parse-uri ";3/baz?baf=3"))
            :test 'equal)
          res)
    (push `(test
            "/%2fbAr;3/baz"
            (let ((u (parse-uri ";3/baz?baf=3")))
              (setf (uri-parsed-path u) '(:absolute ("/bAr" "3") "baz"))
              (uri-path u))
            :test 'string=)
          res)
    (push `(test
            ":8010/kapow?name=foo%3Dbar%25"
            (format nil "~a"
                    (parse-uri
                     ":8010/kapow?name=foo%3Dbar%25"))
            :test 'string=)
          res)
    (push `(test
            "ftp/"
            (format nil "~a"
                    (parse-uri "ftp:/pub/pcl/mop/"))
            :test 'string=)
          res)

;;;; enough-uri tests
    (dolist (x `((""
                  "/"
                  "baz.htm")
                 (""
                  ""
                  "baz.htm")
                 (":80/foo/bar/baz.htm"
                  ":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")

                 ("/~layer/foo.htm"
                  ""
                  "/~layer/foo.htm")
                 ("/~layer/foo.htm"
                  ":8000/~layer/"
                  "/~layer/foo.htm")
                 (":8000/~layer/foo.htm"
                  "/~layer/"
                  ":8000/~layer/foo.htm")
                 (""
                  ""
                  "/")))
      (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 `(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))
       (test-no-error
        (puri:parse-uri
         "|zop")))
     res)
    (push
     '(test-error
       (puri:parse-uri "|zop")
       :condition-type 'uri-parse-error)
     res)

    (push
     '(let ((puri::*strict-parse* nil))
       (test-no-error
        (puri:parse-uri
         "")))
     res)
    (push
     '(test-error
       (puri:parse-uri
        "")
       :condition-type 'uri-parse-error)
     res)

    (push
     '(let ((puri::*strict-parse* nil))
       (test-no-error
        (puri:parse-uri
         "-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
     '(test-error
       (puri:parse-uri
        "-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)

    ;;; tests for weird control characters
   2.4.3
    (dolist (x '("" ;;an escaped newline
  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 ()
  (let ((*break-on-test-failures* t))
    (with-tests (:name "puri")
      (gen-test-forms)))
  t)



 Syntax : ANSI - Common - Lisp ; Base : 10 -*-
 tester package)

 The software, data and information contained herein are proprietary
 agreement, and may be stored and used only in accordance with the terms
 of such license.

 Restricted Rights Legend
 ------------------------
 Use, duplication, and disclosure of the software, data and information


 (relative-uri result base-uri compare-function)
 RFC Appendix C.1 (normal examples)
 Following was changed from appendix C of RFC 2396
 /~fielding/uri/rev-2002/issues.html#003-relative-query
 RFC Appendix C.2 (abnormal examples)
 intern tests
 default port and specifying the default port are
 supposed to compare the same:
 make sure they're `eq':
 parsing and equivalence tests
 allow ? at end
 enough-uri tests
 urn tests, ideas of which are from rfc2141
 tests for weird control characters
an escaped newline
  copyright ( c ) 1999 - 2001 Franz Inc , Berkeley , CA   - All rights reserved .
  copyright ( c ) 2003   ( significant fixes for using
  to , and comprise valuable trade secrets of , Franz , Inc.   They are
  given in confidence by Franz , Inc. pursuant to a written license
  contained herein by any agency , department or entity of the U.S.
  Government are subject to restrictions of Restricted Rights for
  Commercial Software developed at private expense as specified in
  DOD FAR Supplement 52.227 - 7013 ( c ) ( 1 ) ( ii ) , as applicable .
  Original version from ACL 6.1 :
  t - uri.cl , v 1.3.6.3.2.1 2001/08/09 17:42:43 layer
  $ Id$


(defpackage #:puri-tests (:use #:puri #:cl #:ptester))
(in-package #:puri-tests)

(unintern-uri t)

(defmacro gen-test-forms ()
  (let ((res '())
        (base-uri ";p?q"))

                 ("g:h" "g:h" ,base-uri)
                 ("g" "" ,base-uri)
                 ("./g" "" ,base-uri)
                 ("g/" "/" ,base-uri)
                 ("/g" "" ,base-uri)
                 ("//g" "" ,base-uri)
                 #-ignore ("?y" ";p?y" ,base-uri)
                 #+ignore ("?y" "" ,base-uri)
                 ("g?y" "" ,base-uri)
                 ("#s" ";p?q#s" ,base-uri)
                 ("g#s" "#s" ,base-uri)
                 ("g?y#s" "#s" ,base-uri)
                 (";x" "/;x" ,base-uri)
                 ("g;x" ";x" ,base-uri)
                 ("g;x?y#s" ";x?y#s" ,base-uri)
                 ("." "/" ,base-uri)
                 ("./" "/" ,base-uri)
                 (".." "/" ,base-uri)
                 ("../" "/" ,base-uri)
                 ("../g" "" ,base-uri)
                 ("../.." "/" ,base-uri)
                 ("../../" "/" ,base-uri)
                 ("../../g" "" ,base-uri)
                 ("" ";p?q" ,base-uri)
                 ("../../../g" "" ,base-uri)
                 ("../../../../g" "" ,base-uri)
                 ("/./g" "" ,base-uri)
                 ("/../g" "" ,base-uri)
                 ("g." "." ,base-uri)
                 (".g" "" ,base-uri)
                 ("g.." ".." ,base-uri)
                 ("..g" "" ,base-uri)
                 ("./../g" "" ,base-uri)
                 ("./g/." "/" ,base-uri)
                 ("g/./h" "" ,base-uri)
                 ("g/../h" "" ,base-uri)
                 ("g;x=1/./y" ";x=1/y" ,base-uri)
                 ("g;x=1/../y" "" ,base-uri)
                 ("g?y/./x" "" ,base-uri)
                 ("g?y/../x" "" ,base-uri)
                 ("g#s/./x" "#s/./x" ,base-uri)
                 ("g#s/../x" "#s/../x" ,base-uri)
                 ("http:g" "http:g" ,base-uri)

                 ("foo/bar/baz.htm#foo"
                  "#foo"
                  "")
                 ("foo/bar/baz.htm#foo"
                  "#foo"
                  "/")
                 ("foo/bar/baz.htm#foo"
                  "#foo"
                  "")
                 ("foo/bar;x;y/bam.htm"
                  ";x;y/bam.htm"
                  "/")))
      (push `(test (intern-uri ,(second x))
                             (intern-uri (merge-uris (intern-uri ,(first x))
                                                     (intern-uri ,(third x))))
                             :test 'uri=)
            res))

                 (":80" "")
                 (":80" "" eq)
                 (":80" "" eq)
                 ("" "" eq)
                 ("" "" eq)
                 (""
                  "" eq)
                 ("#baz"
                  "#baz" eq)
                 ("" "" eq)
                 ("" "" eq)
                 ("" "/" eq)
  % 72 is " r " , % 2f is " / " , % 3b is " ; "
                  ";x;y;z/baz/"
                  ";x;y;z/baz/" eq)))
      (push `(test (intern-uri ,(second x))
                             (intern-uri ,(first x))
              :test ',(if (third x)
                          (third x)
                          'uri=))
            res))

    (push `(test
            (parse-uri "+bar?baz=b%26lob+bof")
            (parse-uri (parse-uri "+bar?baz=b%26lob+bof"))
            :test 'uri=)
          res)
    (push '(test
            (parse-uri "")
            :test 'uri=)
          res)
    (push `(test
            "baz=b%26lob+bof"
            (uri-query (parse-uri "+bar?baz=b%26lob+bof"))
            :test 'string=)
          res)
    (push `(test
            "baz=b%26lob+bof%3d"
            (uri-query (parse-uri "+bar?baz=b%26lob+bof%3d"))
            :test 'string=)
          res)
    (push
     `(test (parse-uri "xxx?%41") (parse-uri "xxx?A") :test 'uri=)
     res)
    (push
     `(test "A" (uri-query (parse-uri "xxx?%41")) :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
     `(test "foo%23bar" (format nil "~a" (parse-uri "foo%23bar"))
                      :test 'string=)
     res)
    (push
     `(test "foo%23bar#foobar"
                      (format nil "~a" (parse-uri "foo%23bar#foobar"))
                      :test 'string=)
     res)
    (push
     `(test "foo%23bar#foobar#baz"
                      (format nil "~a" (parse-uri "foo%23bar#foobar#baz"))
                      :test 'string=)
     res)
    (push
     `(test "foo%23bar#foobar#baz"
                      (format nil "~a" (parse-uri "foo%23bar#foobar%23baz"))
                      :test 'string=)
     res)
    (push
     `(test "foo%23bar#foobar/baz"
                      (format nil "~a" (parse-uri "foo%23bar#foobar%2fbaz"))
                      :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
            ";3/baz?baf=3"
            (format nil "~a" (parse-uri ";3/baz?baf=3"))
            :test 'string=)
          res)
    (push `(test
            '(:absolute ("/bAr" "3") "baz")
            (uri-parsed-path (parse-uri ";3/baz?baf=3"))
            :test 'equal)
          res)
    (push `(test
            "/%2fbAr;3/baz"
            (let ((u (parse-uri ";3/baz?baf=3")))
              (setf (uri-parsed-path u) '(:absolute ("/bAr" "3") "baz"))
              (uri-path u))
            :test 'string=)
          res)
    (push `(test
            ":8010/kapow?name=foo%3Dbar%25"
            (format nil "~a"
                    (parse-uri
                     ":8010/kapow?name=foo%3Dbar%25"))
            :test 'string=)
          res)
    (push `(test
            "ftp/"
            (format nil "~a"
                    (parse-uri "ftp:/pub/pcl/mop/"))
            :test 'string=)
          res)

    (dolist (x `((""
                  "/"
                  "baz.htm")
                 (""
                  ""
                  "baz.htm")
                 (":80/foo/bar/baz.htm"
                  ":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")

                 ("/~layer/foo.htm"
                  ""
                  "/~layer/foo.htm")
                 ("/~layer/foo.htm"
                  ":8000/~layer/"
                  "/~layer/foo.htm")
                 (":8000/~layer/foo.htm"
                  "/~layer/"
                  ":8000/~layer/foo.htm")
                 (""
                  ""
                  "/")))
      (push `(test (parse-uri ,(third x))
                             (enough-uri (parse-uri ,(first x))
                                         (parse-uri ,(second x)))
                             :test 'uri=)
            res))

    (let ((urn "urn:com:foo-the-bar"))
      (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))
       (test-no-error
        (puri:parse-uri
         "|zop")))
     res)
    (push
     '(test-error
       (puri:parse-uri "|zop")
       :condition-type 'uri-parse-error)
     res)

    (push
     '(let ((puri::*strict-parse* nil))
       (test-no-error
        (puri:parse-uri
         "")))
     res)
    (push
     '(test-error
       (puri:parse-uri
        "")
       :condition-type 'uri-parse-error)
     res)

    (push
     '(let ((puri::*strict-parse* nil))
       (test-no-error
        (puri:parse-uri
         "-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
     '(test-error
       (puri:parse-uri
        "-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)

   2.4.3
  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 ()
  (let ((*break-on-test-failures* t))
    (with-tests (:name "puri")
      (gen-test-forms)))
  t)


