Changeset 11826 in project


Ignore:
Timestamp:
08/31/08 13:32:25 (13 years ago)
Author:
sjamaan
Message:

Add tests for uri->string and absolute-uri, and fix absolute-uri

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

Legend:

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

    r11779 r11826  
    100100  (for-each (lambda (p)
    101101              (let ((ubase (uri-reference (first p)))
    102                     (uabs  (uri-reference (second p)))
     102                    (urabs  (uri-reference (second p)))
     103                    (uabs  (absolute-uri (second p)))
    103104                    (uex   (uri-reference (third p))))
    104                 (let* ((from (uri-relative-from uabs ubase))
     105                (let* ((from (uri-relative-from urabs ubase))
    105106                       (to    (uri-relative-to from ubase)))
    106107                  (test (apply sprintf "~S * ~S -> ~S" p) uex from)
    107                   (test (apply sprintf "~S * ~S -> ~S" p) uabs to)
    108                   )))
     108                  (test (apply sprintf "~S * ~S -> ~S" p) urabs to)
     109                  (if (not (uri-fragment urabs))
     110                      (test (sprintf "~S = ~S" uabs urabs) urabs uabs))
     111                  ))
     112              (for-each
     113               (lambda (s)
     114                 (test (sprintf "~S = ~S" s (uri->string (uri-reference s)))
     115                       s (uri->string (uri-reference s))))
     116               p))
    109117            path-cases))
    110118
     
    112120  (for-each (lambda (p)
    113121              (let ((ubase (uri-reference (first p)))
    114                     (uabs  (uri-reference (second p)))
     122                    (urabs  (uri-reference (second p)))
    115123                    (uex   (uri-reference (third p))))
    116                 (let* ((to    (uri-relative-to uabs ubase)))
     124                (let* ((to    (uri-relative-to urabs ubase)))
    117125                  (test (apply sprintf "~S * ~S -> ~S" p) uex to)
    118126                  )))
     
    122130  (for-each (lambda (p)
    123131              (let ((ubase (uri-reference (first p)))
    124                     (uabs  (uri-reference (second p)))
     132                    (urabs  (uri-reference (second p)))
    125133                    (uex   (uri-reference (third p))))
    126                 (let* ((to    (uri-relative-to uabs ubase)))
     134                (let* ((to    (uri-relative-to urabs ubase)))
    127135                  (test (apply sprintf "~S * ~S -> ~S" p) uex to)
    128136                  )))
  • release/4/uri-generic/trunk/uri-generic.scm

    r11823 r11826  
    252252                         ((up rst)  (path-abempty rst)))
    253253                        (list ua up rst)))
    254          (else (match-let (((up rst) (or (path-abs s) (path-rootless s) (list (list) s))))
     254         (else (match-let (((up rst) (or (path-abs s) (path-rootless s) (list #f s))))
    255255                          (list #f up rst)))))
    256256
     
    638638    (match (scheme s)
    639639           ((us rst) 
    640             (match-let (((ua up rst)  (hier-part rst))
    641                         ((uq rst)     (match rst ((#\? . rst)  (query rst))
    642                                              (else (list (list) rst)))))
    643                        (make-URI scheme: (string->symbol (list->string us)) authority: ua
    644                                  path: (map uri-char-list->string up) query: (and uq (filter-map query->string uq))
    645                                  fragment: #f))))))
     640            (match-let* (((ua up rst)  (hier-part rst))
     641                         ((uq rst)     (match rst ((#\? . rst)  (query rst))
     642                                              (else (list #f rst)))))
     643                        (make-URI scheme: (string->symbol (list->string us)) authority: ua
     644                                  path: (map uri-char-list->string up) query: (and uq (filter-map query->string uq))
     645                                  fragment: #f))))))
    646646                     
    647647
Note: See TracChangeset for help on using the changeset viewer.