diff --git a/lib/dispatch.ml b/lib/dispatch.ml index 08d2b39..9aba7c4 100644 --- a/lib/dispatch.ml +++ b/lib/dispatch.ml @@ -97,8 +97,8 @@ let of_dsl str = let path_match ps0 ms0 = let rec loop ps ms acc = match ps, ms with - | [] , [] -> `Exact acc - | _ , [] -> `Partial (acc, ps) + | [] , [] -> `Exact (List.rev acc) + | _ , [] -> `Partial (List.rev acc, ps) | [] , _ -> `Failure (Printf.sprintf "unmatched pattern suffix: %s" (to_dsl (ms, `Exact))) | p::ps', (`Lit, l)::ms' -> diff --git a/lib_test/test_dispatch.ml b/lib_test/test_dispatch.ml index 04524e1..230ce66 100644 --- a/lib_test/test_dispatch.ml +++ b/lib_test/test_dispatch.ml @@ -32,12 +32,14 @@ ----------------------------------------------------------------------------*) let base_path c _ _ = c +let params vs _ = vs let param_path k ps _ = List.assoc k ps let disp_path _ r = match r with | None -> "" | Some r -> r + open OUnit open Dispatch.DSL open Result @@ -125,6 +127,18 @@ let keys () = end; ;; +let var_order () = + let table = + [ ("/test/:z/:x/:y/", params) + ; ("/test/:x/:y/order/:z/", params) ] + in + "return path parameters in the order they appear" + @? begin match dispatch table "/test/foo/bar/order/baz" with + | Ok ["x", "foo"; "y", "bar"; "z", "baz" ] -> true + | _ -> false + end +;; + let wildcard () = let table = ["/foo/*", disp_path] in "a trailing wildcard pattern matches just the prefix" @@ -156,9 +170,10 @@ let _ = "single" >:: single; "overlap" >:: overlap; "keys" >:: keys; - "wildcard" >:: wildcard + "var order" >:: var_order; + "wildcard" >:: wildcard; ] in - let suite = (Printf.sprintf "test logic") >::: tests in + let suite = (Printf.sprintf "test dispatch") >::: tests in let verbose = ref false in let set_verbose _ = verbose := true in Arg.parse