Changeset 13212 in project


Ignore:
Timestamp:
02/08/09 15:09:50 (11 years ago)
Author:
sjamaan
Message:

Merge latest changes in release 4 trunk

Location:
release/3/uri-generic/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/3/uri-generic/trunk

  • release/3/uri-generic/trunk/tests/run.scm

    r13109 r13212  
    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/3/uri-generic/trunk/uri-generic.scm

    r13109 r13212  
    5757         authority-username authority-password
    5858         
    59          absolute-uri uri->string uri->list
    60          uri-relative-to uri-relative-from
     59         absolute-uri absolute-uri? uri->string uri->list
     60         relative-ref? uri-relative-to uri-relative-from
    6161         uri-decode-string uri-encode-string
    6262         uri-normalize-case uri-normalize-path-segments
     
    694694                             fragment: (and uf (uri-char-list->string uf))))))
    695695
     696(define (relative-ref? u)
     697  (and (uri? u) (not (uri-scheme u))))
     698
    696699(define (relative-part s)
    697700  (match s
     
    717720                                  path: (uri-path-list->path up) query: (and uq (uri-char-list->string uq))
    718721                                  fragment: #f)))
    719            (error 'absolute-uri "no scheme found in URI string"))))
     722           (else (error 'absolute-uri "no scheme found in URI string")))))
    720723                     
     724
     725(define (absolute-uri? u)
     726  (and (uri? u) (not (relative-ref? u)) (not (uri-fragment u))))
    721727
    722728;; Turns a URI into a string.
Note: See TracChangeset for help on using the changeset viewer.