%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2004-2012. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%% http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% %CopyrightEnd%
%%
%%% While similar to bs_construct_SUITE in the emulator test suite,
%%% this module is more corncerned with testing sizes than the contents
%%% of binaries.
-module(bs_construct_SUITE).
-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,
two/1,test1/1,fail/1,float_bin/1,in_guard/1,in_catch/1,
nasty_literals/1,coerce_to_float/1,side_effect/1,
opt/1,otp_7556/1,float_arith/1,otp_8054/1]).
-include_lib("common_test/include/ct.hrl").
suite() ->
[{ct_hooks,[ts_install_cth]},
{timetrap,{minutes,1}}].
all() ->
test_lib:recompile(?MODULE),
[{group,p}].
groups() ->
[{p,[parallel],
[two,test1,fail,float_bin,in_guard,in_catch,
nasty_literals,side_effect,opt,otp_7556,float_arith,
otp_8054]}].
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(Case, Config) when is_atom(Case), is_list(Config) ->
Config.
end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
ok.
two(Config) when is_list(Config) ->
<<0,1,2,3,4,6,7,8,9>> = two_1([0], [<<1,2,3,4>>,<<6,7,8,9>>]),
ok.
two_1(P, L) ->
list_to_binary([P|L]).
big(1) ->
57285702734876389752897683.
i(X) -> X.
id(I) -> I.
-define(T(B, L), {B, ??B, L}).
-define(N(B), {B, ??B, unknown}).
-define(FAIL(Expr), {'EXIT',{badarg,_}} = (catch Expr)).
l(I_13, I_big1, I_16, Bin) ->
[
?T(<<I_13:0>>,
[]),
?T(<<-43>>,
[256-43]),
?T(<<4:4,7:4>>,
[4*16+7]),
?T(<<45:I_16/little>>,
[45,0]),
?T(<<777:16/little>>,
[9,3]),
?T(<<777:I_13,13:3>>,
[24,77]),
?T(<<5:4,987:I_13,537:7>>,
[81,237,153]),
?T(<<0.0:32/float>>,
[0,0,0,0]),
?T(<<0.125:32/float>>,
[62,0,0,0]),
?T(<<1.0:32/little-float>>,
[0,0,128,63]),
?T(<<I_big1:32>>,
[138,99,0,147]),
?T(<<57285702734876389752897684:(I_16+16)>>,
[138,99,0,148]),
?T(<<-1:17/unit:8>>,
lists:duplicate(17, 255)),
?T(<<-1:8/unit:17>>,
lists:duplicate(17, 255)),
?T(<<4:(I_16-8)/unit:2,5:2/unit:8>>,
[0,4,0,5]),
?T(<<1:1, 0:(I_13-7), 1:1>>,
[129]),
?T(<<1:3,"string",9:5>>,
[46,110,142,77,45,204,233]),
?T(<<37.98:64/native-float>>,
native_3798()),
?T(<<32978297842987249827298387697777669766334937:128/native-integer>>,
native_bignum()),
?T(<<Bin/binary>>,
[165,90,195]),
?T(<<79,Bin/binary>>,
[79,165,90,195]),
?T(<<3479:I_13,Bin/binary,7:3>>,
[108,189,42,214,31]),
?T(<<3479:I_13,Bin/binary,7:1/unit:3>>,
[108,189,42,214,31]),
?T(<<869:16/little,3479:I_13,Bin/binary,7:1/unit:3>>,
[101,3,108,189,42,214,31]),
?T(<<869:16/little,3479:I_13,Bin/binary,7:1/unit:3,Bin/binary>>,
[101,3,108,189,42,214,31,165,90,195]),
%% Test of aligment flag.
?T(<<0:I_13/unit:8,1:6,0:2>>,
[0,0,0,0,0,0,0,0,0,0,0,0,0,4]),
%% Test of literals (coverage).
?T(<<0:128>>,[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]),
?T(<<0:13/little,7:3>>,[0,7]),
?T(<<16#77FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF:264>>,
[0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,
16#77,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,
16#FF,16#FF,16#FF,16#FF,16#FF,16#FF]),
%% Mix different units.
?T(<<37558955:(I_16-12)/unit:8,1:1>>,
[2,61,26,171,<<1:1>>])
].
native_3798() ->
case <<1:16/native>> of
<<0,1>> -> [64,66,253,112,163,215,10,61];
<<1,0>> -> [61,10,215,163,112,253,66,64]
end.
native_bignum() ->
case <<1:16/native>> of
<<0,1>> -> [129,205,18,177,1,213,170,101,39,231,109,128,176,11,73,217];
<<1,0>> -> [217,73,11,176,128,109,231,39,101,170,213,1,177,18,205,129]
end.
evaluate(Str, Vars) ->
{ok,Tokens,_} =
erl_scan:string(Str ++ " . "),
{ok, [Expr]} = erl_parse:parse_exprs(Tokens),
case erl_eval:expr(Expr, Vars) of
{value, Result, _} ->
Result
end.
eval_list([], _Vars) ->
[];
eval_list([{C_bin, Str, Bytes} | Rest], Vars) ->
case catch evaluate(Str, Vars) of
{'EXIT', Error} ->
io:format("Evaluation error: ~p, ~p, ~p~n", [Str, Vars, Error]),
exit(Error);
E_bin ->
[{C_bin, E_bin, Str, Bytes} | eval_list(Rest, Vars)]
end.
one_test({C_bin, E_bin, Str, Bytes}) when is_list(Bytes) ->
io:format(" ~s, ~p~n", [Str, Bytes]),
Bin = list_to_bitstring(Bytes),
if
C_bin == Bin ->
ok;
true ->
io:format("ERROR: Compiled: ~p. Expected ~p. Got ~p.~n",
[Str, Bytes, bitstring_to_list(C_bin)]),
ct:fail(comp)
end,
if
E_bin == Bin ->
ok;
true ->
io:format("ERROR: Interpreted: ~p. Expected ~p. Got ~p.~n",
[Str, Bytes, bitstring_to_list(E_bin)]),
ct:fail(comp)
end;
one_test({C_bin, E_bin, Str, Result}) ->
io:format(" ~s ~p~n", [Str, C_bin]),
if
C_bin == E_bin ->
ok;
true ->
Arbitrary = case Result of
unknown ->
size(C_bin);
_ ->
Result
end,
case equal_lists(bitstring_to_list(C_bin),
bitstring_to_list(E_bin),
Arbitrary) of
false ->
io:format("ERROR: Compiled not equal to interpreted:"
"~n ~p, ~p.~n",
[bitstring_to_list(C_bin), bitstring_to_list(E_bin)]),
ct:fail(comp);
0 ->
ok;
%% For situations where the final bits may not matter, like
%% for floats:
N when is_integer(N) ->
io:format("Info: compiled and interpreted differ in the"
" last bytes:~n ~p, ~p.~n",
[bitstring_to_list(C_bin), bitstring_to_list(E_bin)]),
ok
end
end.
equal_lists([], [], _) ->
0;
equal_lists([], _, _) ->
false;
equal_lists(_, [], _) ->
false;
equal_lists([A|AR], [A|BR], R) ->
equal_lists(AR, BR, R);
equal_lists(A, B, R) ->
if
length(A) /= length(B) ->
false;
length(A) =< R ->
R;
true ->
false
end.
test1(Config) when is_list(Config) ->
I_13 = i(13),
I_big1 = big(1),
I_16 = i(16),
Bin = i(<<16#A5,16#5A,16#C3>>),
Vars = lists:sort([{'I_13',I_13},
{'I_big1',I_big1},
{'I_16',I_16},
{'Bin',Bin}]),
lists:foreach(fun one_test/1, eval_list(l(I_13, I_big1, I_16, Bin), Vars)).
fail(Config) when is_list(Config) ->
I_minus_777 = i(-777),
I_minus_2047 = i(-2047),
%% One negative field size, but the sum of field sizes will be 1 byte.
%% Make sure that we reject that properly.
{'EXIT',{badarg,_}} = (catch <<I_minus_777:2048/unit:8,
57:I_minus_2047/unit:8>>),
%% Same thing, but use literals.
{'EXIT',{badarg,_}} = (catch <<I_minus_777:2048/unit:8,
57:(-2047)/unit:8>>),
%% Not numbers.
{'EXIT',{badarg,_}} = (catch <<45:(i(not_a_number))>>),
{'EXIT',{badarg,_}} = (catch <<13:8,45:(i(not_a_number))>>),
%% Unaligned sizes.
BadSz = i(7),
Bitstr = i(<<42:17>>),
{'EXIT',{badarg,_}} = (catch <<Bitstr:4/binary>>),
{'EXIT',{badarg,_}} = (catch <<Bitstr:BadSz/binary>>),
[] = [X || {X} <- [], X == <<Bitstr:BadSz/binary>>],
[] = [X || {X} <- [], X == <<Bitstr:4/binary>>],
%% Literals with incorrect type.
{'EXIT',{badarg,_}} = (catch <<42.0/integer>>),
{'EXIT',{badarg,_}} = (catch <<42/binary>>),
{'EXIT',{badarg,_}} = (catch <<an_atom/integer>>),
ok.
float_bin(Config) when is_list(Config) ->
%% Some more coverage.
{<<1,2,3>>,7.0} = float_bin_1(4),
F = 42.0,
<<42,0,0,0,0,0,0,69,64>> = <<(id(42)),F/little-float>>,
ok.
float_bin_1(F) ->
{<<1,2,3>>,F+3.0}.
in_guard(Config) when is_list(Config) ->
1 = in_guard_1(<<16#74ad:16>>, 16#e95, 5),
2 = in_guard_1(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>),
3 = in_guard_1(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415),
3 = in_guard_1(<<16#FBCD:14,3/float,3:2>>, 16#FBCD, 3),
3 = in_guard_1(<<16#FBCD:14,(2 bsl 226)/float,3:2>>, 16#FBCD, 2 bsl 226),
nope = in_guard_1(<<1>>, 42, b),
nope = in_guard_1(<<1>>, a, b),
nope = in_guard_1(<<1,2>>, 1, 1),
nope = in_guard_1(<<4,5>>, 1, 2.71),
nope = in_guard_1(<<4,5>>, 1, <<12,13>>),
1 = in_guard_2(<<0,56>>, 7, blurf),
2 = in_guard_2(<<1,255>>, 511, blurf),
3 = in_guard_2(<<0,3>>, 0, blurf),
4 = in_guard_2(<<>>, 1, {<<7:16>>}),
nope = in_guard_2(<<4,5>>, 1, blurf),
42 = in_guard_3(<<1,2,3,42>>, <<1,2,3>>),
42 = in_guard_3(<<1,2,3,42>>, <<1,2,3>>),
nope = in_guard_3(<<>>, <<>>),
ok = in_guard_4(<<15:4>>, 255),
nope = in_guard_4(<<15:8>>, 255),
ok.
in_guard_1(Bin, A, B) when <<A:13,B:3>> == Bin -> 1;
in_guard_1(Bin, A, B) when <<A:16,B/binary>> == Bin -> 2;
in_guard_1(Bin, A, B) when <<A:14,B/float,3:2>> == Bin -> 3;
in_guard_1(Bin, A, B) when {a,b,<<A:14,B/float,3:2>>} == Bin -> cant_happen;
in_guard_1(_, _, _) -> nope.
in_guard_2(Bin, A, _T) when <<A:13,0:3>> == Bin -> 1;
in_guard_2(Bin, A, _T) when <<A:16>> == Bin -> 2;
in_guard_2(Bin, A, _T) when <<A:14,3:2>> == Bin -> 3;
in_guard_2(_Bin, A, T) when {A,b} > {0,1}, {<<A:14,3:2>>} == T -> 4;
in_guard_2(_, _, _) -> nope.
in_guard_3(Bin, A) when <<A/binary,42>> =:= Bin -> 42;
in_guard_3(_, _) -> nope.
in_guard_4(Bin, A) when <<A:4>> =:= Bin -> ok;
in_guard_4(_, _) -> nope.
in_catch(Config) when is_list(Config) ->
<<42,0,5>> = small(42, 5),
<<255>> = small(255, <<1,2,3,4,5,6,7,8,9>>),
<<1,2>> = small(<<7,8,9,10>>, 258),
<<>> = small(<<1,2,3,4,5>>, <<7,8,9,10>>),
<<15,240,0,42>> = small2(255, 42),
<<7:20>> = small2(<<1,2,3>>, 7),
<<300:12>> = small2(300, <<1,2,3>>),
<<>> = small2(<<1>>, <<2>>),
ok.
small(A, B) ->
case begin
case catch <<A:8>> of
{'EXIT',_} -> <<>>;
ResA0 -> ResA0
end
end of
ResA -> ok
end,
case begin
case catch <<B:16>> of
{'EXIT',_} -> <<>>;
ResB0 -> ResB0
end
end of
ResB -> ok
end,
<<ResA/binary,ResB/binary>>.
small2(A, B) ->
case begin
case catch <<A:12>> of
{'EXIT',_} -> <<>>;
ResA0 -> ResA0
end
end of
ResA -> ok
end,
case begin
case catch <<B:20>> of
{'EXIT',_} -> <<>>;
ResB0 -> ResB0
end
end of
ResB -> ok
end,
<<ResA/binary-unit:1,ResB/binary-unit:1>>.
nasty_literals(Config) when is_list(Config) ->
case erlang:system_info(endian) of
big ->
[0,42] = binary_to_list(id(<<42:16/native>>));
little ->
[42,0] = binary_to_list(id(<<42:16/native>>))
end,
Bin0 = id(<<1,2,3,0:10000000,4,5,6>>),
1250006 = size(Bin0),
<<1,2,3,0:10000000,4,5,6>> = Bin0,
Bin1 = id(<<0:10000000,7,8,-1:10000000,9,10,0:10000000>>),
3750004 = size(Bin1),
<<0:10000000,7,8,-1:10000000/signed,9,10,0:10000000>> = Bin1,
<<255,255,0,0,0>> = id(<<255,255,0,0,0>>),
%% Coverage.
I = 16#7777FFFF7777FFFF7777FFFF7777FFFF7777FFFF7777FFFF,
id(<<I:260>>),
ok.
-define(COF(Int0),
(fun(Int) ->
true = <<Int:32/float>> =:= <<(float(Int)):32/float>>,
true = <<Int:64/float>> =:= <<(float(Int)):64/float>>
end)(nonliteral(Int0)),
true = <<Int0:32/float>> =:= <<(float(Int0)):32/float>>,
true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>).
-define(COF64(Int0),
(fun(Int) ->
true = <<Int:64/float>> =:= <<(float(Int)):64/float>>
end)(nonliteral(Int0)),
true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>).
nonliteral(X) -> X.
coerce_to_float(Config) when is_list(Config) ->
?COF(0),
?COF(-1),
?COF(1),
?COF(42),
?COF(255),
?COF(-255),
?COF(38474),
?COF(387498738948729893849444444443),
?COF(-37489378937773899999999999999993),
?COF64(298748888888888888888888888883478264866528467367364766666666666666663),
?COF64(-367546729879999999999947826486652846736736476555566666663),
ok.
side_effect(Config) when is_list(Config) ->
{'EXIT',{badarg,_}} = (catch side_effect_1(a)),
{'EXIT',{badarg,_}} = (catch side_effect_1(<<>>)),
ok = side_effect_1(42),
ok.
side_effect_1(A) ->
<<A:17>>, %Warning intentional.
ok.
-record(otp_7029, {a,b}).
opt(Config) when is_list(Config) ->
42 = otp_7029(#otp_7029{a = <<>>,b = 42}),
N = 16,
<<1,3,65>> = id(<<1,833:N>>),
<<1,66,3>> = id(<<1,834:N/little>>),
<<1,65,136,0,0>> = id(<<1,17.0:32/float>>),
<<1,64,8,0,0,0,0,0,0>> = id(<<1,3.0:N/float-unit:4>>),
<<1,0,0,0,0,0,0,8,64>> = id(<<1,3.0:N/little-float-unit:4>>),
{'EXIT',{badarg,_}} = (catch id(<<3.1416:N/float>>)),
B = <<1,2,3,4,5>>,
<<0,1,2,3,4,5>> = id(<<0,B/binary>>),
<<1,2,3,4,5,19>> = id(<<B:5/binary,19>>),
<<1,2,3,42>> = id(<<B:3/binary,42>>),
{'EXIT',_} = (catch <<<<23,56,0,2>>:(2.5)/binary>>),
{'EXIT',_} = (catch <<<<23,56,0,2>>:(-16)/binary>>),
{'EXIT',_} = (catch <<<<23,56,0,2>>:(anka)>>),
{'EXIT',_} = (catch <<<<23,56,0,2>>:64/float>>),
{'EXIT',_} = (catch <<<<23,56,0,2:7>>/binary>>),
%% Test constant propagation - there should be a warning.
BadSz = 2.5,
{'EXIT',_} = (catch <<<<N,56,0,2>>:BadSz/binary>>),
case id(false) of
true -> opt_dont_call_me();
false -> ok
end,
ok.
opt_dont_call_me() ->
N = 16#12345678,
<<0:N>>.
otp_7029(R) ->
#otp_7029{a = <<>>} = R,
R#otp_7029.b.
otp_7556(Config) when is_list(Config) ->
[otp_7556(<<>>, 1024, 1024, 1024) || _ <- lists:seq(0, 1023)],
ok.
otp_7556(Bin, A, B, C) ->
%% When allocating the binary, the sizes 16*A and 16*A would
%% be forgotten.
<<Bin/binary,(-1):A/unit:16,0:B/unit:16,(-1):C/unit:16>>.
%% Test binary construction combined with floating point operations
%% (mostly to cover code in beam_flatten that combines the allocation
%% for a binary construction with a later allocation).
float_arith(Config) when is_list(Config) ->
{<<1,2,3,64,69,0,0,0,0,0,0>>,21.0} = do_float_arith(<<1,2,3>>, 42, 2),
ok.
do_float_arith(Bin0, X, Y) ->
Bin = <<Bin0/binary,X/float>>,
{Bin,X / Y}.
otp_8054(Config) when is_list(Config) ->
<<"abc">> = otp_8054_1([null,1,2,3], <<"abc">>),
ok.
otp_8054_1([H|T], Bin) ->
_ = case H of
null ->
%% The beam_validator would complain about {x,3}
%% not being live in bs_append/8 because of a live
%% optimization bug.
<<Bin/binary>>;
_ ->
ok
end,
otp_8054_1(T, Bin);
otp_8054_1([], Bin) -> Bin.
