diff --git a/_oasis b/_oasis index 7ffc8e3301..1cf8bdb975 100644 --- a/_oasis +++ b/_oasis @@ -138,6 +138,15 @@ Executable test_parser Install: false BuildDepends: cohttp, cohttp.lwt, oUnit (>= 1.0.2) +Executable test_parser_async + Path: lib_test + MainIs: test_parser_async.ml + Build$: flag(tests) && flag(async) + Custom: true + CompiledObject: best + Install: false + BuildDepends: cohttp, cohttp.async, oUnit (>= 1.0.2) + Executable test_accept Path: lib_test MainIs: test_accept.ml @@ -356,6 +365,11 @@ Test test_parser Command: $test_parser WorkingDirectory: lib_test +Test test_parser_async + Run$: flag(tests) && flag(async) + Command: $test_parser_async + WorkingDirectory: lib_test + Test test_net_lwt Run$: flag(nettests) && flag(lwt_unix) Command: $test_net_lwt diff --git a/_tags b/_tags index 115cdbd778..d95e1f065e 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 9e5f723b5dc53e4f0b65b65a00c4b409) +# DO NOT EDIT (digest: f313874952e9c72355fdfca71d918ae4) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process @@ -123,6 +123,25 @@ true: annot, bin_annot : use_cohttp_lwt : use_cohttp_lwt_unix : custom +# Executable test_parser_async +: pkg_async +: pkg_base64 +: pkg_bytes +: pkg_conduit.async +: pkg_fieldslib +: pkg_fieldslib.syntax +: pkg_magic-mime +: pkg_oUnit +: pkg_re.emacs +: pkg_sexplib +: pkg_sexplib.syntax +: pkg_stringext +: pkg_threads +: pkg_uri +: pkg_uri.services +: use_cohttp +: use_cohttp_async +: custom # Executable test_accept : pkg_base64 : pkg_bytes diff --git a/async/cohttp_async.mli b/async/cohttp_async.mli index 541fb48391..7af5e3744d 100644 --- a/async/cohttp_async.mli +++ b/async/cohttp_async.mli @@ -20,7 +20,7 @@ open Async.Std (** Read in a full body and convert to a [string] *) -module IO : Cohttp.S.IO with type 'a t = 'a Deferred.t +module IO : (module type of Cohttp_async_io) module Request : sig type t = Cohttp.Request.t diff --git a/async/cohttp_async_io.mli b/async/cohttp_async_io.mli new file mode 100644 index 0000000000..a7977727e3 --- /dev/null +++ b/async/cohttp_async_io.mli @@ -0,0 +1,22 @@ +(* + * Copyright (c) 2013 Anil Madhavapeddy + * + * Permission to use, copy, modify, and distribute this software for + * any purpose with or without fee is hereby granted, provided that the + * above copyright notice and this permission notice appear in all + * copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS + * ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED + * WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE + * AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL + * DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA + * OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER + * TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR + * PERFORMANCE OF THIS SOFTWARE. +*) + +open Async.Std + +include Cohttp.S.IO + with type 'a t = 'a Deferred.t + and type ic = Reader.t + and type oc = Writer.t diff --git a/lib_test/test_parser_async.ml b/lib_test/test_parser_async.ml new file mode 100644 index 0000000000..bcb1e1de2b --- /dev/null +++ b/lib_test/test_parser_async.ml @@ -0,0 +1,81 @@ +(* + * Copyright (c) 2015 Daniel Patterson + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + * + *) + +open OUnit +open Printf + +let post_req = +"POST /path/script.cgi HTTP/1.0 +From: frog@jmarshall.com +User-Agent: HTTPTool/1.0 +Content-Type: application/x-www-form-urlencoded +Content-Length: 32 + +home=Cosby&favorite+flavor=flies" + + +open Core.Std +open Async.Std + +let ic_of_buffer buf = Reader.of_pipe (Info.of_string "") (Pipe.of_list [buf]) + +let p_sexp f x = x |> f |> Sexplib.Sexp.to_string + +let post_form_parse () = + let open Cohttp_async in + ic_of_buffer post_req >>= fun ic -> + Request.read ic >>= function + | `Ok req -> + assert_equal true (Request.is_form req); + Request.read_form req ic >>= fun params -> + assert_equal ["Cosby"] (List.Assoc.find_exn params "home"); + assert_equal ["flies"] (List.Assoc.find_exn params "favorite flavor"); + assert_raises Not_found (fun () -> List.Assoc.find_exn params "nonexistent"); + (* multiple requests should still work *) + assert_equal ["Cosby"] (List.Assoc.find_exn params "home"); + return () + | _ -> assert false + +let test_cases = + let tests = [ + "post_form_parse", post_form_parse; + ] in + List.map ~f:(fun (n,x) -> n >:: (fun () -> Thread_safe.block_on_async_exn x)) tests + +(* Returns true if the result list contains successes only. + Copied from oUnit source as it isnt exposed by the mli *) +let rec was_successful = + function + | [] -> true + | RSuccess _::t + | RSkip _::t -> + was_successful t + | RFailure _::_ + | RError _::_ + | RTodo _::_ -> + false + +let _ = + let suite = "Parser" >::: test_cases in + let verbose = ref false in + let set_verbose _ = verbose := true in + Arg.parse + [("-verbose", Arg.Unit set_verbose, "Run the test in verbose mode.");] + (fun x -> raise (Arg.Bad ("Bad argument : " ^ x))) + ("Usage: " ^ Sys.argv.(0) ^ " [-verbose]"); + if not (was_successful (run_test_tt ~verbose:!verbose suite)) then + Pervasives.exit 1 diff --git a/setup.ml b/setup.ml index 1b731e4b50..0011e46843 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ (* setup.ml generated for the first time by OASIS v0.4.5 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 69dd07bfb7823d5b65485f2c355c5f75) *) +(* DO NOT EDIT (digest: 01ed2ba568da4408acfb974d376f91c7) *) (* Regenerated by OASIS v0.4.5 Visit http://oasis.forge.ocamlcore.org for more information and @@ -6837,6 +6837,14 @@ let setup_t = cmd_clean = [(OASISExpr.EBool true, None)]; cmd_distclean = [(OASISExpr.EBool true, None)] }); + ("test_parser_async", + CustomPlugin.Test.main + { + CustomPlugin.cmd_main = + [(OASISExpr.EBool true, ("$test_parser_async", []))]; + cmd_clean = [(OASISExpr.EBool true, None)]; + cmd_distclean = [(OASISExpr.EBool true, None)] + }); ("test_net_lwt", CustomPlugin.Test.main { @@ -6906,6 +6914,14 @@ let setup_t = cmd_clean = [(OASISExpr.EBool true, None)]; cmd_distclean = [(OASISExpr.EBool true, None)] }); + ("test_parser_async", + CustomPlugin.Test.clean + { + CustomPlugin.cmd_main = + [(OASISExpr.EBool true, ("$test_parser_async", []))]; + cmd_clean = [(OASISExpr.EBool true, None)]; + cmd_distclean = [(OASISExpr.EBool true, None)] + }); ("test_net_lwt", CustomPlugin.Test.clean { @@ -6973,6 +6989,14 @@ let setup_t = cmd_clean = [(OASISExpr.EBool true, None)]; cmd_distclean = [(OASISExpr.EBool true, None)] }); + ("test_parser_async", + CustomPlugin.Test.distclean + { + CustomPlugin.cmd_main = + [(OASISExpr.EBool true, ("$test_parser_async", []))]; + cmd_clean = [(OASISExpr.EBool true, None)]; + cmd_distclean = [(OASISExpr.EBool true, None)] + }); ("test_net_lwt", CustomPlugin.Test.distclean { @@ -7547,6 +7571,44 @@ let setup_t = bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = true; exec_main_is = "test_parser.ml"}); + Executable + ({ + cs_name = "test_parser_async"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + bs_build = + [ + (OASISExpr.EBool true, false); + (OASISExpr.EAnd + (OASISExpr.EFlag "tests", + OASISExpr.EFlag "async"), + true) + ]; + bs_install = [(OASISExpr.EBool true, false)]; + bs_path = "lib_test"; + bs_compiled_object = Best; + bs_build_depends = + [ + InternalLibrary "cohttp"; + InternalLibrary "cohttp_async"; + FindlibPackage + ("oUnit", + Some (OASISVersion.VGreaterEqual "1.0.2")) + ]; + bs_build_tools = [ExternalTool "ocamlbuild"]; + bs_c_sources = []; + bs_data_files = []; + bs_ccopt = [(OASISExpr.EBool true, [])]; + bs_cclib = [(OASISExpr.EBool true, [])]; + bs_dlllib = [(OASISExpr.EBool true, [])]; + bs_dllpath = [(OASISExpr.EBool true, [])]; + bs_byteopt = [(OASISExpr.EBool true, [])]; + bs_nativeopt = [(OASISExpr.EBool true, [])] + }, + {exec_custom = true; exec_main_is = "test_parser_async.ml" + }); Executable ({ cs_name = "test_accept"; @@ -8438,6 +8500,35 @@ let setup_t = ]; test_tools = [ExternalTool "ocamlbuild"] }); + Test + ({ + cs_name = "test_parser_async"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + test_type = (`Test, "custom", Some "0.4"); + test_command = + [(OASISExpr.EBool true, ("$test_parser_async", []))]; + test_custom = + { + pre_command = [(OASISExpr.EBool true, None)]; + post_command = [(OASISExpr.EBool true, None)] + }; + test_working_directory = Some "lib_test"; + test_run = + [ + (OASISExpr.ENot (OASISExpr.EFlag "tests"), false); + (OASISExpr.EFlag "tests", false); + (OASISExpr.EAnd + (OASISExpr.EFlag "tests", + OASISExpr.EAnd + (OASISExpr.EFlag "tests", + OASISExpr.EFlag "async")), + true) + ]; + test_tools = [ExternalTool "ocamlbuild"] + }); Test ({ cs_name = "test_net_lwt"; @@ -8521,7 +8612,7 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.5"; - oasis_digest = Some "Ò\142:Úú)\127$\153\157Û*Ò\159U4"; + oasis_digest = Some "\129n\145\247sW\127\201r\236\141\231V\149R{"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -8529,6 +8620,6 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 8533 "setup.ml" +# 8624 "setup.ml" (* OASIS_STOP *) let () = setup ();;