erts: Improve stress of binary_to_term in binary_SUITE

by doing repeated calls with different reduction count.

1 files changed, 96 insertions, 47 deletions

diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index 08ab094019..2e5f8ce64d 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -447,26 +447,26 @@ terms(Config) when is_list(Config) ->
               Sz1 when is_integer(Sz1), size(Bin1) =< Sz1 ->
                   ok
               end,
-		      Term = binary_to_term(Bin),
-		      Term = binary_to_term(Bin, [safe]),
+		      Term = binary_to_term_stress(Bin),
+		      Term = binary_to_term_stress(Bin, [safe]),
 		      Unaligned = make_unaligned_sub_binary(Bin),
-		      Term = binary_to_term(Unaligned),
-		      Term = binary_to_term(Unaligned, []),
-		      Term = binary_to_term(Bin, [safe]),
+		      Term = binary_to_term_stress(Unaligned),
+		      Term = binary_to_term_stress(Unaligned, []),
+		      Term = binary_to_term_stress(Bin, [safe]),
 		      BinC = erlang:term_to_binary(Term, [compressed]),
-		      Term = binary_to_term(BinC),
+		      Term = binary_to_term_stress(BinC),
 		      true = size(BinC) =< size(Bin),
 		      Bin = term_to_binary(Term, [{compressed,0}]),
 		      terms_compression_levels(Term, size(Bin), 1),
 		      UnalignedC = make_unaligned_sub_binary(BinC),
-		      Term = binary_to_term(UnalignedC)
+		      Term = binary_to_term_stress(UnalignedC)
 	      end,
     ?line test_terms(TestFun),
     ok.
 
 terms_compression_levels(Term, UncompressedSz, Level) when Level < 10 ->
     BinC = erlang:term_to_binary(Term, [{compressed,Level}]),
-    Term = binary_to_term(BinC),
+    Term = binary_to_term_stress(BinC),
     Sz = byte_size(BinC),
     true = Sz =< UncompressedSz,
     terms_compression_levels(Term, UncompressedSz, Level+1);
@@ -476,9 +476,9 @@ terms_float(Config) when is_list(Config) ->
     ?line test_floats(fun(Term) ->
 			      Bin0 = term_to_binary(Term),
 			      Bin0 = term_to_binary(Term, [{minor_version,0}]),
-			      Term = binary_to_term(Bin0),
+			      Term = binary_to_term_stress(Bin0),
 			      Bin1 = term_to_binary(Term, [{minor_version,1}]),
-			      Term = binary_to_term(Bin1),
+			      Term = binary_to_term_stress(Bin1),
 			      true = size(Bin1) < size(Bin0),
                   Size0 = erlang:external_size(Term),
                   Size00 = erlang:external_size(Term, [{minor_version, 0}]),
@@ -490,7 +490,7 @@ terms_float(Config) when is_list(Config) ->
 float_middle_endian(Config) when is_list(Config) ->
     %% Testing for roundtrip is not enough.
     ?line <<131,70,63,240,0,0,0,0,0,0>> = term_to_binary(1.0, [{minor_version,1}]),
-    ?line 1.0 = binary_to_term(<<131,70,63,240,0,0,0,0,0,0>>).
+    ?line 1.0 = binary_to_term_stress(<<131,70,63,240,0,0,0,0,0,0>>).
 
 external_size(Config) when is_list(Config) ->
     %% Build a term whose external size only fits in a big num (on 32-bit CPU).
@@ -608,10 +608,10 @@ bad_binary_to_term(Config) when is_list(Config) ->
     ok.
 
 bad_bin_to_term(BadBin) ->
-    {'EXIT',{badarg,_}} = (catch binary_to_term(BadBin)).
+    {'EXIT',{badarg,_}} = (catch binary_to_term_stress(BadBin)).
 
 bad_bin_to_term(BadBin,Opts) ->
-    {'EXIT',{badarg,_}} = (catch binary_to_term(BadBin,Opts)).
+    {'EXIT',{badarg,_}} = (catch binary_to_term_stress(BadBin,Opts)).
 
 safe_binary_to_term2(doc) -> "Test safety options for binary_to_term/2";
 safe_binary_to_term2(Config) when is_list(Config) ->
@@ -622,7 +622,7 @@ safe_binary_to_term2(Config) when is_list(Config) ->
     BadRef = <<131,114,0,3,BadHostAtom/binary,0,<<0,0,0,255>>/binary,
 	      Empty/binary,Empty/binary>>,
     ?line bad_bin_to_term(BadRef, [safe]), % good ref, with a bad atom
-    ?line fullsweep_after = binary_to_term(<<131,100,0,15,"fullsweep_after">>, [safe]), % should be a good atom
+    ?line fullsweep_after = binary_to_term_stress(<<131,100,0,15,"fullsweep_after">>, [safe]), % should be a good atom
     BadExtFun = <<131,113,100,0,4,98,108,117,101,100,0,4,109,111,111,110,97,3>>,
     ?line bad_bin_to_term(BadExtFun, [safe]),
     ok.
@@ -673,14 +673,14 @@ corrupter0(Term) ->
 
 corrupter(Bin, Pos) when Pos >= 0 ->
     ?line {ShorterBin, Rest} = split_binary(Bin, Pos),
-    ?line catch binary_to_term(ShorterBin), %% emulator shouldn't crash
+    ?line catch binary_to_term_stress(ShorterBin), %% emulator shouldn't crash
     ?line MovedBin = list_to_binary([ShorterBin]),
-    ?line catch binary_to_term(MovedBin), %% emulator shouldn't crash
+    ?line catch binary_to_term_stress(MovedBin), %% emulator shouldn't crash
 
     %% Bit faults, shouldn't crash
     <<Byte,Tail/binary>> = Rest,
     Fun = fun(M) -> FaultyByte = Byte bxor M,                    
-		    catch binary_to_term(<<ShorterBin/binary,
+		    catch binary_to_term_stress(<<ShorterBin/binary,
 					  FaultyByte, Tail/binary>>) end,
     ?line lists:foreach(Fun,[1,2,4,8,16,32,64,128,255]),    
     ?line corrupter(Bin, Pos-1);
@@ -694,7 +694,7 @@ more_bad_terms(Config) when is_list(Config) ->
     ?line ok = io:format("File: ~s\n", [BadFile]),
     ?line case file:read_file(BadFile) of
 	      {ok,Bin} ->
-		  ?line {'EXIT',{badarg,_}} = (catch binary_to_term(Bin)),
+		  ?line {'EXIT',{badarg,_}} = (catch binary_to_term_stress(Bin)),
 		  ok;
 	      Other ->
 		  ?line ?t:fail(Other)
@@ -703,7 +703,7 @@ more_bad_terms(Config) when is_list(Config) ->
 otp_5484(Config) when is_list(Config) ->
     ?line {'EXIT',_} =
 	(catch
-	     binary_to_term(
+	     binary_to_term_stress(
 	       <<131,
 		104,2,				%Tuple, 2 elements
 		103,				%Pid
@@ -716,7 +716,7 @@ otp_5484(Config) when is_list(Config) ->
 
     ?line {'EXIT',_} =
 	(catch
-	     binary_to_term(
+	     binary_to_term_stress(
 	       <<131,
 		104,2,				%Tuple, 2 elements
 		103,				%Pid
@@ -728,13 +728,13 @@ otp_5484(Config) when is_list(Config) ->
 
     ?line {'EXIT',_} =
 	(catch
-	     binary_to_term(
+	     binary_to_term_stress(
 	       %% A old-type fun in a list containing a bad creator pid.
 	       <<131,108,0,0,0,1,117,0,0,0,0,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,255,255,0,25,255,0,0,0,0,100,0,1,116,97,0,98,6,142,121,72,106>>)),
 
     ?line {'EXIT',_} =
 	(catch
-	     binary_to_term(
+	     binary_to_term_stress(
 	       %% A new-type fun in a list containing a bad creator pid.
 	       %% 
 	       <<131,
@@ -746,7 +746,7 @@ otp_5484(Config) when is_list(Config) ->
 
     ?line {'EXIT',_} =
 	(catch
-	     binary_to_term(
+	     binary_to_term_stress(
 	       %% A new-type fun in a list containing a bad module.
 	       <<131,
 		108,0,0,0,1,			%List, 1 element
@@ -757,7 +757,7 @@ otp_5484(Config) when is_list(Config) ->
 
     ?line {'EXIT',_} =
 	(catch
-	     binary_to_term(
+	     binary_to_term_stress(
 	       %% A new-type fun in a list containing a bad index.
 	       <<131,
 		108,0,0,0,1,			%List, 1 element
@@ -769,7 +769,7 @@ otp_5484(Config) when is_list(Config) ->
 
     ?line {'EXIT',_} =
 	(catch
-	     binary_to_term(
+	     binary_to_term_stress(
 	       %% A new-type fun in a list containing a bad unique value.
 	       <<131,
 		108,0,0,0,1,			%List, 1 element
@@ -782,46 +782,46 @@ otp_5484(Config) when is_list(Config) ->
 
     %% An absurdly large atom.
     ?line {'EXIT',_} = 
-	(catch binary_to_term(iolist_to_binary([<<131,100,65000:16>>|
+	(catch binary_to_term_stress(iolist_to_binary([<<131,100,65000:16>>|
 						lists:duplicate(65000, 42)]))),
 
     %% Longer than 255 characters.
     ?line {'EXIT',_} = 
-	(catch binary_to_term(iolist_to_binary([<<131,100,256:16>>|
+	(catch binary_to_term_stress(iolist_to_binary([<<131,100,256:16>>|
 						lists:duplicate(256, 42)]))),
 
     %% OTP-7218. Thanks to Matthew Dempsky. Also make sure that we
     %% cover the other error cases for external funs (EXPORT_EXT).
     ?line {'EXIT',_} = 
-	(catch binary_to_term(
+	(catch binary_to_term_stress(
 		 <<131,
 		  113,				%EXPORT_EXP
 		  97,13,			%Integer: 13
 		  97,13,			%Integer: 13
 		  97,13>>)),			%Integer: 13
     ?line {'EXIT',_} = 
-	(catch binary_to_term(
+	(catch binary_to_term_stress(
 		 <<131,
 		  113,				%EXPORT_EXP
 		  100,0,1,64,			%Atom: '@'
 		  97,13,			%Integer: 13
 		  97,13>>)),			%Integer: 13
     ?line {'EXIT',_} = 
-	(catch binary_to_term(
+	(catch binary_to_term_stress(
 		 <<131,
 		  113,				%EXPORT_EXP
 		  100,0,1,64,			%Atom: '@'
 		  100,0,1,64,			%Atom: '@'
 		  106>>)),			%NIL
     ?line {'EXIT',_} = 
-	(catch binary_to_term(
+	(catch binary_to_term_stress(
 		 <<131,
 		  113,				%EXPORT_EXP
 		  100,0,1,64,			%Atom: '@'
 		  100,0,1,64,			%Atom: '@'
 		  98,255,255,255,255>>)),	%Integer: -1
     ?line {'EXIT',_} = 
-	(catch binary_to_term(
+	(catch binary_to_term_stress(
 		 <<131,
 		  113,				%EXPORT_EXP
 		  100,0,1,64,			%Atom: '@'
@@ -829,7 +829,7 @@ otp_5484(Config) when is_list(Config) ->
 		  113,97,13,97,13,97,13>>)),	%fun 13:13/13
 
     %% Bad funs.
-    ?line {'EXIT',_} = (catch binary_to_term(fake_fun(0, lists:seq(0, 256)))),
+    ?line {'EXIT',_} = (catch binary_to_term_stress(fake_fun(0, lists:seq(0, 256)))),
     ok.
 
 fake_fun(Arity, Env0) ->
@@ -863,7 +863,7 @@ try_bad_lengths(B) ->
 try_bad_lengths(B, L) when L > 16#FFFFFFF0 ->
     Bin = <<B/binary,L:32>>,
     io:format("~p\n", [Bin]),
-    {'EXIT',_} = (catch binary_to_term(Bin)),
+    {'EXIT',_} = (catch binary_to_term_stress(Bin)),
     try_bad_lengths(B, L-1);
 try_bad_lengths(_, _) -> ok.
 
@@ -917,7 +917,7 @@ otp_6817_try_bin(Bin) ->
     %% If the bug is present, the heap pointer will moved when the invalid term
     %% is found and we will have a linked list passing through the limbo area
     %% between the heap top and the stack pointer.
-    catch binary_to_term(Bin),
+    catch binary_to_term_stress(Bin),
 
     %% If the bug is present, we will overwrite the pointers in the limbo area.
     Filler = erlang:make_tuple(1024, 16#3FA),
@@ -1227,12 +1227,12 @@ bit_sized_binary_sizes(Config) when is_list(Config) ->
 bsbs_1(0) ->
     BinSize = 32+8,
     io:format("A: ~p BinSize: ~p", [0,BinSize]),
-    Bin = binary_to_term(<<131,$M,5:32,0,0,0,0,0,0>>),
+    Bin = binary_to_term_stress(<<131,$M,5:32,0,0,0,0,0,0>>),
     BinSize = bit_size(Bin);
 bsbs_1(A) ->
     BinSize = 32+A,
     io:format("A: ~p BinSize: ~p", [A,BinSize]),
-    Bin = binary_to_term(<<131,$M,5:32,A,0,0,0,0,0>>),
+    Bin = binary_to_term_stress(<<131,$M,5:32,A,0,0,0,0,0>>),
     BinSize = bit_size(Bin).
 
 deep(Config) when is_list(Config) ->
@@ -1249,7 +1249,7 @@ deep(Config) when is_list(Config) ->
 
 deep_roundtrip(T) ->
     B = term_to_binary(T),
-    T = binary_to_term(B).
+    T = binary_to_term_stress(B).
 
 obsolete_funs(Config) when is_list(Config) ->
     erts_debug:set_internal_state(available_internal_state, true),
@@ -1284,29 +1284,29 @@ obsolete_fun(Fun) ->
     Tuple = no_fun_roundtrip(Fun).
 
 no_fun_roundtrip(Term) ->
-    binary_to_term(erts_debug:get_internal_state({term_to_binary_no_funs,Term})).
+    binary_to_term_stress(erts_debug:get_internal_state({term_to_binary_no_funs,Term})).
 
 %% Test non-standard encodings never generated by term_to_binary/1
 %% but recognized by binary_to_term/1.
 
 robustness(Config) when is_list(Config) ->
-    ?line [] = binary_to_term(<<131,107,0,0>>),	%Empty string.
-    ?line [] = binary_to_term(<<131,108,0,0,0,0,106>>),	%Zero-length list.
+    ?line [] = binary_to_term_stress(<<131,107,0,0>>),	%Empty string.
+    ?line [] = binary_to_term_stress(<<131,108,0,0,0,0,106>>),	%Zero-length list.
 
     %% {[],a} where [] is a zero-length list.
-    ?line {[],a} = binary_to_term(<<131,104,2,108,0,0,0,0,106,100,0,1,97>>),
+    ?line {[],a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,106,100,0,1,97>>),
 
     %% {42,a} where 42 is a zero-length list with 42 in the tail.
-    ?line {42,a} = binary_to_term(<<131,104,2,108,0,0,0,0,97,42,100,0,1,97>>),
+    ?line {42,a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,97,42,100,0,1,97>>),
 
     %% {{x,y},a} where {x,y} is a zero-length list with {x,y} in the tail.
-    ?line {{x,y},a} = binary_to_term(<<131,104,2,108,0,0,0,0,
+    ?line {{x,y},a} = binary_to_term_stress(<<131,104,2,108,0,0,0,0,
 				      104,2,100,0,1,120,100,0,1,
 				      121,100,0,1,97>>),
 
     %% Bignums fitting in 32 bits.
-    ?line 16#7FFFFFFF = binary_to_term(<<131,98,127,255,255,255>>),
-    ?line -1 = binary_to_term(<<131,98,255,255,255,255>>),
+    ?line 16#7FFFFFFF = binary_to_term_stress(<<131,98,127,255,255,255>>),
+    ?line -1 = binary_to_term_stress(<<131,98,255,255,255,255>>),
     
     ok.
 
@@ -1324,7 +1324,7 @@ run_otp_8180(Name) ->
     ?line {ok,Bins} = file:consult(Name),
     [begin
 	 io:format("~p\n", [Bin]),
-	 ?line {'EXIT',{badarg,_}} = (catch binary_to_term(Bin))
+	 ?line {'EXIT',{badarg,_}} = (catch binary_to_term_stress(Bin))
      end || Bin <- Bins],
     ok.
 
@@ -1393,3 +1393,52 @@ unaligned_sub_bin(Bin0, Offs) ->
     Bin.
 
 id(I) -> I.
+
+
+%% Stress binary_to_term with different initial reductions
+binary_to_term_stress(Bin) ->
+    binary_to_term_stress(Bin, no_opts).
+
+binary_to_term_stress(Bin, Opts) ->
+    Reds = get_reds(),
+    T = b2t(erlang:system_info(context_reductions),
+	    Bin, Opts, catch_binary_to_term(Bin, Opts)),
+    set_reds(Reds),
+    T = case Opts of
+	    no_opts -> binary_to_term(Bin);
+	    _ ->       binary_to_term(Bin,Opts)
+	end.
+
+catch_binary_to_term(Bin, no_opts) ->
+    try binary_to_term(Bin)
+    catch
+	error:badarg -> binary_to_term_throws_badarg
+    end;
+catch_binary_to_term(Bin, Opts) ->
+    try binary_to_term(Bin, Opts)
+    catch
+	error:badarg -> binary_to_term_throws_badarg
+    end.
+
+b2t(0, _Bin, _Opts, Term) ->
+    Term;
+b2t(Reds, Bin, Opts, Term) ->
+    set_reds(Reds),
+    Term = catch_binary_to_term(Bin,Opts),
+    b2t(Reds div 3, Bin, Opts, Term).
+
+set_reds(Reds) ->
+    try	erts_debug:set_internal_state(reds_left, Reds)
+    catch
+	error:undef ->
+	    erts_debug:set_internal_state(available_internal_state, true),
+	    set_reds(Reds)
+    end.
+
+get_reds() ->
+    try	erts_debug:get_internal_state(reds_left)
+    catch
+	error:undef ->
+	    erts_debug:set_internal_state(available_internal_state, true),
+	    get_reds()
+    end.