aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/test/binary_SUITE.erl
diff options
context:
space:
mode:
Diffstat (limited to 'erts/emulator/test/binary_SUITE.erl')
-rw-r--r--erts/emulator/test/binary_SUITE.erl242
1 files changed, 139 insertions, 103 deletions
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index db2b3e10db..fed5854112 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -23,12 +23,12 @@
%% Tests binaries and the BIFs:
%% list_to_binary/1
%% iolist_to_binary/1
-%% bitstr_to_list/1
+%% list_to_bitstring/1
%% binary_to_list/1
%% binary_to_list/3
%% binary_to_term/1
%% binary_to_term/2
-%% bitstr_to_list/1
+%% bitstring_to_list/1
%% term_to_binary/1
%% erlang:external_size/1
%% size(Binary)
@@ -40,9 +40,11 @@
%% phash2(Binary, N)
%%
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1, init_per_testcase/2, fin_per_testcase/2,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ init_per_testcase/2, end_per_testcase/2,
copy_terms/1, conversions/1, deep_lists/1, deep_bitstr_lists/1,
bad_list_to_binary/1, bad_binary_to_list/1,
t_split_binary/1, bad_split/1, t_concat_binary/1,
@@ -55,31 +57,48 @@
otp_5484/1,otp_5933/1,
ordering/1,unaligned_order/1,gc_test/1,
bit_sized_binary_sizes/1,
- bitlevel_roundtrip/1,
otp_6817/1,deep/1,obsolete_funs/1,robustness/1,otp_8117/1,
otp_8180/1]).
%% Internal exports.
-export([sleeper/0]).
-all(suite) ->
- [copy_terms,conversions,deep_lists,deep_bitstr_lists,
+suite() -> [{ct_hooks,[ts_install_cth]},
+ {timetrap,{minutes,2}}].
+
+all() ->
+ [copy_terms, conversions, deep_lists, deep_bitstr_lists,
t_split_binary, bad_split, t_concat_binary,
- bad_list_to_binary, bad_binary_to_list, terms, terms_float,
- external_size, t_iolist_size,
- bad_binary_to_term_2,safe_binary_to_term2,
- bad_binary_to_term, bad_terms, t_hash, bad_size, bad_term_to_binary,
- more_bad_terms, otp_5484, otp_5933, ordering, unaligned_order,
- gc_test, bit_sized_binary_sizes, bitlevel_roundtrip, otp_6817, otp_8117,
- deep,obsolete_funs,robustness,otp_8180].
+ bad_list_to_binary, bad_binary_to_list, terms,
+ terms_float, external_size, t_iolist_size,
+ bad_binary_to_term_2, safe_binary_to_term2,
+ bad_binary_to_term, bad_terms, t_hash, bad_size,
+ bad_term_to_binary, more_bad_terms, otp_5484, otp_5933,
+ ordering, unaligned_order, gc_test,
+ bit_sized_binary_sizes, otp_6817, otp_8117, deep,
+ obsolete_funs, robustness, otp_8180].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?t:timetrap(?t:minutes(2)),
- [{watchdog, Dog}|Config].
+ Config.
-fin_per_testcase(_Func, Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog).
+end_per_testcase(_Func, _Config) ->
+ ok.
-define(heap_binary_size, 64).
@@ -256,12 +275,33 @@ bad_list_to_binary(Config) when is_list(Config) ->
?line test_bad_bin(fun(X, Y) -> X*Y end),
?line test_bad_bin([1,fun(X) -> X + 1 end,2|fun() -> 0 end]),
?line test_bad_bin([fun(X) -> X + 1 end]),
+
+ %% Test iolists that do not fit in the address space.
+ %% Unfortunately, it would be too slow to test in a 64-bit emulator.
+ case erlang:system_info(wordsize) of
+ 4 -> huge_iolists();
+ _ -> ok
+ end.
+
+huge_iolists() ->
+ FourGigs = 1 bsl 32,
+ ?line Sizes = [FourGigs+N || N <- lists:seq(0, 64)] ++
+ [1 bsl N || N <- lists:seq(33, 37)],
+ ?line Base = <<0:(1 bsl 20)/unit:8>>,
+ [begin
+ L = build_iolist(Sz, Base),
+ ?line {'EXIT',{system_limit,_}} = (catch list_to_binary([L])),
+ ?line {'EXIT',{system_limit,_}} = (catch list_to_bitstring([L])),
+ ?line {'EXIT',{system_limit,_}} = (catch binary:list_to_bin([L])),
+ ?line {'EXIT',{system_limit,_}} = (catch iolist_to_binary(L))
+ end || Sz <- Sizes],
ok.
test_bad_bin(List) ->
{'EXIT',{badarg,_}} = (catch list_to_binary(List)),
{'EXIT',{badarg,_}} = (catch iolist_to_binary(List)),
- {'EXIT',{badarg,_}} = (catch list_to_bitstring(List)).
+ {'EXIT',{badarg,_}} = (catch list_to_bitstring(List)),
+ {'EXIT',{badarg,_}} = (catch iolist_size(List)).
bad_binary_to_list(doc) -> "Tries binary_to_list/1,3 with bad arguments.";
bad_binary_to_list(Config) when is_list(Config) ->
@@ -438,12 +478,17 @@ terms(Config) when is_list(Config) ->
Sz when is_integer(Sz), size(Bin) =< Sz ->
ok
end,
+ Bin1 = term_to_binary(Term, [{minor_version, 1}]),
+ case erlang:external_size(Bin1, [{minor_version, 1}]) of
+ Sz1 when is_integer(Sz1), size(Bin1) =< Sz1 ->
+ ok
+ end,
Term = binary_to_term(Bin),
- Term = erlang:binary_to_term(Bin, [safe]),
+ Term = binary_to_term(Bin, [safe]),
Unaligned = make_unaligned_sub_binary(Bin),
Term = binary_to_term(Unaligned),
- Term = erlang:binary_to_term(Unaligned, []),
- Term = erlang:binary_to_term(Bin, [safe]),
+ Term = binary_to_term(Unaligned, []),
+ Term = binary_to_term(Bin, [safe]),
BinC = erlang:term_to_binary(Term, [compressed]),
Term = binary_to_term(BinC),
true = size(BinC) =< size(Bin),
@@ -470,7 +515,12 @@ terms_float(Config) when is_list(Config) ->
Term = binary_to_term(Bin0),
Bin1 = term_to_binary(Term, [{minor_version,1}]),
Term = binary_to_term(Bin1),
- true = size(Bin1) < size(Bin0)
+ true = size(Bin1) < size(Bin0),
+ Size0 = erlang:external_size(Term),
+ Size00 = erlang:external_size(Term, [{minor_version, 0}]),
+ Size1 = erlang:external_size(Term, [{minor_version, 1}]),
+ true = (Size0 =:= Size00),
+ true = Size1 < Size0
end).
external_size(Config) when is_list(Config) ->
@@ -486,7 +536,9 @@ external_size(Config) when is_list(Config) ->
io:format(" Aligned size: ~p\n", [Sz1]),
io:format("Unaligned size: ~p\n", [Sz2]),
?line ?t:fail()
- end.
+ end,
+ ?line erlang:external_size(Bin) =:= erlang:external_size(Bin, [{minor_version, 1}]),
+ ?line erlang:external_size(Unaligned) =:= erlang:external_size(Unaligned, [{minor_version, 1}]).
external_size_1(Term, Size0, Limit) when Size0 < Limit ->
case erlang:external_size(Term) of
@@ -497,18 +549,65 @@ external_size_1(Term, Size0, Limit) when Size0 < Limit ->
external_size_1(_, _, _) -> ok.
t_iolist_size(Config) when is_list(Config) ->
- %% Build a term whose external size only fits in a big num (on 32-bit CPU).
- Bin = iolist_to_binary(lists:seq(0, 254)),
- ?line ok = t_iolist_size_1(Bin, 0, 16#7FFFFFFF),
- ?line ok = t_iolist_size_1(make_unaligned_sub_binary(Bin), 0, 16#7FFFFFFF).
+ ?line Seed = now(),
+ ?line io:format("Seed: ~p", [Seed]),
+ ?line random:seed(Seed),
+ ?line Base = <<0:(1 bsl 20)/unit:8>>,
+ ?line Powers = [1 bsl N || N <- lists:seq(2, 37)],
+ ?line Sizes0 = [[N - random:uniform(N div 2),
+ lists:seq(N-2, N+2),
+ N+N div 2,
+ N + random:uniform(N div 2)] ||
+ N <- Powers],
+ %% Test sizes around 1^32 more thoroughly.
+ FourGigs = 1 bsl 32,
+ ?line Sizes1 = [FourGigs+N || N <- lists:seq(-8, 40)] ++ Sizes0,
+ ?line Sizes2 = lists:flatten(Sizes1),
+ ?line Sizes = lists:usort(Sizes2),
+ io:format("~p sizes:", [length(Sizes)]),
+ io:format("~p\n", [Sizes]),
+ ?line [Sz = iolist_size(build_iolist(Sz, Base)) || Sz <- Sizes],
+ ok.
-t_iolist_size_1(IOList, Size0, Limit) when Size0 < Limit ->
- case iolist_size(IOList) of
- Size when is_integer(Size), Size0 < Size ->
- io:format("~p", [Size]),
- t_iolist_size_1([IOList|IOList], Size, Limit)
+build_iolist(N, Base) when N < 16 ->
+ case random:uniform(3) of
+ 1 ->
+ <<Bin:N/binary,_/binary>> = Base,
+ Bin;
+ _ ->
+ lists:seq(1, N)
+ end;
+build_iolist(N, Base) when N =< byte_size(Base) ->
+ case random:uniform(3) of
+ 1 ->
+ <<Bin:N/binary,_/binary>> = Base,
+ Bin;
+ 2 ->
+ <<Bin:N/binary,_/binary>> = Base,
+ [Bin];
+ 3 ->
+ case N rem 2 of
+ 0 ->
+ L = build_iolist(N div 2, Base),
+ [L,L];
+ 1 ->
+ L = build_iolist(N div 2, Base),
+ [L,L,45]
+ end
end;
-t_iolist_size_1(_, _, _) -> ok.
+build_iolist(N0, Base) ->
+ Small = random:uniform(15),
+ Seq = lists:seq(1, Small),
+ N = N0 - Small,
+ case N rem 2 of
+ 0 ->
+ L = build_iolist(N div 2, Base),
+ [L,L|Seq];
+ 1 ->
+ L = build_iolist(N div 2, Base),
+ [47,L,L|Seq]
+ end.
+
bad_binary_to_term_2(doc) -> "OTP-4053.";
bad_binary_to_term_2(suite) -> [];
@@ -543,7 +642,7 @@ bad_bin_to_term(BadBin) ->
{'EXIT',{badarg,_}} = (catch binary_to_term(BadBin)).
bad_bin_to_term(BadBin,Opts) ->
- {'EXIT',{badarg,_}} = (catch erlang:binary_to_term(BadBin,Opts)).
+ {'EXIT',{badarg,_}} = (catch binary_to_term(BadBin,Opts)).
safe_binary_to_term2(doc) -> "Test safety options for binary_to_term/2";
safe_binary_to_term2(Config) when is_list(Config) ->
@@ -554,7 +653,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 = erlang:binary_to_term(<<131,100,0,15,"fullsweep_after">>, [safe]), % should be a good atom
+ ?line fullsweep_after = binary_to_term(<<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.
@@ -1042,7 +1141,7 @@ test_terms(Test_Func) ->
?line Test_Func(F = fun(A) -> 42*A end),
?line Test_Func(lists:duplicate(32, F)),
- ?line Test_Func(FF = fun binary_SUITE:all/1),
+ ?line Test_Func(FF = fun binary_SUITE:all/0),
?line Test_Func(lists:duplicate(32, FF)),
ok.
@@ -1150,35 +1249,6 @@ bsbs_1(A) ->
Bin = binary_to_term(<<131,$M,5:32,A,0,0,0,0,0>>),
BinSize = bit_size(Bin).
-bitlevel_roundtrip(Config) when is_list(Config) ->
- case ?t:is_release_available("r11b") of
- true -> bitlevel_roundtrip_1();
- false -> {skip,"No R11B found"}
- end.
-
-bitlevel_roundtrip_1() ->
- Name = bitlevelroundtrip,
- ?line N = list_to_atom(atom_to_list(Name) ++ "@" ++ hostname()),
- ?line ?t:start_node(Name, slave, [{erl,[{release,"r11b"}]}]),
-
- ?line {<<128>>,1} = roundtrip(N, <<1:1>>),
- ?line {<<64>>,2} = roundtrip(N, <<1:2>>),
- ?line {<<16#E0>>,3} = roundtrip(N, <<7:3>>),
- ?line {<<16#70>>,4} = roundtrip(N, <<7:4>>),
- ?line {<<16#10>>,5} = roundtrip(N, <<2:5>>),
- ?line {<<16#8>>,6} = roundtrip(N, <<2:6>>),
- ?line {<<16#2>>,7} = roundtrip(N, <<1:7>>),
- ?line {<<8,128>>,1} = roundtrip(N, <<8,1:1>>),
- ?line {<<42,248>>,5} = roundtrip(N, <<42,31:5>>),
-
- ?line ?t:stop_node(N),
- ok.
-
-roundtrip(Node, Term) ->
- {badrpc,{'EXIT',Res}} = rpc:call(Node, erlang, exit, [Term]),
- io:format("<<~p bits>> => ~w", [bit_size(Term),Res]),
- Res.
-
deep(Config) when is_list(Config) ->
?line deep_roundtrip(lists:foldl(fun(E, A) ->
[E,A]
@@ -1193,34 +1263,7 @@ deep(Config) when is_list(Config) ->
deep_roundtrip(T) ->
B = term_to_binary(T),
- true = deep_eq(T, binary_to_term(B)).
-
-%%
-%% FIXME: =:= runs out of stack.
-%%
-deep_eq([H1|T1], [H2|T2]) ->
- deep_eq(H1, H2) andalso deep_eq(T1, T2);
-deep_eq(T1, T2) when tuple_size(T1) =:= tuple_size(T2) ->
- deep_eq_tup(T1, T2, tuple_size(T1));
-deep_eq(T1, T2) when is_function(T1), is_function(T2) ->
- {uniq,U1} = erlang:fun_info(T1, uniq),
- {index,I1} = erlang:fun_info(T1, index),
- {arity,A1} = erlang:fun_info(T1, arity),
- {env,E1} = erlang:fun_info(T1, env),
- {uniq,U2} = erlang:fun_info(T2, uniq),
- {index,I2} = erlang:fun_info(T2, index),
- {arity,A2} = erlang:fun_info(T2, arity),
- {env,E2} = erlang:fun_info(T2, env),
- U1 =:= U2 andalso I1 =:= I2 andalso A1 =:= A2 andalso
- deep_eq(E1, E2);
-deep_eq(T1, T2) ->
- T1 =:= T2.
-
-deep_eq_tup(_T1, _T2, 0) ->
- true;
-deep_eq_tup(T1, T2, N) ->
- deep_eq(element(N, T1), element(N, T2)) andalso
- deep_eq_tup(T1, T2, N-1).
+ T = binary_to_term(B).
obsolete_funs(Config) when is_list(Config) ->
erts_debug:set_internal_state(available_internal_state, true),
@@ -1331,11 +1374,4 @@ unaligned_sub_bin(Bin0, Offs) ->
<<_:Offs,Bin:Sz/binary,_:Roffs>> = id(Bin1),
Bin.
-hostname() ->
- from($@, atom_to_list(node())).
-
-from(H, [H | T]) -> T;
-from(H, [_ | T]) -> from(H, T);
-from(_, []) -> [].
-
id(I) -> I.
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-09 10:35:07 +0000