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

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

uri-match: add test-depends and set exit code for tests

File size: 3.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 '(((/ "foo")
8                                (GET "bar")
9                                (POST "POSTed")
10                                ((/ "bar") 
11                                 (GET "nested")))))])
12
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 "foo" ((uri-match 'POST "/foo/bar" (make-routes '(((/ "foo") ((/ "bar") (POST "foo"))))))))
35
36    (test-group "with procedure body"
37      (test 'something
38        ((uri-match 'GET "/me" (make-routes `(((/ "me") (GET ,(lambda (c) 'something))))))))
39
40      (test 100 ((uri-match 'GET "/numbers/100"
41                            (make-routes `(((/ "numbers" "(\\d+)") (GET ,(lambda (c n) (string->number n)))))))))))
42
43  (test-group "with capture groups"
44    (let ([routes (make-routes `(((/ "foo") ((/ "(\\d+)") ((/ "(\\d+)") (GET ,(lambda (c . args) (apply string-append args))))))))])
45     
46      (test "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") ((/ (submatch (+ num)))
52                                 ((/ (submatch (+ num)))
53                                  (GET ,(lambda (c . args) (apply string-append args))))))))])
54
55      (test "105" ((uri-match 'GET "/foo/10/5" routes)))
56      (test-assert (not (uri-match 'GET "/foo/bar/10" routes)))))
57 
58  (test-group "with irregex named capture groups"
59    (let ([routes (make-routes
60                   `(((/ "foo") ((/ (submatch (+ num)))
61                                 ((/ (or (submatch-named b (+ num))
62                                         (submatch-named c (+ alpha))))
63                                  (GET ,(lambda (cont a #!key (b "b") (c "c"))
64                                          (string-append a b c))))))))])
65      (test "105c" ((uri-match 'GET "/foo/10/5" routes)))
66      (test "10bx" ((uri-match 'GET "/foo/10/x" routes)))
67      (test-assert (not (uri-match 'GET "/foo/bar/10" routes))))))
68
69
70(test-group "matcher" 
71         
72  (let ([matcher (make-uri-matcher '(((/ "") (GET "is")) 
73                                     ((/ "this") (POST "it")
74                                      ((/ "or") (PUT "what?")))))])
75
76    (test "is" ((matcher 'GET "/")))
77
78    (test "it" ((matcher 'POST "/this")))
79
80    (test "what?" ((matcher 'PUT "/this/or")))))
81
82(test-group "precedence"
83  (let ([matcher (make-uri-matcher '(((/ "f..") (GET "first"))
84                                     ((/ "foo") (GET "second"))))])
85
86    (test "first come, first serve" "first" ((matcher 'GET "/foo")))))
87
88(test-group "a bit more complex nesting"
89  (let ((match (make-uri-matcher `(((/ "") (GET "this is the root path!")
90                                    ((/ "some")
91                                     ((/ "nested") (GET "I'm nested!")
92                                      ((/ "route" "(.+)" "(.+)") (GET ,(lambda (c x y)
93                                                                         (format "I am the ~A and ~A!" x y)))))))))))
94
95    (test "this is the root path!" ((match 'GET "/")))
96    (test "I'm nested!" ((match 'GET "/some/nested")))
97    (test "I am the alpha and omega!" ((match 'GET (uri-reference "http://localhost/some/nested/route/alpha/omega"))))))
98
99(test-group "continuing matching"
100  (let ((match (make-uri-matcher `(((/ (submatch (+ any)))
101                                    (PUT ,(lambda (continue arg)
102                                            (if (string=? "foo" arg)
103                                                'this-is-foo
104                                                (continue))))
105                                    (PUT ,(lambda (continue arg)
106                                            (if (string=? "sparta" arg)
107                                                'this-is-spartaaaa
108                                                (continue)))))))))
109
110    (test 'this-is-foo ((match 'PUT "/foo")))
111    (test 'this-is-spartaaaa ((match 'PUT "/sparta")))
112    (test-assert (not ((match 'PUT "/nothing"))))))
113
114(unless (zero? (test-failure-count)) (exit 1))
Note: See TracBrowser for help on using the repository browser.