1 USING: http.server http.server.dispatchers http.server.responses
2 tools.test kernel namespaces accessors io http math sequences
3 assocs arrays classes words urls ;
4 IN: http.server.dispatchers.tests
6 \ find-responder must-infer
7 \ http-error. must-infer
9 TUPLE: mock-responder path ;
11 C: <mock-responder> mock-responder
13 M: mock-responder call-responder*
16 [ ] "text/plain" <content> ;
18 : check-dispatch ( tag path -- ? )
19 V{ } clone responder-nesting set
22 main-responder get call-responder
27 "foo" <mock-responder> "foo" add-responder
28 "bar" <mock-responder> "bar" add-responder
30 "123" <mock-responder> "123" add-responder
31 "default" <mock-responder> >>default
36 { "foo" } main-responder get find-responder path>> nip
40 { "bar" } main-responder get find-responder path>> nip
43 [ t ] [ "foo" "foo" check-dispatch ] unit-test
44 [ f ] [ "foo" "bar" check-dispatch ] unit-test
45 [ t ] [ "bar" "bar" check-dispatch ] unit-test
46 [ t ] [ "default" "baz/xxx" check-dispatch ] unit-test
47 [ t ] [ "default" "baz/xxx//" check-dispatch ] unit-test
48 [ t ] [ "default" "/baz/xxx//" check-dispatch ] unit-test
49 [ t ] [ "123" "baz/123" check-dispatch ] unit-test
50 [ t ] [ "123" "baz///123" check-dispatch ] unit-test
56 "default" <mock-responder> >>default
59 [ "/default" ] [ "/default" main-responder get find-responder drop ] unit-test
62 ! Make sure path for default responder isn't chopped
63 TUPLE: path-check-responder ;
65 C: <path-check-responder> path-check-responder
67 M: path-check-responder call-responder*
69 >array "text/plain" <content> ;
72 V{ } clone responder-nesting set
77 <path-check-responder> >>default
83 ! Test that "" dispatcher works with default>>
86 "" <mock-responder> "" add-responder
87 "bar" <mock-responder> "bar" add-responder
88 "baz" <mock-responder> >>default
91 [ t ] [ "" "" check-dispatch ] unit-test
92 [ f ] [ "" "quux" check-dispatch ] unit-test
93 [ t ] [ "baz" "quux" check-dispatch ] unit-test
94 [ f ] [ "foo" "bar" check-dispatch ] unit-test
95 [ t ] [ "bar" "bar" check-dispatch ] unit-test
96 [ t ] [ "baz" "xxx" check-dispatch ] unit-test