Permalink
Browse files

Merge pull request #6 from lukyanov/master

Update from Echo Stream Server (currently used code)
  • Loading branch information...
2 parents 9f676f0 + aa91baf commit 6707f924d3f531540b07031b5d268343b800935e @vlm vlm committed Aug 22, 2012
Showing with 65 additions and 9 deletions.
  1. +41 −9 ErlangTerm.ml
  2. +2 −0 ErlangTerm.mli
  3. +22 −0 ErlangTerm_Check.ml
View
@@ -475,11 +475,11 @@ let binary_to_term_buf2 off buf =
incr off;
byte in
let iint () = Int32.(
- to_int (
- List.fold_left (fun a e -> add a (shift_left (of_int (ibyte ())) e))
- zero [24; 16; 8; 0]
- )
- ) in
+ to_int (
+ List.fold_left (fun a e -> add a (shift_left (of_int (ibyte ())) e))
+ zero [24; 16; 8; 0]
+ )
+ ) in
let istr len = let s = Buffer.sub buf !off len in
off := !off + len;
s in
@@ -522,18 +522,50 @@ let term_to_binary_out out_channel term =
let term_to_binary_buf buffer term =
let abyte x = Buffer.add_char buffer (char_of_int x) in
let aint x =
- let x32 = Int32.of_int x in
- List.iter (fun n ->
- abyte Int32.(to_int (logand (shift_right_logical x32 n) 0xFFl))
- ) [24; 16; 8; 0] in
+ let x32 = Int32.of_int x in
+ List.iter (fun n ->
+ abyte Int32.(to_int (logand (shift_right_logical x32 n) 0xFFl))
+ ) [24; 16; 8; 0] in
let astr = Buffer.add_string buffer in
let abuf = Buffer.add_buffer buffer in
abyte 131;
erlang_term_encode abyte aint astr abuf term;;
+let term_to_binary_bufs term =
+ let aref = ref [] in
+ let new_buffer size = Buffer.create size in
+ let current_size = ref (10000) in
+ let buffer = ref (new_buffer !current_size) in
+ let wrapper f x =
+ let wr f0 x0 =
+ aref := !buffer :: !aref;
+ if !current_size < 246000 then
+ current_size := !current_size * 2;
+ buffer := new_buffer !current_size;
+ f !buffer x
+ in
+ if (Buffer.length !buffer + 1000 > !current_size) then
+ wr f x
+ else
+ try f !buffer x with _ -> wr f x
+ in
+ let abyte x = wrapper Buffer.add_char (char_of_int x) in
+ let aint x =
+ let x32 = Int32.of_int x in
+ List.iter (fun n ->
+ abyte Int32.(to_int (logand (shift_right_logical x32 n) 0xFFl))
+ ) [24; 16; 8; 0] in
+ let astr = wrapper Buffer.add_string in
+ let abuf = wrapper Buffer.add_buffer in
+ abyte 131;
+ erlang_term_encode abyte aint astr abuf term;
+ List.rev (!buffer :: !aref);;
+
(* Return a fresh Buffer containing the serialized Erlang term *)
let term_to_binary term =
let b = Buffer.create 1024 in
let () = term_to_binary_buf b term in
b;;
+exception ExceptionTerm of erlang_term
+
View
@@ -54,4 +54,6 @@ val binary_to_term_buf : Buffer.t -> erlang_term
val binaries_to_terms_buf : Buffer.t -> erlang_term list
val term_to_binary_out : out_channel -> erlang_term -> unit
val term_to_binary_buf : Buffer.t -> erlang_term -> unit
+val term_to_binary_bufs : erlang_term -> Buffer.t list
val term_to_binary : erlang_term -> Buffer.t
+exception ExceptionTerm of erlang_term
View
@@ -68,6 +68,14 @@ let bignum_check_negative () =
| _ -> failwith "Bignum test failed"
;;
+let bigbuffer_check () =
+ let a = ref [] in
+ for v = 1 to 100000 do
+ a := complexTerm :: !a
+ done;
+ ET_List !a;;
+
+
(* Check that the given Erlang term passes the round-trip encode/decode test *)
let check_round_trip op term =
let rewrittenTerm = binary_to_term_buf (term_to_binary term) in
@@ -115,6 +123,20 @@ let selfcheck () =
print_erlang_term complexTerm;
print_newline ();
check_round_trip (=) complexTerm;
+
+ ignore(term_to_binary_bufs (bigbuffer_check ()));
+
+ (* do not check it on 64bit system as
+ * Sys.max_string_length = 144115188075855863
+ * it's too long to generate assertion
+ *)
+ if Sys.word_size == 32 then
+ let b = Buffer.create 1024 in
+ try
+ term_to_binary_buf b (bigbuffer_check ());
+ assert(false)
+ with Failure "Buffer.add: cannot grow buffer" -> ();
+
print_string "Selfcheck OK\n";;
let _ =

0 comments on commit 6707f92

Please sign in to comment.