Changeset 11827 in project


Ignore:
Timestamp:
08/31/08 13:46:50 (13 years ago)
Author:
sjamaan
Message:

Backport changes in release 4 trunk to release 3

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

Legend:

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

    r11562 r11827  
    1 
    21(require-extension srfi-1)
    32(require-extension uri-generic)
    4 (require-extension testbase)
    5 (require-extension testbase-output-compact)
    6 
    7 (define-expect-unary pair?)
     3(require-extension test)
    84
    95;; test cases from Python URI implementation
     
    10197    ))
    10298
    103 (define-test uri-test "uri test"
     99(test-group "uri test"
     100  (for-each (lambda (p)
     101              (let ((ubase (uri-reference (first p)))
     102                    (urabs  (uri-reference (second p)))
     103                    (uabs  (absolute-uri (second p)))
     104                    (uex   (uri-reference (third p))))
     105                (let* ((from (uri-relative-from urabs ubase))
     106                       (to    (uri-relative-to from ubase)))
     107                  (test (apply sprintf "~S * ~S -> ~S" p) uex from)
     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))
     117            path-cases))
    104118
    105    (test/collect 'path-test
    106      (for-each (lambda (p)
    107                  (let ((ubase (uri-reference (first p)))
    108                        (uabs  (uri-reference (second p)))
    109                        (uex   (uri-reference (third p))))
    110                    (let* ((from (uri-relative-from uabs ubase))
    111                           (to    (uri-relative-to from ubase)))
    112                      (collect-test (test/equal from uex))
    113                      (collect-test (test/equal to uabs))
    114                    )))
    115                path-cases))
     119(test-group "rfc test"
     120  (for-each (lambda (p)
     121              (let ((ubase (uri-reference (first p)))
     122                    (urabs  (uri-reference (second p)))
     123                    (uex   (uri-reference (third p))))
     124                (let* ((to    (uri-relative-to urabs ubase)))
     125                  (test (apply sprintf "~S * ~S -> ~S" p) uex to)
     126                  )))
     127            rfc-cases))
    116128
    117    (test/collect 'rfc-test
    118      (for-each (lambda (p)
    119                  (let ((ubase (uri-reference (first p)))
    120                        (uabs  (uri-reference (second p)))
    121                        (uex   (uri-reference (third p))))
    122                    (let* ((to    (uri-relative-to uabs ubase)))
    123                      (collect-test (test/equal to uex))
    124                    )))
    125                rfc-cases))
    126 
    127    (test/collect 'extra-test
    128      (for-each (lambda (p)
    129                  (let ((ubase (uri-reference (first p)))
    130                        (uabs  (uri-reference (second p)))
    131                        (uex   (uri-reference (third p))))
    132                    (let* ((to    (uri-relative-to uabs ubase)))
    133                      (collect-test (test/equal to uex))
    134                    )))
    135                extra-cases))
    136    )
    137 
    138 
    139 (test::styler-set! uri-test test::output-style-compact)
    140 (run-test "uri test")
     129(test-group "extra-test"
     130  (for-each (lambda (p)
     131              (let ((ubase (uri-reference (first p)))
     132                    (urabs  (uri-reference (second p)))
     133                    (uex   (uri-reference (third p))))
     134                (let* ((to    (uri-relative-to urabs ubase)))
     135                  (test (apply sprintf "~S * ~S -> ~S" p) uex to)
     136                  )))
     137            extra-cases))
  • release/3/uri-generic/trunk/uri-generic.scm

    r11817 r11827  
    260260                         ((up rst)  (path-abempty rst)))
    261261                        (list ua up rst)))
    262          (else (match-let (((up rst) (or (path-abs s) (path-rootless s) (list (list) s))))
     262         (else (match-let (((up rst) (or (path-abs s) (path-rootless s) (list #f s))))
    263263                          (list #f up rst)))))
    264264
     
    646646    (match (scheme s)
    647647           ((us rst) 
    648             (match-let (((ua up rst)  (hier-part rst))
    649                         ((uq rst)     (match rst ((#\? . rst)  (query rst))
    650                                              (else (list (list) rst)))))
    651                        (make-URI scheme: (string->symbol (list->string us)) authority: ua
    652                                  path: (map uri-char-list->string up) query: (and uq (filter-map query->string uq))
    653                                  fragment: #f))))))
     648            (match-let* (((ua up rst)  (hier-part rst))
     649                         ((uq rst)     (match rst ((#\? . rst)  (query rst))
     650                                              (else (list #f rst)))))
     651                        (make-URI scheme: (string->symbol (list->string us)) authority: ua
     652                                  path: (map uri-char-list->string up) query: (and uq (filter-map query->string uq))
     653                                  fragment: #f))))))
    654654                     
    655655
Note: See TracChangeset for help on using the changeset viewer.