From: Prashanth Mundkur Date: Wed, 3 Jun 2009 18:58:25 +0000 (-0700) Subject: Added response_handling codegen, which needed a slight change in request api. Extend... X-Git-Url: http://xenbits.xensource.com/gitweb?a=commitdiff_plain;h=9d88315a97d9d44fd6a809cd7b58be83b718f303;p=xenclient%2Ftoolstack.git Added response_handling codegen, which needed a slight change in request api. Extended tests appropriately. --- diff --git a/gen/rpc/codegen.ml b/gen/rpc/codegen.ml index 2c52ea9..e0c40e8 100644 --- a/gen/rpc/codegen.ml +++ b/gen/rpc/codegen.ml @@ -245,22 +245,46 @@ module Client = struct done; nm + let gen_handler_type ff resp = + let resp_type = resp.response_value.param_type in + fprintf ff "@,val %s : %s -> context -> unit" resp.response_handler resp_type + + let client_modname s = Printf.sprintf "%s_client" (String.capitalize s.server_name) + + let gen_resp_name rpc = + Printf.sprintf "jresp_%s" (gen_method_name rpc.rpc_request.request_name) + + let generate_client_sig ff s rpcs = + fprintf ff "module type %s =@\n" (client_modname s); + fprintf ff "@[sig"; + fprintf ff "@,type rpc_id"; + fprintf ff "@,type context"; + fprintf ff "@,val get_new_rpc_id : unit -> rpc_id * Json.t"; + List.iter (fun (rpc, resp) -> gen_handler_type ff resp) rpcs; + fprintf ff "@]@\nend@\n@\n@?" + let start_maker ff s = - let rpcid_maker = "Rpc_id_maker" in - fprintf ff "module Make_%s_client (%s : Jsonrpc.Rpc_id_generator) =@\n" (String.lowercase s.server_name) rpcid_maker ; + let modname = client_modname s in + fprintf ff "module Make_%s_client (%s : %s) =@\n" (String.lowercase s.server_name) modname modname; fprintf ff "@[struct"; - rpcid_maker + modname let end_maker ff = fprintf ff "@]@\nend@\n@\n@?" - let generate_rpc ff venv rpcid_maker s rpc = + let generate_resp_handler ff modname c (rpc, resp) = + fprintf ff "@,@[let %s resp =@," (gen_resp_name rpc); + fprintf ff "%s.%s (%s resp)@]" modname resp.response_handler + (Type_conv.of_json resp.response_value.param_type) + + let generate_rpc ff venv modname s rpc = let params = rpc.rpc_request.request_params in let args = List.map (fun p -> p.param_name) params in let avlist, venv = Var_env.new_idents_from_names venv ~prefix:"o_" args in let vvlist, venv = Var_env.new_idents_from_names venv ~prefix:"j_" args in let rpcv, venv = Var_env.new_ident_from_name venv "rpc_id" in - let rpcvn = name_of_var rpcv in + let jrpcv, venv = Var_env.new_ident_from_name venv "jrpc_id" in + let rpcvn, jrpcvn = name_of_var rpcv, name_of_var jrpcv in let meth_name = gen_method_name rpc.rpc_request.request_name in let args_str = (match args with @@ -277,15 +301,21 @@ module Client = struct Printf.sprintf "\"%s\", %s" a (name_of_var v) ) args vvlist ) - ) - in + ) in (match rpc.rpc_response with - | None -> fprintf ff "let %s = None in@," rpcvn - | Some _ -> fprintf ff "let %s = Some (%s.get_rpc_request_id ()) in@," rpcvn rpcid_maker); - fprintf ff "@[{ Jsonrpc.request_id = %s;@," rpcvn; + | None -> + fprintf ff "let %s = None in@," jrpcvn + | Some resp -> + fprintf ff "let %s, %s = %s.get_new_rpc_id () in@," rpcvn jrpcvn modname; + fprintf ff "let %s = Some %s in@," jrpcvn jrpcvn + ); + fprintf ff "@[{ Jsonrpc.request_id = %s;@," jrpcvn; fprintf ff "Jsonrpc.method_name = \"%s\";@," rpc.rpc_request.request_name; fprintf ff "Jsonrpc.params = Json.Object (Array.of_list [ %s ])" args_str; - fprintf ff "@]@,}@]" + (match rpc.rpc_response with + | None -> fprintf ff "@]@,}@]" + | Some _ -> fprintf ff "@]@,}, %s, %s@]" rpcvn (gen_resp_name rpc) + ) end let generate_header ff = @@ -315,9 +345,17 @@ let generate_server ff spec s = fprintf ff "@\n@?" let generate_client ff spec c = - let rpc_list = get_rpcs_by_server spec c in - let rpcid_maker = Client.start_maker ff c in - List.iter (Client.generate_rpc ff Var_env.new_env rpcid_maker c) rpc_list; + let rpc_list, _ = get_sorted_rpcs_by_server spec c in + let msg_list = get_rpcs_by_server spec c in + Client.generate_client_sig ff c rpc_list; + let modname = Client.start_maker ff c in + if List.length rpc_list > 0 then + fprintf ff "@,(* Response handling *)@,"; + List.iter (Client.generate_resp_handler ff modname c) rpc_list; + fprintf ff "@,"; + if List.length msg_list > 0 then + fprintf ff "@,(* Requests and notifications *)@,"; + List.iter (Client.generate_rpc ff Var_env.new_env modname c) msg_list; Client.end_maker ff let generate_endpoint spec e fn = diff --git a/gen/rpc/tests/test_rpc.ml b/gen/rpc/tests/test_rpc.ml index 9413265..a702685 100644 --- a/gen/rpc/tests/test_rpc.ml +++ b/gen/rpc/tests/test_rpc.ml @@ -3,14 +3,37 @@ open Rpc_types_json_conv open Rpc_one open Rpc_two -(* First, implement the Json-rpc id generator. *) -module I : Jsonrpc.Rpc_id_generator = struct - let cur_id = ref 0L +exception Dumb_test_error + +(* First, implement the response handling interface. *) +module I = struct + type rpc_id = Int64.t - let get_rpc_request_id () = + let cur_id = ref 0L + let get_new_rpc_id () = let id = !cur_id in cur_id := Int64.add !cur_id 1L; - Json.Int id + id, Json.Int id + + type context = + | Req0 of resp1_type + | Req1 of resp1_type + | Req2 of resp2_type + + let response0_handler resp1 context = + match context with + | Req0 r -> assert (r = resp1); Printf.printf "response0_handler: response good\n\n" + | _ -> raise Dumb_test_error + + let response1_handler resp2 context = + match context with + | Req1 r -> assert (r = resp2); Printf.printf "response1_handler: response good\n\n" + | _ -> raise Dumb_test_error + + let client_function resp2 context = + match context with + | Req2 r -> assert (r = resp2); Printf.printf "client_function: response good\n\n" + | _ -> raise Dumb_test_error end (* Now, create the client-side wrappers. *) @@ -143,28 +166,30 @@ let test_invoke req ?(id_check=default_id_check) ?(error_check=default_error_che let test_server () = let req0_checker test_id () = - let req = C.jrpc_request0 () in + let req, rpcid, resp_fn = C.jrpc_request0 () in let exp_resp = S.req0_handler () in let resp_to_str r = match r with |None -> "None" | Some b -> if b then "Some true" else "Some false" in let resp_checker r = let got_resp = resp1_type_of_json r in if got_resp <> exp_resp then raise (Failure (Printf.sprintf "req1, test %s: got \"%s\", expected \"%s\"!" - test_id (resp_to_str got_resp) (resp_to_str exp_resp))) + test_id (resp_to_str got_resp) (resp_to_str exp_resp))); + resp_fn r (I.Req0 exp_resp) in test_invoke req resp_checker in req0_checker "1" (); let req1_checker test_id arg1 = - let req = C.jrpc_request1 arg1 in + let req, rpcid, resp_fn = C.jrpc_request1 arg1 in let exp_resp = S.req1_handler arg1 in let resp_to_str r = match r with |None -> "None" | Some b -> if b then "Some true" else "Some false" in let resp_checker r = let got_resp = resp1_type_of_json r in if got_resp <> exp_resp then raise (Failure (Printf.sprintf "req1, test %s: got \"%s\", expected \"%s\"!" - test_id (resp_to_str got_resp) (resp_to_str exp_resp))) + test_id (resp_to_str got_resp) (resp_to_str exp_resp))); + resp_fn r (I.Req1 exp_resp) in test_invoke req resp_checker in @@ -173,12 +198,13 @@ let test_server () = req1_checker "3" 13; let req2_checker test_id arg1 arg2 arg3 = - let req = C.jrpc_request2 arg1 arg2 arg3 in + let req, rpcid, resp_fn = C.jrpc_request2 arg1 arg2 arg3 in let exp_resp = S.req2_handler arg1 arg2 arg3 in let resp_checker r = let got_resp = resp2_type_of_json r in if got_resp <> exp_resp - then raise (Failure (Printf.sprintf "req2, test %s: got \"%s\", expected \"%s\"!" test_id got_resp exp_resp)) + then raise (Failure (Printf.sprintf "req2, test %s: got \"%s\", expected \"%s\"!" test_id got_resp exp_resp)); + resp_fn r (I.Req2 exp_resp) in test_invoke req resp_checker in