mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-18 21:29:19 +02:00
Many still import (chibi), and as (scheme base) is somewhat more expensive to load at present these are changed to cond-expand. Many libraries also rely on (srfi 33), and these have been changed to a cond-expand first trying (srfi 60) where available. Also fixing a few portability concerns (duplicate imports of the same binding), and adding a few libraries missing from lib-tests.scm.
67 lines
3 KiB
Scheme
67 lines
3 KiB
Scheme
(define-library (chibi uri-test)
|
|
(export run-tests)
|
|
(import (scheme base) (chibi test) (chibi uri))
|
|
(begin
|
|
(define (run-tests)
|
|
(test-begin "uri")
|
|
|
|
(test-assert (uri? (make-uri 'http)))
|
|
(test 'http (uri-scheme (make-uri 'http)))
|
|
(test "r" (uri-user (make-uri 'http "r")))
|
|
(test "google.com" (uri-host (make-uri 'http "r" "google.com")))
|
|
(test 80 (uri-port (make-uri 'http "r" "google.com" 80)))
|
|
(test "/search" (uri-path (make-uri 'http "r" "google.com" 80 "/search")))
|
|
(test "q=cats"
|
|
(uri-query (make-uri 'http "r" "google.com" 80 "/search" "q=cats")))
|
|
(test "recent"
|
|
(uri-fragment
|
|
(make-uri 'http "r" "google.com" 80 "/search" "q=cats" "recent")))
|
|
|
|
(let ((str "http://google.com"))
|
|
(test-assert (uri? (string->uri str)))
|
|
(test 'http (uri-scheme (string->uri str)))
|
|
(test "google.com" (uri-host (string->uri str)))
|
|
(test #f (uri-port (string->uri str)))
|
|
(test #f (uri-path (string->uri str)))
|
|
(test #f (uri-query (string->uri str)))
|
|
(test #f (uri-fragment (string->uri str))))
|
|
|
|
(let ((str "http://google.com/"))
|
|
(test-assert (uri? (string->uri str)))
|
|
(test 'http (uri-scheme (string->uri str)))
|
|
(test "google.com" (uri-host (string->uri str)))
|
|
(test #f (uri-port (string->uri str)))
|
|
(test "/" (uri-path (string->uri str)))
|
|
(test #f (uri-query (string->uri str)))
|
|
(test #f (uri-fragment (string->uri str))))
|
|
|
|
(let ((str "http://google.com:80/search?q=cats#recent"))
|
|
(test-assert (uri? (string->uri str)))
|
|
(test 'http (uri-scheme (string->uri str)))
|
|
(test "google.com" (uri-host (string->uri str)))
|
|
(test 80 (uri-port (string->uri str)))
|
|
(test "/search" (uri-path (string->uri str)))
|
|
(test "q=cats" (uri-query (string->uri str)))
|
|
(test "recent" (uri-fragment (string->uri str))))
|
|
|
|
(test "/%73" (uri-path (string->uri "http://google.com/%73")))
|
|
(test "/s" (uri-path (string->uri "http://google.com/%73" #t)))
|
|
(test "a=1&b=2;c=3"
|
|
(uri-query (string->uri "http://google.com/%73?a=1&b=2;c=3" #t)))
|
|
(test '(("a" . "1") ("b" . "2") ("c" . "3"))
|
|
(uri-query (string->uri "http://google.com/%73?a=1&b=2;c=3" #t #t)))
|
|
(test '(("a" . "1") ("b" . "2+2") ("c" . "3"))
|
|
(uri-query (string->uri "http://google.com/%73?a=1&b=2+2;c=%33" #f #t)))
|
|
(test '(("a" . "1") ("b" . "2 2") ("c" . "3"))
|
|
(uri-query (string->uri "http://google.com/%73?a=1&b=2+2;c=%33" #t #t)))
|
|
|
|
(let ((str "/"))
|
|
(test-assert (uri? (string->path-uri 'http str)))
|
|
(test 'http (uri-scheme (string->path-uri 'http str)))
|
|
(test #f (uri-host (string->path-uri 'http str)))
|
|
(test #f (uri-port (string->path-uri 'http str)))
|
|
(test "/" (uri-path (string->path-uri 'http str)))
|
|
(test #f (uri-query (string->path-uri 'http str)))
|
|
(test #f (uri-fragment (string->path-uri 'http str))))
|
|
|
|
(test-end))))
|