Permalink
Browse files

Generate a unique request id with every RPC.

This was lost when the core/ was de-lwt'd
  • Loading branch information...
David Scott
David Scott committed Dec 30, 2012
1 parent 7d8ee7a commit 1c71fdfa298c145542ceafc685e66840c358f399
Showing with 27 additions and 9 deletions.
  1. +9 −2 client_lwt/xs_client.ml
  2. +13 −2 client_unix/xs_client_unix.ml
  3. +2 −2 core/xs_protocol.ml
  4. +1 −1 core/xs_protocol.mli
  5. +1 −1 core_test/xs_test.ml
  6. +1 −1 server_test/server_test.ml
View
@@ -194,10 +194,17 @@ module Client = functor(IO: IO with type 'a t = 'a Lwt.t) -> struct
type handle = client Xs_handle.t
+ let make_rid =
+ let counter = ref 0l in
+ fun () ->
+ let result = !counter in
+ counter := Int32.succ !counter;
+ result
+
let rpc hint h payload unmarshal =
let open Xs_handle in
- let request = Request.print payload (get_tid h) in
- let rid = get_rid request in
+ let rid = make_rid () in
+ let request = Request.print payload (get_tid h) rid in
let t, u = wait () in
let c = get_client h in
if c.dispatcher_shutting_down
@@ -226,10 +226,21 @@ module Client = functor(IO: IO with type 'a t = 'a) -> struct
let set_watch_callback client cb = client.extra_watch_callback <- cb
+ let make_rid =
+ let counter = ref 0l in
+ let m = Mutex.create () in
+ fun () ->
+ with_mutex m
+ (fun () ->
+ let result = !counter in
+ counter := Int32.succ !counter;
+ result
+ )
+
let rpc hint h payload unmarshal =
let open Xs_handle in
- let request = Request.print payload (get_tid h) in
- let rid = get_rid request in
+ let rid = make_rid () in
+ let request = Request.print payload (get_tid h) rid in
let t = Task.make () in
let c = get_client h in
if c.dispatcher_shutting_down
View
@@ -637,10 +637,10 @@ module Request = struct
| Set_target (mine, yours) ->
data_concat [ Printf.sprintf "%u" mine; Printf.sprintf "%u" yours; ]
- let print x tid =
+ let print x tid rid =
create
(if transactional_of_payload x then tid else 0l)
- 0l
+ rid
(ty_of_payload x)
(data_of_payload x)
end
View
@@ -193,7 +193,7 @@ module Request : sig
val prettyprint: t -> string
val parse: t -> payload option
- val print: payload -> int32 -> t
+ val print: payload -> int32 -> int32 -> t
end
module Unmarshal : sig
View
@@ -86,7 +86,7 @@ type example_packet = {
}
let make_example_request op payload tid wire_fmt = {
op = op;
- packet = Xs_protocol.Request.print payload tid;
+ packet = Xs_protocol.Request.print payload tid 0l;
wire_fmt = wire_fmt;
}
@@ -77,7 +77,7 @@ let check_result reply = function
(success ++ int32) f reply
let rpc store c tid payload =
- let request = Xs_protocol.Request.print payload tid in
+ let request = Xs_protocol.Request.print payload tid 0l in
Call.reply store c request
let run store (payloads: (Connection.t * int32 * Xs_protocol.Request.payload * result) list) =

0 comments on commit 1c71fdf

Please sign in to comment.