Changeset 13229 in project

Timestamp:

02/09/09 22:52:05 (11 years ago)

Author:

sjamaan

Message:

Rename old uri? predicate to uri-reference? and introduce a new uri? predicate that only returns #t when the object is an uri, not when it's a relative reference

Location:

release/4/uri-generic/trunk

Files:

• tests/run.scm (modified) (1 diff)
• uri-generic.scm (modified) (9 diffs)

release/4/uri-generic/trunk/tests/run.scm

@@ -322 +322 @@
 (test-group "absolute/relative distinction"
   (for-each (lambda (s)
-              (test-assert (sprintf "~S is relative" s)
+              (test-assert (sprintf "~S is a relative ref" s)
                            (relative-ref? (uri-reference s)))
-              (test-assert (sprintf "~S is not absolute" s)
+              (test-assert (sprintf "~S is not an URI" s)
+                           (not (uri? (uri-reference s))))
+              (test-assert (sprintf "~S is not an absolute URI" s)
                            (not (absolute-uri? (uri-reference s))))
               (test-error (absolute-uri s)))
             relative-refs)
   (for-each (lambda (s)
-              (test-assert (sprintf "~S is not relative" s)
+              (test-assert (sprintf "~S is not a relative ref" s)
                            (not (relative-ref? (uri-reference s))))
-              (test-assert (sprintf "~S is absolute" s)
+              (test-assert (sprintf "~S is an URI" s)
+                           (uri? (uri-reference s)))
+              (test-assert (sprintf "~S is an absolute URI" s)
                            (absolute-uri? (uri-reference s)))
               (test (uri-reference s) (absolute-uri s)))
             absolute-uris)
   (for-each (lambda (s)
-              (test-assert (sprintf "~S is not relative" s)
+              (test-assert (sprintf "~S is not a relative ref" s)
                            (not (relative-ref? (uri-reference s))))
-              (test-assert (sprintf "~S is not absolute" s)
+              (test-assert (sprintf "~S is an URI" s)
+                           (uri? (uri-reference s)))
+              (test-assert (sprintf "~S is not an absolute URI" s)
                            (not (absolute-uri? (uri-reference s))))
               ;; Should this give an error in the fragment case?

release/4/uri-generic/trunk/uri-generic.scm

@@ -42 +42 @@
 (module uri-generic
   (uri-reference update-uri update-authority
-   uri? uri-auth uri-authority uri-scheme uri-path uri-query
+   uri-reference? uri-auth uri-authority uri-scheme uri-path uri-query
    uri-fragment uri-host uri-port uri-username uri-password
    authority? authority-host authority-port
    authority-username authority-password
    
-   absolute-uri absolute-uri? uri->string uri->list
+   uri? absolute-uri absolute-uri? uri->string uri->list
    relative-ref? uri-relative-to uri-relative-from 
    uri-decode-string uri-encode-string 
@@ -80 +80 @@
            (URIAuth-port x)))
 
-(define uri? URI?)
+(define uri-reference? URI?)
 
 (define uri-auth       URI-authority )
@@ -281 +281 @@
 ;;               / path-empty
 
+;; TODO: Export a modified version of this one, to match absolute-uri
+;;       (modified = throw an error instead of #f)
 (define (uri s)
   (let ((s (if (string? s) (uri-string->normalized-char-list s) s)))
@@ -294 +296 @@
                                   fragment: (and uf (uri-char-list->string uf)))))
          (else #f))))
+
+(define (uri? u)
+  (and (uri-reference? u) (uri-scheme u)))
 
 (define (uri-path-list->path pcl)
@@ -664 +669 @@
     (or (uri s) (relative-ref s))))
 
+;; (define uri-reference? URI) ; Already defined as URI? (struct predicate)
+
 ;;  RFC3986, section 4.2
 ;;
@@ -673 +680 @@
 ;;                 / path-empty
 
+;; TODO: Export a modified version of this  (one that accepts a string
+;;       and throws an exception instead of returning #f)
 (define (relative-ref s)
   (and (not (scheme s))
@@ -685 +694 @@
 
 (define (relative-ref? u)
-  (and (uri? u) (not (uri-scheme u))))
+  (and (uri-reference? u) (not (uri-scheme u))))
 
 (define (relative-part s)
@@ -716 +725 @@
 
 (define (absolute-uri? u)
-  (and (uri? u) (not (relative-ref? u)) (not (uri-fragment u))))
+  (and (uri-reference? u) (not (relative-ref? u)) (not (uri-fragment u))))
 
 ;; Turns a URI into a string.
@@ -825 +834 @@
 
 (define (uri-relative-to ref base)
-  (and (uri? ref) (uri? base)
+  (and (uri-reference? ref) (uri-reference? base)
        (cond ((uri-scheme ref)      (update-URI ref
                                                 path: (just-segments ref)))