1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2004-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21%%% While similar to bs_construct_SUITE in the emulator test suite,
22%%% this module is more corncerned with testing sizes than the contents
23%%% of binaries.
24
25-module(bs_construct_SUITE).
26
27-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
28	 init_per_group/2,end_per_group/2,
29	 init_per_testcase/2,end_per_testcase/2,
30	 two/1,test1/1,fail/1,float_bin/1,in_guard/1,in_catch/1,
31	 nasty_literals/1,coerce_to_float/1,side_effect/1,
32	 opt/1,otp_7556/1,float_arith/1,otp_8054/1,
33         cover/1]).
34
35-include_lib("common_test/include/ct.hrl").
36
37suite() ->
38    [{ct_hooks,[ts_install_cth]},
39     {timetrap,{minutes,1}}].
40
41all() ->
42    [{group,p}].
43
44groups() ->
45    [{p,[parallel],
46      [two,test1,fail,float_bin,in_guard,in_catch,
47       nasty_literals,side_effect,opt,otp_7556,float_arith,
48       otp_8054,cover]}].
49
50
51init_per_suite(Config) ->
52    test_lib:recompile(?MODULE),
53    Config.
54
55end_per_suite(_Config) ->
56    ok.
57
58init_per_group(_GroupName, Config) ->
59    Config.
60
61end_per_group(_GroupName, Config) ->
62    Config.
63
64
65init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
66    Config.
67
68end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
69    ok.
70
71two(Config) when is_list(Config) ->
72    <<0,1,2,3,4,6,7,8,9>> = two_1([0], [<<1,2,3,4>>,<<6,7,8,9>>]),
73    ok.
74
75two_1(P, L) ->
76    list_to_binary([P|L]).
77
78
79big(1) ->
80    57285702734876389752897683.
81
82i(X) -> X.
83
84id(I) -> I.
85
86-define(T(B, L), {B, ??B, L}).
87-define(N(B), {B, ??B, unknown}).
88
89-define(FAIL(Expr), {'EXIT',{badarg,_}} = (catch Expr)).
90
91l(I_13, I_big1, I_16, Bin) ->
92    [
93     ?T(<<I_13:0>>,
94	[]),
95     ?T(<<-43>>,
96	[256-43]),
97     ?T(<<4:4,7:4>>,
98	[4*16+7]),
99     ?T(<<45:I_16/little>>,
100        [45,0]),
101     ?T(<<777:16/little>>,
102	[9,3]),
103     ?T(<<777:I_13,13:3>>,
104        [24,77]),
105     ?T(<<5:4,987:I_13,537:7>>,
106        [81,237,153]),
107     ?T(<<0.0:32/float>>,
108	[0,0,0,0]),
109     ?T(<<0.125:32/float>>,
110	[62,0,0,0]),
111     ?T(<<1.0:32/little-float>>,
112	[0,0,128,63]),
113     ?T(<<I_big1:32>>,
114	[138,99,0,147]),
115     ?T(<<57285702734876389752897684:(I_16+16)>>,
116	[138,99,0,148]),
117     ?T(<<-1:17/unit:8>>,
118	lists:duplicate(17, 255)),
119     ?T(<<-1:8/unit:17>>,
120	lists:duplicate(17, 255)),
121     ?T(<<4:(I_16-8)/unit:2,5:2/unit:8>>,
122	[0,4,0,5]),
123     ?T(<<1:1, 0:(I_13-7), 1:1>>,
124	[129]),
125     ?T(<<1:3,"string",9:5>>,
126	[46,110,142,77,45,204,233]),
127     ?T(<<37.98:64/native-float>>,
128	native_3798()),
129     ?T(<<32978297842987249827298387697777669766334937:128/native-integer>>,
130	native_bignum()),
131
132     ?T(<<Bin/binary>>,
133        [165,90,195]),
134     ?T(<<79,Bin/binary>>,
135        [79,165,90,195]),
136     ?T(<<3479:I_13,Bin/binary,7:3>>,
137        [108,189,42,214,31]),
138     ?T(<<3479:I_13,Bin/binary,7:1/unit:3>>,
139        [108,189,42,214,31]),
140     ?T(<<869:16/little,3479:I_13,Bin/binary,7:1/unit:3>>,
141        [101,3,108,189,42,214,31]),
142     ?T(<<869:16/little,3479:I_13,Bin/binary,7:1/unit:3,Bin/binary>>,
143        [101,3,108,189,42,214,31,165,90,195]),
144
145     %% Test of aligment flag.
146     ?T(<<0:I_13/unit:8,1:6,0:2>>,
147	[0,0,0,0,0,0,0,0,0,0,0,0,0,4]),
148
149     %% Test of literals (coverage).
150     ?T(<<0:128>>,[0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]),
151     ?T(<<0:13/little,7:3>>,[0,7]),
152     ?T(<<16#77FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF:264>>,
153	[0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,
154	 16#77,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,16#FF,
155	 16#FF,16#FF,16#FF,16#FF,16#FF,16#FF]),
156
157     %% Mix different units.
158     ?T(<<37558955:(I_16-12)/unit:8,1:1>>,
159	[2,61,26,171,<<1:1>>])
160     ].
161
162native_3798() ->
163    case <<1:16/native>> of
164	<<0,1>> -> [64,66,253,112,163,215,10,61];
165	<<1,0>> -> [61,10,215,163,112,253,66,64]
166    end.
167
168native_bignum() ->
169    case <<1:16/native>> of
170	<<0,1>> -> [129,205,18,177,1,213,170,101,39,231,109,128,176,11,73,217];
171	<<1,0>> -> [217,73,11,176,128,109,231,39,101,170,213,1,177,18,205,129]
172    end.
173
174evaluate(Str, Vars) ->
175    {ok,Tokens,_} =
176	erl_scan:string(Str ++ " . "),
177    {ok, [Expr]} = erl_parse:parse_exprs(Tokens),
178    case erl_eval:expr(Expr, Vars) of
179	{value, Result, _} ->
180	    Result
181    end.
182
183eval_list([], _Vars) ->
184    [];
185eval_list([{C_bin, Str, Bytes} | Rest], Vars) ->
186    case catch evaluate(Str, Vars) of
187	{'EXIT', Error} ->
188	    io:format("Evaluation error: ~p, ~p, ~p~n", [Str, Vars, Error]),
189	    exit(Error);
190	E_bin ->
191	    [{C_bin, E_bin, Str, Bytes} | eval_list(Rest, Vars)]
192    end.
193
194one_test({C_bin, E_bin, Str, Bytes}) when is_list(Bytes) ->
195    io:format("  ~s, ~p~n", [Str, Bytes]),
196    Bin = list_to_bitstring(Bytes),
197    if
198	C_bin == Bin ->
199	    ok;
200	true ->
201	    io:format("ERROR: Compiled: ~p. Expected ~p. Got ~p.~n",
202		      [Str, Bytes, bitstring_to_list(C_bin)]),
203	    ct:fail(comp)
204    end,
205    if
206	E_bin == Bin ->
207	    ok;
208	true ->
209	    io:format("ERROR: Interpreted: ~p. Expected ~p. Got ~p.~n",
210		      [Str, Bytes, bitstring_to_list(E_bin)]),
211	    ct:fail(comp)
212    end;
213one_test({C_bin, E_bin, Str, Result}) ->
214    io:format("  ~s ~p~n", [Str, C_bin]),
215    if
216	C_bin == E_bin ->
217	    ok;
218	true ->
219	    Arbitrary = case Result of
220			    unknown ->
221				size(C_bin);
222			    _ ->
223				Result
224			end,
225	    case equal_lists(bitstring_to_list(C_bin),
226			     bitstring_to_list(E_bin),
227			     Arbitrary) of
228		false ->
229		    io:format("ERROR: Compiled not equal to interpreted:"
230			      "~n ~p, ~p.~n",
231			      [bitstring_to_list(C_bin), bitstring_to_list(E_bin)]),
232		    ct:fail(comp);
233		0 ->
234		    ok;
235		%% For situations where the final bits may not matter, like
236		%% for floats:
237		N when is_integer(N) ->
238		    io:format("Info: compiled and interpreted differ in the"
239			      " last bytes:~n ~p, ~p.~n",
240			      [bitstring_to_list(C_bin), bitstring_to_list(E_bin)]),
241		    ok
242	    end
243    end.
244
245equal_lists([], [], _) ->
246    0;
247equal_lists([], _, _) ->
248    false;
249equal_lists(_, [], _) ->
250    false;
251equal_lists([A|AR], [A|BR], R) ->
252    equal_lists(AR, BR, R);
253equal_lists(A, B, R) ->
254    if
255	length(A) /= length(B) ->
256	    false;
257	length(A) =< R ->
258	    R;
259	true ->
260	    false
261    end.
262
263test1(Config) when is_list(Config) ->
264    I_13 = i(13),
265    I_big1 = big(1),
266    I_16 = i(16),
267    Bin = i(<<16#A5,16#5A,16#C3>>),
268    Vars = lists:sort([{'I_13',I_13},
269		       {'I_big1',I_big1},
270		       {'I_16',I_16},
271		       {'Bin',Bin}]),
272    lists:foreach(fun one_test/1, eval_list(l(I_13, I_big1, I_16, Bin), Vars)).
273
274fail(Config) when is_list(Config) ->
275    I_minus_777 = i(-777),
276    I_minus_2047 = i(-2047),
277
278    %% One negative field size, but the sum of field sizes will be 1 byte.
279    %% Make sure that we reject that properly.
280
281    {'EXIT',{badarg,_}} = (catch <<I_minus_777:2048/unit:8,
282				   57:I_minus_2047/unit:8>>),
283
284    %% Same thing, but use literals.
285    {'EXIT',{badarg,_}} = (catch <<I_minus_777:2048/unit:8,
286				   57:(-2047)/unit:8>>),
287
288    %% Not numbers.
289    {'EXIT',{badarg,_}} = (catch <<45:(i(not_a_number))>>),
290    {'EXIT',{badarg,_}} = (catch <<13:8,45:(i(not_a_number))>>),
291
292    %% Unaligned sizes.
293    BadSz = i(7),
294    Bitstr = i(<<42:17>>),
295
296    {'EXIT',{badarg,_}} = (catch <<Bitstr:4/binary>>),
297    {'EXIT',{badarg,_}} = (catch <<Bitstr:BadSz/binary>>),
298
299    [] = [X || {X} <- [], X == <<Bitstr:BadSz/binary>>],
300    [] = [X || {X} <- [], X == <<Bitstr:4/binary>>],
301
302    %% Literals with incorrect type.
303    {'EXIT',{badarg,_}} = (catch <<42.0/integer>>),
304    {'EXIT',{badarg,_}} = (catch <<42/binary>>),
305    {'EXIT',{badarg,_}} = (catch <<an_atom/integer>>),
306
307    %% Bad literal sizes
308    Bin = i(<<>>),
309    {'EXIT',{badarg,_}} = (catch <<0:(-1)>>),
310    {'EXIT',{badarg,_}} = (catch <<Bin/binary,0:(-1)>>),
311    {'EXIT',{badarg,_}} = (catch <<0:(-(1 bsl 100))>>),
312    {'EXIT',{badarg,_}} = (catch <<Bin/binary,0:(-(1 bsl 100))>>),
313
314    ok.
315
316float_bin(Config) when is_list(Config) ->
317    %% Some more coverage.
318    {<<1,2,3>>,7.0} = float_bin_1(4),
319    F = 42.0,
320    <<42,0,0,0,0,0,0,69,64>> = <<(id(42)),F/little-float>>,
321    ok.
322
323float_bin_1(F) ->
324    {<<1,2,3>>,F+3.0}.
325
326in_guard(Config) when is_list(Config) ->
327    1 = in_guard_1(<<16#74ad:16>>, 16#e95, 5),
328    2 = in_guard_1(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>),
329    3 = in_guard_1(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415),
330    3 = in_guard_1(<<16#FBCD:14,3/float,3:2>>, 16#FBCD, 3),
331    3 = in_guard_1(<<16#FBCD:14,(2 bsl 226)/float,3:2>>, 16#FBCD, 2 bsl 226),
332    nope = in_guard_1(<<1>>, 42, b),
333    nope = in_guard_1(<<1>>, a, b),
334    nope = in_guard_1(<<1,2>>, 1, 1),
335    nope = in_guard_1(<<4,5>>, 1, 2.71),
336    nope = in_guard_1(<<4,5>>, 1, <<12,13>>),
337
338    1 = in_guard_2(<<0,56>>, 7, blurf),
339    2 = in_guard_2(<<1,255>>, 511, blurf),
340    3 = in_guard_2(<<0,3>>, 0, blurf),
341    4 = in_guard_2(<<>>, 1, {<<7:16>>}),
342    nope = in_guard_2(<<4,5>>, 1, blurf),
343
344    42 = in_guard_3(<<1,2,3,42>>, <<1,2,3>>),
345    42 = in_guard_3(<<1,2,3,42>>, <<1,2,3>>),
346    nope = in_guard_3(<<>>, <<>>),
347
348    ok = in_guard_4(<<15:4>>, 255),
349    nope = in_guard_4(<<15:8>>, 255),
350    ok.
351
352in_guard_1(Bin, A, B) when <<A:13,B:3>> == Bin -> 1;
353in_guard_1(Bin, A, B) when <<A:16,B/binary>> == Bin -> 2;
354in_guard_1(Bin, A, B) when <<A:14,B/float,3:2>> == Bin -> 3;
355in_guard_1(Bin, A, B) when {a,b,<<A:14,B/float,3:2>>} == Bin -> cant_happen;
356in_guard_1(_, _, _) -> nope.
357
358in_guard_2(Bin, A, _T) when <<A:13,0:3>> == Bin -> 1;
359in_guard_2(Bin, A, _T) when <<A:16>> == Bin -> 2;
360in_guard_2(Bin, A, _T) when <<A:14,3:2>> == Bin -> 3;
361in_guard_2(_Bin, A, T) when {A,b} > {0,1}, {<<A:14,3:2>>} == T -> 4;
362in_guard_2(_, _, _) -> nope.
363
364in_guard_3(Bin, A) when <<A/binary,42>> =:= Bin -> 42;
365in_guard_3(_, _) -> nope.
366
367in_guard_4(Bin, A) when <<A:4>> =:= Bin -> ok;
368in_guard_4(_, _) -> nope.
369
370in_catch(Config) when is_list(Config) ->
371    <<42,0,5>> = small(42, 5),
372    <<255>> = small(255, <<1,2,3,4,5,6,7,8,9>>),
373    <<1,2>> = small(<<7,8,9,10>>, 258),
374    <<>> = small(<<1,2,3,4,5>>, <<7,8,9,10>>),
375
376    <<15,240,0,42>> = small2(255, 42),
377    <<7:20>> = small2(<<1,2,3>>, 7),
378    <<300:12>> = small2(300, <<1,2,3>>),
379    <<>> = small2(<<1>>, <<2>>),
380    ok.
381
382small(A, B) ->
383    case begin
384	     case catch <<A:8>> of
385		 {'EXIT',_} -> <<>>;
386		 ResA0 -> ResA0
387	     end
388	 end of
389	ResA -> ok
390    end,
391    case begin
392	     case catch <<B:16>> of
393		 {'EXIT',_} -> <<>>;
394		 ResB0 -> ResB0
395	     end
396	 end of
397	ResB -> ok
398    end,
399    <<ResA/binary,ResB/binary>>.
400
401small2(A, B) ->
402    case begin
403	     case catch <<A:12>> of
404		 {'EXIT',_} -> <<>>;
405		 ResA0 -> ResA0
406	     end
407	 end of
408	ResA -> ok
409    end,
410    case begin
411	     case catch <<B:20>> of
412		 {'EXIT',_} -> <<>>;
413		 ResB0 -> ResB0
414	     end
415	 end of
416	ResB -> ok
417    end,
418    <<ResA/binary-unit:1,ResB/binary-unit:1>>.
419
420nasty_literals(Config) when is_list(Config) ->
421    case erlang:system_info(endian) of
422	big ->
423	    [0,42] = binary_to_list(id(<<42:16/native>>));
424	little ->
425	    [42,0] = binary_to_list(id(<<42:16/native>>))
426    end,
427
428    Bin0 = id(<<1,2,3,0:10000000,4,5,6>>),
429    1250006 = size(Bin0),
430    <<1,2,3,0:10000000,4,5,6>> = Bin0,
431
432    Bin1 = id(<<0:10000000,7,8,-1:10000000,9,10,0:10000000>>),
433    3750004 = size(Bin1),
434    <<0:10000000,7,8,-1:10000000/signed,9,10,0:10000000>> = Bin1,
435
436    <<255,255,0,0,0>> = id(<<255,255,0,0,0>>),
437
438    %% Coverage.
439    I = 16#7777FFFF7777FFFF7777FFFF7777FFFF7777FFFF7777FFFF,
440    id(<<I:260>>),
441
442    ok.
443
444-define(COF(Int0),
445	(fun(Int) ->
446		 true = <<Int:32/float>> =:= <<(float(Int)):32/float>>,
447		 true = <<Int:64/float>> =:= <<(float(Int)):64/float>>
448	 end)(nonliteral(Int0)),
449	true = <<Int0:32/float>> =:= <<(float(Int0)):32/float>>,
450	true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>).
451
452-define(COF64(Int0),
453	(fun(Int) ->
454		 true = <<Int:64/float>> =:= <<(float(Int)):64/float>>
455	 end)(nonliteral(Int0)),
456	true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>).
457
458nonliteral(X) -> X.
459
460coerce_to_float(Config) when is_list(Config) ->
461    ?COF(0),
462    ?COF(-1),
463    ?COF(1),
464    ?COF(42),
465    ?COF(255),
466    ?COF(-255),
467    ?COF(38474),
468    ?COF(387498738948729893849444444443),
469    ?COF(-37489378937773899999999999999993),
470    ?COF64(298748888888888888888888888883478264866528467367364766666666666666663),
471    ?COF64(-367546729879999999999947826486652846736736476555566666663),
472    ok.
473
474side_effect(Config) when is_list(Config) ->
475    {'EXIT',{badarg,_}} = (catch side_effect_1(a)),
476    {'EXIT',{badarg,_}} = (catch side_effect_1(<<>>)),
477    ok = side_effect_1(42),
478    ok.
479
480side_effect_1(A) ->
481    <<A:17>>,					%Warning intentional.
482    ok.
483
484-record(otp_7029, {a,b}).
485
486opt(Config) when is_list(Config) ->
487    42 = otp_7029(#otp_7029{a = <<>>,b = 42}),
488    N = 16,
489    <<1,3,65>> = id(<<1,833:N>>),
490    <<1,66,3>> = id(<<1,834:N/little>>),
491    <<1,65,136,0,0>> = id(<<1,17.0:32/float>>),
492    <<1,64,8,0,0,0,0,0,0>> = id(<<1,3.0:N/float-unit:4>>),
493    <<1,0,0,0,0,0,0,8,64>> = id(<<1,3.0:N/little-float-unit:4>>),
494    {'EXIT',{badarg,_}} = (catch id(<<3.1416:N/float>>)),
495
496    B = <<1,2,3,4,5>>,
497    <<0,1,2,3,4,5>> = id(<<0,B/binary>>),
498    <<1,2,3,4,5,19>> = id(<<B:5/binary,19>>),
499    <<1,2,3,42>> = id(<<B:3/binary,42>>),
500
501    {'EXIT',_} = (catch <<<<23,56,0,2>>:(2.5)/binary>>),
502    {'EXIT',_} = (catch <<<<23,56,0,2>>:(-16)/binary>>),
503    {'EXIT',_} = (catch <<<<23,56,0,2>>:(anka)>>),
504    {'EXIT',_} = (catch <<<<23,56,0,2>>:64/float>>),
505    {'EXIT',_} = (catch <<<<23,56,0,2:7>>/binary>>),
506
507    %% Test constant propagation - there should be a warning.
508    BadSz = 2.5,
509    {'EXIT',_} = (catch <<<<N,56,0,2>>:BadSz/binary>>),
510
511    case id(false) of
512	true -> opt_dont_call_me();
513	false -> ok
514    end,
515
516    ok.
517
518opt_dont_call_me() ->
519    N = 16#12345678,
520    <<0:N>>.
521
522otp_7029(R) ->
523    #otp_7029{a = <<>>} = R,
524    R#otp_7029.b.
525
526otp_7556(Config) when is_list(Config) ->
527    [otp_7556(<<>>, 1024, 1024, 1024) || _ <- lists:seq(0, 1023)],
528    ok.
529
530otp_7556(Bin, A, B, C) ->
531    %% When allocating the binary, the sizes 16*A and 16*A would
532    %% be forgotten.
533    <<Bin/binary,(-1):A/unit:16,0:B/unit:16,(-1):C/unit:16>>.
534
535%% Test binary construction combined with floating point operations
536%% (mostly to cover code in beam_flatten that combines the allocation
537%% for a binary construction with a later allocation).
538
539float_arith(Config) when is_list(Config) ->
540    {<<1,2,3,64,69,0,0,0,0,0,0>>,21.0} = do_float_arith(<<1,2,3>>, 42, 2),
541    ok.
542
543do_float_arith(Bin0, X, Y)  ->
544    Bin = <<Bin0/binary,X/float>>,
545    {Bin,X / Y}.
546
547otp_8054(Config) when is_list(Config) ->
548    <<"abc">> = otp_8054_1([null,1,2,3], <<"abc">>),
549    ok.
550
551otp_8054_1([H|T], Bin) ->
552    _ = case H of
553	    null ->
554		%% The beam_validator would complain about {x,3}
555		%% not being live in bs_append/8 because of a live
556		%% optimization bug.
557		<<Bin/binary>>;
558	    _ ->
559		ok
560	end,
561    otp_8054_1(T, Bin);
562otp_8054_1([], Bin) -> Bin.
563
564-define(LONG_STRING,
565        "3lz7Q4au2i3DJWNlNhWuzmvA7gYWGXG+LAPtgtlEO2VGSxRqL2WOoHW"
566        "QxORTQfJw17mNEU8i87UKvEPbo9YY8ppiM7vfaG88TTyfEzgUMTgY3I"
567        "vsikMBELPz2AayVz5aaMh9PBFTZ4DkBIFxURBUKHho4Vgt7IzYnWNgn"
568        "3ON5D9VS89TPANK5/PwSUoMQYZ2fk5VLbq7D1ExlnCScvTDnF/WHMQ3"
569        "m2GUcQWb+ajfOf3bnP7EX4f1Q3d/1Soe6lEpf1KN/5S7A/ugjMhy4+H"
570        "Zuo1J1J6CCwEVZ/wDc79OpDPPj/qOGhDK73F8DaMcynZ91El+01vfTn"
571        "uUxNFUHLpuoQ==").
572
573cover(Config) ->
574    %% Cover handling of a huge partially literal string.
575    L = length(Config),
576    Bin = id(<<L:32,?LONG_STRING>>),
577    <<L:32,?LONG_STRING>> = Bin,
578    ok.
579