diff --git a/cohttp/src/accept.ml b/cohttp/src/accept.ml index bfd6bd5806..2663e38ccc 100644 --- a/cohttp/src/accept.ml +++ b/cohttp/src/accept.ml @@ -47,8 +47,16 @@ let rec string_of_pl = function | (k,T v)::r -> sprintf ";%s=%s%s" k v (string_of_pl r) | (k,S v)::r -> sprintf ";%s=\"%s\"%s" k (Stringext.quote v) (string_of_pl r) +let string_of_q = function + | q when q < 0 -> + invalid_arg (Printf.sprintf "qvalue %d must be positive" q) + | q when q > 1000 -> + invalid_arg (Printf.sprintf "qvalue %d must be less than 1000" q) + | 1000 -> "1" + | q -> Printf.sprintf "0.%03d" q + let accept_el el pl q = - sprintf "%s;q=%.3f%s" el ((float q)/.1000.) (string_of_pl pl) + sprintf "%s;q=%s%s" el (string_of_q q) (string_of_pl pl) let string_of_media_range = function | (MediaType (t,st),pl) -> accept_el (sprintf "%s/%s" t st) pl diff --git a/cohttp/test/test_accept.ml b/cohttp/test/test_accept.ml index 4785305840..14ded566ea 100644 --- a/cohttp/test/test_accept.ml +++ b/cohttp/test/test_accept.ml @@ -21,12 +21,43 @@ let suite_of -> a Alcotest.testable -> (string * a) list -> _ list - = fun parser t -> + = fun pf t -> List.map (fun (s, expected) -> let test () = - Alcotest.(check t) s (parser (Some s)) expected in + Alcotest.check t s (pf (Some s)) expected in (s, `Quick, test)) +let suite_of_fail + : type a. (string option -> a) + -> a Alcotest.testable + -> (string * exn) list + -> _ list + = fun pf t -> + List.map (fun (s, e) -> + let test () = + Alcotest.check_raises s e (fun () -> ignore (pf (Some s))) in + (s, `Quick, test)) + +let suite_to_string_of + : type a. (a -> string) + -> (a * string) list + -> _ list + = fun pf -> + List.map (fun (v, expected_str) -> + let test () = + Alcotest.(check string expected_str expected_str (pf v)) in + (expected_str, `Quick, test)) + +let suite_to_string_of_fail + : type a. (a -> string) + -> (a * string * exn) list + -> _ list + = fun pf -> + List.map (fun (v, descr, e) -> + let test () = + Alcotest.(check_raises descr e (fun () -> ignore (pf v))) in + ("", `Quick, test)) + let valid_media_ranges = [ "text/plain", [1000,(A.MediaType ("text","plain"),[])]; "text/*", [1000,(A.AnyMediaSubtype "text",[])]; @@ -36,7 +67,6 @@ let valid_media_ranges = [ "*/*;q=1.", [1000,(A.AnyMedia,[])]; "*/*;q=1.0", [1000,(A.AnyMedia,[])]; "*/*;q=.0", [0,(A.AnyMedia,[])]; - (* TODO invalid test "*/*;q=.", [0,(A.AnyMedia,[])]; *) "*/*;q=0.", [0,(A.AnyMedia,[])]; "*/*;q=0.1", [100,(A.AnyMedia,[])]; "image/*,text/*", [ @@ -52,11 +82,41 @@ let valid_media_ranges = [ "*/*;f=\";q=0,text/plain\"", [1000,(A.AnyMedia,["f",A.S";q=0,text/plain"])]; ] +let invalid_media_ranges = [ + "*/*;q=.", Parsing.Parse_error; +] + let valid_media_ranges_suite = let t_media_ranges = Alcotest.testable (Fmt.of_to_string A.string_of_media_ranges) (=) in suite_of A.media_ranges t_media_ranges valid_media_ranges +let invalid_media_ranges_suite = + let t_media_ranges = + Alcotest.testable (Fmt.of_to_string A.string_of_media_ranges) (=) in + suite_of_fail A.media_ranges t_media_ranges invalid_media_ranges + +let valid_qualities = [ + (1000,(A.AnyMedia,[])), "*/*;q=1"; + (0,(A.AnyMedia,[])), "*/*;q=0.000"; + (353,(A.AnyMedia,[])), "*/*;q=0.353"; + (25,(A.AnyMedia,[])), "*/*;q=0.025"; + (1,(A.AnyMedia,[])), "*/*;q=0.001"; +] + +let invalid_qualities = [ + (-3,(A.AnyMedia,[])), "negative", Invalid_argument "qvalue -3 must be positive"; + (1001,(A.AnyMedia,[])), "bigger than 1000", Invalid_argument "qvalue 1001 must be less than 1000"; +] + +let valid_qualities_suite = + suite_to_string_of + (fun (q,a) -> A.string_of_media_range a q) valid_qualities + +let invalid_qualities_suite = + suite_to_string_of_fail + (fun (q, a) -> A.string_of_media_range a q) invalid_qualities + let valid_charsets = [ "utf-8", [1000,A.Charset "utf-8"]; "UTF-8", [1000,A.Charset "utf-8"]; @@ -112,8 +172,11 @@ let () = Printexc.record_backtrace true let () = Alcotest.run "test_accept" [ - "Valid Accept",valid_media_ranges_suite; - "Valid Accept-Charset", valid_charsets_suite; - "Valid Accept-Encoding", valid_encodings_suite; - "Valid Accept-Language", valid_languages_suite; + "valid string to media range", valid_media_ranges_suite; + "invalid string to media range", invalid_media_ranges_suite; + "valid media range to string", valid_qualities_suite; + "invalid media range to string", invalid_qualities_suite; + "valid string to charset", valid_charsets_suite; + "valid string to encoding", valid_encodings_suite; + "valid string to language", valid_languages_suite; ]