URI parsing errors throw to `uri-error'

* module/web/uri.scm (uri-error): New proc, throws to 'uri-error.
  (validate-uri, uri-decode, uri-encode): Use uri-error.

* test-suite/tests/web-uri.test: Update for uri-error.

module/web/uri.scm

@@ -50,26 +50,29 @@
   (query uri-query)
   (fragment uri-fragment))
 
+(define (uri-error message . args)
+  (throw 'uri-error message args))
+
 (define (positive-exact-integer? port)
   (and (number? port) (exact? port) (integer? port) (positive? port)))
 
 (define (validate-uri scheme userinfo host port path query fragment)
   (cond
    ((not (symbol? scheme))
-    (error "expected a symbol for the URI scheme" scheme))
+    (uri-error "Expected a symbol for the URI scheme: ~s" scheme))
    ((and (or userinfo port) (not host))
-    (error "expected host, given userinfo or port"))
+    (uri-error "Expected a host, given userinfo or port"))
    ((and port (not (positive-exact-integer? port)))
-    (error "expected integer port" port))
+    (uri-error "Expected port to be an integer: ~s" port))
    ((and host (or (not (string? host)) (not (valid-host? host))))
-    (error "expected valid host" host))
+    (uri-error "Expected valid host: ~s" host))
    ((and userinfo (not (string? userinfo)))
-    (error "expected string for userinfo" userinfo))
+    (uri-error "Expected string for userinfo: ~s" userinfo))
    ((not (string? path))
-    (error "expected string for path" path))
+    (uri-error "Expected string for path: ~s" path))
    ((and host (not (string-null? path))
          (not (eqv? (string-ref path 0) #\/)))
-    (error "expected path of absolute URI to start with a /" path))))
+    (uri-error "Expected path of absolute URI to start with a /: ~a" path))))
 
 (define* (build-uri scheme #:key userinfo host port (path "") query fragment
                     (validate? #t))
@@ -222,7 +225,7 @@
               ((case charset
                  ((utf-8) utf8->string)
                  ((#f) (lambda (x) x)) ; raw bytevector
-                 (else (error "unknown charset" charset)))
+                 (else (uri-error "Unknown charset: ~s" charset)))
                (get-bytevector))
               (let ((ch (string-ref str i)))
                 (cond
@@ -242,7 +245,8 @@
                   (put-u8 port (char->integer ch))
                   (lp (1+ i)))
                  (else
-                  (error "invalid character in encoded URI" str ch))))))))))
+                  (uri-error "Invalid character in encoded URI ~a: ~s"
+                             str ch))))))))))
   
 (define ascii-alnum-chars
   (string->char-set
@@ -272,7 +276,7 @@
   ((case charset
      ((utf-8) utf8->string)
      ((#f) (lambda (x) x)) ; raw bytevector
-     (else (error "unknown charset" charset)))
+     (else (uri-error "Unknown charset: ~s" charset)))
    (call-with-values open-bytevector-output-port
      (lambda (port get-bytevector)
        (string-for-each

test-suite/tests/web-uri.test

@@ -19,6 +19,7 @@
 
 (define-module (test-web-uri)
   #:use-module (web uri)
+  #:use-module (ice-9 regex)
   #:use-module (test-suite lib))
 
 
@@ -35,7 +36,16 @@
        (equal? (uri-query uri) query)
        (equal? (uri-fragment uri) fragment)))
 
-(define ex:expected '(misc-error . "expected"))
+(define-syntax pass-if-uri-exception
+  (syntax-rules ()
+    ((_ name pat exp)
+     (pass-if name
+       (catch 'uri-error
+         (lambda () exp (error "expected uri-error exception"))
+         (lambda (k message args)
+           (if (string-match pat message)
+               #t
+               (error "unexpected uri-error exception" message args))))))))
 
 (with-test-prefix "build-uri"
   (pass-if "ftp:"
@@ -68,32 +78,32 @@
            #:port 22
            #:path "/baz"))
 
-  (pass-if-exception "non-symbol scheme"
-                     ex:expected
+  (pass-if-uri-exception "non-symbol scheme"
+                         "Expected.*symbol"
                          (build-uri "nonsym"))
 
-  (pass-if-exception "http://bad.host.1"
-                     ex:expected
+  (pass-if-uri-exception "http://bad.host.1"
+                         "Expected.*host"
                          (build-uri 'http #:host "bad.host.1"))
 
   (pass-if "http://bad.host.1 (no validation)"
     (uri=? (build-uri 'http #:host "bad.host.1" #:validate? #f)
            #:scheme 'http #:host "bad.host.1" #:path ""))
 
-  (pass-if-exception "http://foo:not-a-port"
-                     ex:expected
+  (pass-if-uri-exception "http://foo:not-a-port"
+                         "Expected.*port"
                          (build-uri 'http #:host "foo" #:port "not-a-port"))
 
-  (pass-if-exception "http://foo:10 but port as string"
-                     ex:expected
+  (pass-if-uri-exception "http://foo:10 but port as string"
+                         "Expected.*port"
                          (build-uri 'http #:host "foo" #:port "10"))
 
-  (pass-if-exception "http://:10"
-                     ex:expected
+  (pass-if-uri-exception "http://:10"
+                         "Expected.*host"
                          (build-uri 'http #:port 10))
 
-  (pass-if-exception "http://foo@"
-                     ex:expected
+  (pass-if-uri-exception "http://foo@"
+                         "Expected.*host"
                          (build-uri 'http #:userinfo "foo")))