Skip to content

Commit

Permalink
Sync code with Echo Stream Server
Browse files Browse the repository at this point in the history
  • Loading branch information
lukyanov committed Aug 15, 2012
1 parent 9f676f0 commit aa91baf
Show file tree
Hide file tree
Showing 3 changed files with 65 additions and 9 deletions.
50 changes: 41 additions & 9 deletions ErlangTerm.ml
Expand Up @@ -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
Expand Down Expand Up @@ -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

2 changes: 2 additions & 0 deletions ErlangTerm.mli
Expand Up @@ -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
22 changes: 22 additions & 0 deletions ErlangTerm_Check.ml
Expand Up @@ -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
Expand Down Expand Up @@ -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 _ =
Expand Down

0 comments on commit aa91baf

Please sign in to comment.