source: project/release/4/uri-match/trunk/tests/run.scm @ 16104

Last change on this file since 16104 was 16104, checked in by Moritz Heidkamp, 10 years ago

use irregex for route matching (per Peter Bex)

File size: 2.9 KB
Line 
1(load-relative "../uri-match.scm")
2
3(import uri-match)
4(use test srfi-1 data-structures uri-common)
5
6(test-group "routes creation"
7  (let ([routes (make-routes '((get "foo")
8                               ("/foo"
9                                (get "bar")
10                                (post "posted")
11                                ("/bar" (get "nested")))
12                               (post "ha!")))])
13    (test-assert (lset= '(get post) (map car routes)))
14
15    (test-group "expansion"
16
17      (test-assert (lset= '("/" "/foo" "/foo/bar")
18                          (map car (alist-ref 'get routes))))
19
20      (test-assert (lset= '("/" "/foo")
21                          (map car (alist-ref 'post routes)))))))
22
23(test-group "basic matching"
24
25  (test "this is the body"
26        ((uri-match 'get "/" (make-routes '(("/" (get "this is the body")))))))
27
28  (test "against the path of a uri-reference" "something!"
29        ((uri-match 'get (uri-reference "http://foo/bar") (make-routes '(("/bar" (get "something!")))))))
30
31  (test-assert (not (uri-match 'get "/" (make-routes '(("/" (post "won't reach me")))))))
32
33  (test-group "with nesting"
34    (test-assert (equal? "foo" ((uri-match 'post "/foo/bar" (make-routes '(("/foo" ("/bar" (post "foo")))))))))
35
36    (test-group "with procedure body"
37      (test-assert (eq? 'something
38                        ((uri-match 'get "/me" (make-routes `(("/me" (get ,(lambda () 'something)))))))))
39
40      (test-assert (= 100 ((uri-match 'get "/numbers/100"
41                                      (make-routes `(("/numbers/(\\d+)" (get ,(lambda (n) (string->number n))))))))))))
42
43  (test-group "with capture groups"
44    (let ([routes (make-routes `(("/foo" ("/(\\d+)" ("/(\\d+)" (get ,string-append))))))])
45     
46      (test-assert (string= "105" ((uri-match 'get "/foo/10/5" routes))))
47      (test-assert (not (uri-match 'get "/foo/bar/10" routes)))))
48 
49  (test-group "with irregex capture groups"
50    (let ([routes (make-routes
51                   `(("/foo" ((seq "/" (submatch (+ num)))
52                              ((seq "/" (submatch (+ num)))
53                               (get ,string-append))))))])
54      (test-assert (string= "105" ((uri-match 'get "/foo/10/5" routes))))
55      (test-assert (not (uri-match 'get "/foo/bar/10" routes)))))
56 
57  (test-group "with irregex named capture groups"
58    (let ([routes (make-routes
59                   `(("/foo" ((seq "/" (submatch (+ num)))
60                              ((seq "/" (or (submatch-named b (+ num))
61                                            (submatch-named c (+ alpha))))
62                               (get ,(lambda (a #!key (b "b") (c "c"))
63                                       (string-append a b c))))))))])
64      (test "105c" ((uri-match 'get "/foo/10/5" routes)))
65      (test "10bx" ((uri-match 'get "/foo/10/x" routes)))
66      (test-assert (not (uri-match 'get "/foo/bar/10" routes))))))
67
68
69(test-group "matcher" 
70         
71  (let ([matcher (make-uri-matcher '(("/" (get "is")) ("/this" (post "it") ("/or" (put "what?")))))])
72
73    (test-assert (equal? "is" ((matcher 'get "/"))))
74
75    (test-assert (equal? "it" ((matcher 'post "/this"))))
76
77    (test-assert (equal? "what?" ((matcher 'put "/this/or"))))))
Note: See TracBrowser for help on using the repository browser.