Changeset 13229 in project
- Timestamp:
- 02/09/09 22:52:05 (11 years ago)
- Location:
- release/4/uri-generic/trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/uri-generic/trunk/tests/run.scm
r13228 r13229 322 322 (test-group "absolute/relative distinction" 323 323 (for-each (lambda (s) 324 (test-assert (sprintf "~S is relative" s)324 (test-assert (sprintf "~S is a relative ref" s) 325 325 (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) 327 329 (not (absolute-uri? (uri-reference s)))) 328 330 (test-error (absolute-uri s))) 329 331 relative-refs) 330 332 (for-each (lambda (s) 331 (test-assert (sprintf "~S is not relative" s)333 (test-assert (sprintf "~S is not a relative ref" s) 332 334 (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) 334 338 (absolute-uri? (uri-reference s))) 335 339 (test (uri-reference s) (absolute-uri s))) 336 340 absolute-uris) 337 341 (for-each (lambda (s) 338 (test-assert (sprintf "~S is not relative" s)342 (test-assert (sprintf "~S is not a relative ref" s) 339 343 (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) 341 347 (not (absolute-uri? (uri-reference s)))) 342 348 ;; Should this give an error in the fragment case? -
release/4/uri-generic/trunk/uri-generic.scm
r13228 r13229 42 42 (module uri-generic 43 43 (uri-reference update-uri update-authority 44 uri ? uri-auth uri-authority uri-scheme uri-path uri-query44 uri-reference? uri-auth uri-authority uri-scheme uri-path uri-query 45 45 uri-fragment uri-host uri-port uri-username uri-password 46 46 authority? authority-host authority-port 47 47 authority-username authority-password 48 48 49 absolute-uri absolute-uri? uri->string uri->list49 uri? absolute-uri absolute-uri? uri->string uri->list 50 50 relative-ref? uri-relative-to uri-relative-from 51 51 uri-decode-string uri-encode-string … … 80 80 (URIAuth-port x))) 81 81 82 (define uri ? URI?)82 (define uri-reference? URI?) 83 83 84 84 (define uri-auth URI-authority ) … … 281 281 ;; / path-empty 282 282 283 ;; TODO: Export a modified version of this one, to match absolute-uri 284 ;; (modified = throw an error instead of #f) 283 285 (define (uri s) 284 286 (let ((s (if (string? s) (uri-string->normalized-char-list s) s))) … … 294 296 fragment: (and uf (uri-char-list->string uf))))) 295 297 (else #f)))) 298 299 (define (uri? u) 300 (and (uri-reference? u) (uri-scheme u))) 296 301 297 302 (define (uri-path-list->path pcl) … … 664 669 (or (uri s) (relative-ref s)))) 665 670 671 ;; (define uri-reference? URI) ; Already defined as URI? (struct predicate) 672 666 673 ;; RFC3986, section 4.2 667 674 ;; … … 673 680 ;; / path-empty 674 681 682 ;; TODO: Export a modified version of this (one that accepts a string 683 ;; and throws an exception instead of returning #f) 675 684 (define (relative-ref s) 676 685 (and (not (scheme s)) … … 685 694 686 695 (define (relative-ref? u) 687 (and (uri ? u) (not (uri-scheme u))))696 (and (uri-reference? u) (not (uri-scheme u)))) 688 697 689 698 (define (relative-part s) … … 716 725 717 726 (define (absolute-uri? u) 718 (and (uri ? u) (not (relative-ref? u)) (not (uri-fragment u))))727 (and (uri-reference? u) (not (relative-ref? u)) (not (uri-fragment u)))) 719 728 720 729 ;; Turns a URI into a string. … … 825 834 826 835 (define (uri-relative-to ref base) 827 (and (uri ? ref) (uri? base)836 (and (uri-reference? ref) (uri-reference? base) 828 837 (cond ((uri-scheme ref) (update-URI ref 829 838 path: (just-segments ref)))
Note: See TracChangeset
for help on using the changeset viewer.