Changeset 13209 in project


Ignore:
Timestamp:
02/07/09 22:31:57 (11 years ago)
Author:
sjamaan
Message:

Add absolute/relative uri/reference predicates and tests for them. Fix bug in absolute-uri and add tests for absolute uri

Location:
release/4/uri-generic/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/uri-generic/trunk/tests/run.scm

    r13108 r13209  
    287287            internal-representation-cases))
    288288
     289;; I wonder if there's a term for this :)
     290(define non-relative-non-absolute-uri-references
     291  '("http://foo#frag"
     292    "http://foo?a=b#frag"
     293    "http://foo/bar#frag"
     294    "http://foo/bar?a=b#frag"))
     295
     296(define absolute-uris
     297  '("http://foo"
     298    "http://foo?a=b"
     299    "http://foo/bar"
     300    "http://foo/bar?a=b"))
     301
     302(define relative-refs
     303  `(""
     304    "bar"
     305    "bar?a=b"
     306    "bar#frag"
     307    "bar?a=b#frag"
     308    "/"
     309    "/bar"
     310    "/bar?a=b"
     311    "/bar#frag"
     312    "/bar?a=b#frag"
     313    "//foo"
     314    "//foo?a=b"
     315    "//foo#frag"
     316    "//foo?a=b#frag"
     317    "//foo/bar"
     318    "//foo/bar?a=b"
     319    "//foo/bar#frag"
     320    "//foo/bar?a=b#frag"))
     321
     322(test-group "absolute/relative distinction"
     323  (for-each (lambda (s)
     324              (test-assert (sprintf "~S is relative" s)
     325                           (relative-ref? (uri-reference s)))
     326              (test-assert (sprintf "~S is not absolute" s)
     327                           (not (absolute-uri? (uri-reference s))))
     328              (test-error (absolute-uri s)))
     329            relative-refs)
     330  (for-each (lambda (s)
     331              (test-assert (sprintf "~S is not relative" s)
     332                           (not (relative-ref? (uri-reference s))))
     333              (test-assert (sprintf "~S is absolute" s)
     334                           (absolute-uri? (uri-reference s)))
     335              (test (uri-reference s) (absolute-uri s)))
     336            absolute-uris)
     337  (for-each (lambda (s)
     338              (test-assert (sprintf "~S is not relative" s)
     339                           (not (relative-ref? (uri-reference s))))
     340              (test-assert (sprintf "~S is not absolute" s)
     341                           (not (absolute-uri? (uri-reference s))))
     342              ;; Should this give an error in the fragment case?
     343              (test-error (absolute-uri s)))
     344            non-relative-non-absolute-uri-references))
     345
    289346(test-group "miscellaneous"
    290347  ;; Special case, see section 4.2
  • release/4/uri-generic/trunk/uri-generic.scm

    r13108 r13209  
    4747   authority-username authority-password
    4848   
    49    absolute-uri uri->string uri->list
    50    uri-relative-to uri-relative-from
     49   absolute-uri absolute-uri? uri->string uri->list
     50   relative-ref? uri-relative-to uri-relative-from
    5151   uri-decode-string uri-encode-string
    5252   uri-normalize-case uri-normalize-path-segments
     
    684684                             fragment: (and uf (uri-char-list->string uf))))))
    685685
     686(define (relative-ref? u)
     687  (and (uri? u) (not (uri-scheme u))))
     688
    686689(define (relative-part s)
    687690  (match s
     
    707710                                  path: (uri-path-list->path up) query: (and uq (uri-char-list->string uq))
    708711                                  fragment: #f)))
    709            (error 'absolute-uri "no scheme found in URI string"))))
    710 
     712           (else (error 'absolute-uri "no scheme found in URI string")))))
     713
     714(define (absolute-uri? u)
     715  (and (uri? u) (not (relative-ref? u)) (not (uri-fragment u))))
    711716
    712717;; Turns a URI into a string.
Note: See TracChangeset for help on using the changeset viewer.