Changeset 13230 in project


Ignore:
Timestamp:
02/09/09 23:05:20 (11 years ago)
Author:
sjamaan
Message:

Merge latest changes from release 4

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

    r13212 r13230  
    127127              (let ((ubase (uri-reference (first p)))
    128128                    (urabs  (uri-reference (second p)))
    129                     (uabs  (absolute-uri (second p)))
    130129                    (uex   (uri-reference (third p))))
    131130                (let* ((from (uri-relative-from urabs ubase))
     
    133132                  (test (apply sprintf "~S * ~S -> ~S" p) uex from)
    134133                  (test (apply sprintf "~S * ~S -> ~S" p) urabs to)
    135                   (if (not (uri-fragment urabs))
    136                       (test (sprintf "~S = ~S" uabs urabs) urabs uabs))
     134                  (unless (uri-fragment urabs)
     135                    (let ((uabs  (absolute-uri (second p))))
     136                      (test (sprintf "~S = ~S" uabs urabs) urabs uabs)))
    137137                  ))
    138138              (for-each
     
    322322(test-group "absolute/relative distinction"
    323323  (for-each (lambda (s)
    324               (test-assert (sprintf "~S is relative" s)
     324              (test-assert (sprintf "~S is a relative ref" s)
    325325                           (relative-ref? (uri-reference s)))
    326               (test-assert (sprintf "~S is not absolute" s)
     326              (test-assert (sprintf "~S is not an URI" s)
     327                           (not (uri? (uri-reference s))))
     328              (test-assert (sprintf "~S is not an absolute URI" s)
    327329                           (not (absolute-uri? (uri-reference s))))
    328330              (test-error (absolute-uri s)))
    329331            relative-refs)
    330332  (for-each (lambda (s)
    331               (test-assert (sprintf "~S is not relative" s)
     333              (test-assert (sprintf "~S is not a relative ref" s)
    332334                           (not (relative-ref? (uri-reference s))))
    333               (test-assert (sprintf "~S is absolute" s)
     335              (test-assert (sprintf "~S is an URI" s)
     336                           (uri? (uri-reference s)))
     337              (test-assert (sprintf "~S is an absolute URI" s)
    334338                           (absolute-uri? (uri-reference s)))
    335339              (test (uri-reference s) (absolute-uri s)))
    336340            absolute-uris)
    337341  (for-each (lambda (s)
    338               (test-assert (sprintf "~S is not relative" s)
     342              (test-assert (sprintf "~S is not a relative ref" s)
    339343                           (not (relative-ref? (uri-reference s))))
    340               (test-assert (sprintf "~S is not absolute" s)
     344              (test-assert (sprintf "~S is an URI" s)
     345                           (uri? (uri-reference s)))
     346              (test-assert (sprintf "~S is not an absolute URI" s)
    341347                           (not (absolute-uri? (uri-reference s))))
    342348              ;; Should this give an error in the fragment case?
  • release/3/uri-generic/trunk/uri-generic.scm

    r13212 r13230  
    44;; Based on the Haskell URI library by  Graham Klyne <gk@ninebynine.org>.
    55;;
    6 ;; Copyright 2008 Ivan Raikov, Peter Bex.
     6;; Copyright 2008-2009 Ivan Raikov, Peter Bex.
    77;;
    88;;
     
    5252 (lambda-lift)
    5353 (export uri-reference update-uri update-authority
    54          uri? uri-auth uri-authority uri-scheme uri-path uri-query
     54         uri-reference? uri-auth uri-authority uri-scheme uri-path uri-query
    5555         uri-fragment uri-host uri-port uri-username uri-password
    5656         authority? authority-host authority-port
    5757         authority-username authority-password
    5858         
    59          absolute-uri absolute-uri? uri->string uri->list
     59         uri? absolute-uri absolute-uri? uri->string uri->list
    6060         relative-ref? uri-relative-to uri-relative-from
    6161         uri-decode-string uri-encode-string
     
    8484           (URIAuth-port x)))
    8585
    86 (define uri? URI?)
     86(define uri-reference? URI?)
    8787
    8888(define uri-auth       URI-authority )
     
    291291;;               / path-empty
    292292
     293;; TODO: Export a modified version of this one, to match absolute-uri
     294;;       (modified = throw an error instead of #f)
    293295(define (uri s)
    294296  (let ((s (if (string? s) (uri-string->normalized-char-list s) s)))
     
    304306                                  fragment: (and uf (uri-char-list->string uf)))))
    305307         (else #f))))
     308
     309(define (uri? u)
     310  (and (uri-reference? u) (uri-scheme u)))
    306311
    307312(define (uri-path-list->path pcl)
     
    674679    (or (uri s) (relative-ref s))))
    675680
     681;; (define uri-reference? URI) ; Already defined as URI? (struct predicate)
     682
    676683;;  RFC3986, section 4.2
    677684;;
     
    683690;;                 / path-empty
    684691
     692;; TODO: Export a modified version of this  (one that accepts a string
     693;;       and throws an exception instead of returning #f)
    685694(define (relative-ref s)
    686695  (and (not (scheme s))
     
    695704
    696705(define (relative-ref? u)
    697   (and (uri? u) (not (uri-scheme u))))
     706  (and (uri-reference? u) (not (uri-scheme u))))
    698707
    699708(define (relative-part s)
     
    717726                         ((uq rst)     (match rst ((#\? . rst)  (query rst))
    718727                                              (else (list #f rst)))))
    719                         (make-URI scheme: (string->symbol (list->string us)) authority: ua
    720                                   path: (uri-path-list->path up) query: (and uq (uri-char-list->string uq))
    721                                   fragment: #f)))
     728                        (match rst
     729                               ((#\# . rst) (error 'absolute-uri "fragments are not permitted in absolute URI"))
     730                               (else (make-URI scheme: (string->symbol (list->string us)) authority: ua
     731                                               path: (uri-path-list->path up)
     732                                               query: (and uq (uri-char-list->string uq))
     733                                               fragment: #f)))))
    722734           (else (error 'absolute-uri "no scheme found in URI string")))))
    723735                     
    724736
    725737(define (absolute-uri? u)
    726   (and (uri? u) (not (relative-ref? u)) (not (uri-fragment u))))
     738  (and (uri-reference? u) (not (relative-ref? u)) (not (uri-fragment u))))
    727739
    728740;; Turns a URI into a string.
     
    833845
    834846(define (uri-relative-to ref base)
    835   (and (uri? ref) (uri? base)
     847  (and (uri-reference? ref) (uri-reference? base)
    836848       (cond ((uri-scheme ref)      (just-segments ref))
    837849             ((uri-authority ref)   (let ((x (just-segments ref)))
Note: See TracChangeset for help on using the changeset viewer.