From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/compiler/test/bs_construct_SUITE.erl | 499 +++++++++++++++++++++++++++++++ 1 file changed, 499 insertions(+) create mode 100644 lib/compiler/test/bs_construct_SUITE.erl (limited to 'lib/compiler/test/bs_construct_SUITE.erl') diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl new file mode 100644 index 0000000000..1862a28bbe --- /dev/null +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -0,0 +1,499 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2009. 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 +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights 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/1,init_per_testcase/2,fin_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("test_server.hrl"). + +all(suite) -> + test_lib:recompile(?MODULE), + [two,test1,fail,float_bin,in_guard,in_catch,nasty_literals, + side_effect,opt,otp_7556,float_arith,otp_8054]. + +init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + Dog = test_server:timetrap(?t:minutes(1)), + [{watchdog,Dog}|Config]. + +fin_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + 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), ?line {'EXIT',{badarg,_}} = (catch Expr)). + +l(I_13, I_big1, I_16, Bin) -> + [ + ?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(<>, + [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(<>, + [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)]), + test_server: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)]), + test_server: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)]), + test_server:fail(comp); + 0 -> + ok; + %% For situations where the final bits may not matter, like + %% for floats: + N when 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) -> + ?line I_13 = i(13), + ?line I_big1 = big(1), + ?line I_16 = i(16), + ?line Bin = i(<<16#A5,16#5A,16#C3>>), + ?line Vars = lists:sort([{'I_13',I_13}, + {'I_big1',I_big1}, + {'I_16',I_16}, + {'Bin',Bin}]), + ?line 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. + + ?line {'EXIT',{badarg,_}} = (catch <>), + + %% Same thing, but use literals. + ?line {'EXIT',{badarg,_}} = (catch <>), + + %% Not numbers. + ?line {'EXIT',{badarg,_}} = (catch <<45:(i(not_a_number))>>), + ?line {'EXIT',{badarg,_}} = (catch <<13:8,45:(i(not_a_number))>>), + + %% Unaligned sizes. + BadSz = i(7), + Bitstr = i(<<42:17>>), + + ?line {'EXIT',{badarg,_}} = (catch <>), + ?line {'EXIT',{badarg,_}} = (catch <>), + + ?line [] = [X || {X} <- [], X == <>], + ?line [] = [X || {X} <- [], X == <>], + + %% Literals with incorrect type. + ?line {'EXIT',{badarg,_}} = (catch <<42.0/integer>>), + ?line {'EXIT',{badarg,_}} = (catch <<42/binary>>), + ?line {'EXIT',{badarg,_}} = (catch <>), + + ok. + +float_bin(Config) when is_list(Config) -> + %% Some more coverage. + ?line {<<1,2,3>>,7.0} = float_bin_1(4), + F = 42.0, + ?line <<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) -> + ?line 1 = in_guard_1(<<16#74ad:16>>, 16#e95, 5), + ?line 2 = in_guard_1(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>), + ?line 3 = in_guard_1(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415), + ?line nope = in_guard_1(<<1>>, 42, b), + ?line nope = in_guard_1(<<1>>, a, b), + ?line nope = in_guard_1(<<1,2>>, 1, 1), + ?line nope = in_guard_1(<<4,5>>, 1, 2.71), + ?line nope = in_guard_1(<<4,5>>, 1, <<12,13>>), + + ?line 1 = in_guard_2(<<0,56>>, 7, blurf), + ?line 2 = in_guard_2(<<1,255>>, 511, blurf), + ?line 3 = in_guard_2(<<0,3>>, 0, blurf), + ?line 4 = in_guard_2(<<>>, 1, {<<7:16>>}), + ?line nope = in_guard_2(<<4,5>>, 1, blurf), + + ?line 42 = in_guard_3(<<1,2,3,42>>, <<1,2,3>>), + ?line 42 = in_guard_3(<<1,2,3,42>>, <<1,2,3>>), + ?line nope = in_guard_3(<<>>, <<>>), + + ?line ok = in_guard_4(<<15:4>>, 255), + ?line nope = in_guard_4(<<15:8>>, 255), + ok. + +in_guard_1(Bin, A, B) when <> == Bin -> 1; +in_guard_1(Bin, A, B) when <> == Bin -> 2; +in_guard_1(Bin, A, B) when <> == Bin -> 3; +in_guard_1(Bin, A, B) when {a,b,<>} == Bin -> cant_happen; +in_guard_1(_, _, _) -> nope. + +in_guard_2(Bin, A, _T) when <> == Bin -> 1; +in_guard_2(Bin, A, _T) when <> == Bin -> 2; +in_guard_2(Bin, A, _T) when <> == Bin -> 3; +in_guard_2(_Bin, A, T) when {A,b} > {0,1}, {<>} == T -> 4; +in_guard_2(_, _, _) -> nope. + +in_guard_3(Bin, A) when <> =:= Bin -> 42; +in_guard_3(_, _) -> nope. + +in_guard_4(Bin, A) when <> =:= Bin -> ok; +in_guard_4(_, _) -> nope. + +in_catch(Config) when is_list(Config) -> + ?line <<42,0,5>> = small(42, 5), + ?line <<255>> = small(255, <<1,2,3,4,5,6,7,8,9>>), + ?line <<1,2>> = small(<<7,8,9,10>>, 258), + ?line <<>> = small(<<1,2,3,4,5>>, <<7,8,9,10>>), + ok. + +small(A, B) -> + case begin + case catch <> of + {'EXIT',_} -> <<>>; + ResA0 -> ResA0 + end + end of + ResA -> ok + end, + case begin + case catch <> of + {'EXIT',_} -> <<>>; + ResB0 -> ResB0 + end + end of + ResB -> ok + end, + <>. + +nasty_literals(Config) when is_list(Config) -> + case erlang:system_info(endian) of + big -> + ?line [0,42] = binary_to_list(id(<<42:16/native>>)); + little -> + ?line [42,0] = binary_to_list(id(<<42:16/native>>)) + end, + + ?line Bin0 = id(<<1,2,3,0:10000000,4,5,6>>), + ?line 1250006 = size(Bin0), + ?line <<1,2,3,0:10000000,4,5,6>> = Bin0, + + ?line Bin1 = id(<<0:10000000,7,8,-1:10000000,9,10,0:10000000>>), + ?line 3750004 = size(Bin1), + ?line <<0:10000000,7,8,-1:10000000/signed,9,10,0:10000000>> = Bin1, + + ?line <<255,255,0,0,0>> = id(<<255,255,0,0,0>>), + + %% Coverage. + I = 16#7777FFFF7777FFFF7777FFFF7777FFFF7777FFFF7777FFFF, + id(<>), + + ok. + +-define(COF(Int0), + ?line (fun(Int) -> + true = <> =:= <<(float(Int)):32/float>>, + true = <> =:= <<(float(Int)):64/float>> + end)(nonliteral(Int0)), + ?line true = <> =:= <<(float(Int0)):32/float>>, + ?line true = <> =:= <<(float(Int0)):64/float>>). + +-define(COF64(Int0), + ?line (fun(Int) -> + true = <> =:= <<(float(Int)):64/float>> + end)(nonliteral(Int0)), + ?line true = <> =:= <<(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(<<>>)), + ?line ok = side_effect_1(42), + ok. + +side_effect_1(A) -> + <>, %Warning intentional. + ok. + +-record(otp_7029, {a,b}). + +opt(Config) when is_list(Config) -> + ?line 42 = otp_7029(#otp_7029{a = <<>>,b = 42}), + N = 16, + ?line <<1,3,65>> = id(<<1,833:N>>), + ?line <<1,66,3>> = id(<<1,834:N/little>>), + ?line <<1,65,136,0,0>> = id(<<1,17.0:32/float>>), + ?line <<1,64,8,0,0,0,0,0,0>> = id(<<1,3.0:N/float-unit:4>>), + ?line <<1,0,0,0,0,0,0,8,64>> = id(<<1,3.0:N/little-float-unit:4>>), + ?line {'EXIT',{badarg,_}} = (catch id(<<3.1416:N/float>>)), + + B = <<1,2,3,4,5>>, + ?line <<0,1,2,3,4,5>> = id(<<0,B/binary>>), + ?line <<1,2,3,4,5,19>> = id(<>), + ?line <<1,2,3,42>> = id(<>), + + ?line {'EXIT',_} = (catch <<<<23,56,0,2>>:(2.5)/binary>>), + ?line {'EXIT',_} = (catch <<<<23,56,0,2>>:(-16)/binary>>), + ?line {'EXIT',_} = (catch <<<<23,56,0,2>>:(anka)>>), + ?line {'EXIT',_} = (catch <<<<23,56,0,2>>:64/float>>), + ?line {'EXIT',_} = (catch <<<<23,56,0,2:7>>/binary>>), + + case id(false) of + true -> ?line 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. + <>. + +%% 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) -> + ?line {<<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 = <>, + {Bin,X / Y}. + +otp_8054(Config) when is_list(Config) -> + ?line <<"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. + <>; + _ -> + ok + end, + otp_8054_1(T, Bin); +otp_8054_1([], Bin) -> Bin. -- cgit v1.2.3