1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1999-2017. 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%% Purpose : Common utilities used by several optimization passes.
21%%
22
23-module(bs_construct_SUITE).
24
25-export([all/0, suite/0,
26         init_per_suite/1, end_per_suite/1,
27	 test1/1, test2/1, test3/1, test4/1, test5/1, testf/1,
28	 not_used/1, in_guard/1,
29	 mem_leak/1, coerce_to_float/1, bjorn/1,
30	 huge_float_field/1, huge_binary/1, system_limit/1, badarg/1,
31	 copy_writable_binary/1, kostis/1, dynamic/1, bs_add/1,
32	 otp_7422/1, zero_width/1, bad_append/1, bs_add_overflow/1]).
33
34-include_lib("common_test/include/ct.hrl").
35
36suite() ->
37    [{ct_hooks,[ts_install_cth]},
38     {timetrap, {minutes, 1}}].
39
40all() ->
41    [test1, test2, test3, test4, test5, testf, not_used,
42     in_guard, mem_leak, coerce_to_float, bjorn,
43     huge_float_field, huge_binary, system_limit, badarg,
44     copy_writable_binary, kostis, dynamic, bs_add, otp_7422, zero_width,
45     bad_append, bs_add_overflow].
46
47init_per_suite(Config) ->
48    Config.
49
50end_per_suite(_Config) ->
51    application:stop(os_mon).
52
53big(1) ->
54    57285702734876389752897683.
55
56i(X) -> X.
57
58r(L) ->
59    lists:reverse(L).
60
61-define(T(B, L), {B, ??B, L}).
62-define(N(B), {B, ??B, unknown}).
63
64-define(FAIL(Expr), fail_check(catch Expr, ??Expr, [])).
65
66-define(FAIL_VARS(Expr, Vars), fail_check(catch Expr, ??Expr, Vars)).
67
68l(I_13, I_big1) ->
69    [
70     ?T(<<-43>>,
71	[256-43]),
72     ?T(<<56>>,
73	[56]),
74     ?T(<<1,2>>,
75	[1, 2]),
76     ?T(<<4:4, 7:4>>,
77	[4*16+7]),
78     ?T(<<777:16/big>>,
79	[3, 9]),
80     ?T(<<777:16/little>>,
81	[9, 3]),
82     ?T(<<0.0:32/float>>,
83	[0,0,0,0]),
84     ?T(<<0.125:32/float>>,
85	[62,0,0,0]),
86     ?T(<<0.125:32/little-float>>,
87	[0,0,0,62]),
88     ?T(<<I_big1:32>>,
89	[138, 99, 0, 147]),
90     ?T(<<57285702734876389752897684:32>>,
91	[138, 99, 0, 148]),
92     ?T(<<I_big1:32/little>>,
93	r([138, 99, 0, 147])),
94     ?T(<<-1:17/unit:8>>,
95	lists:duplicate(17, 255)),
96
97     ?T(<<I_13>>,
98	[13]),
99
100     ?T(<<4:8/unit:2,5:2/unit:8>>,
101	[0, 4, 0, 5]),
102
103     ?T(<<1:1, 0:6, 1:1>>,
104	[129]),
105     ?T(<<1:1/little, 0:6/little, 1:1/little>>,
106	[129]),
107
108     ?T(<<<<1,2>>/binary>>,
109	[1, 2]),
110     ?T(<<<<1,2>>:1/binary>>,
111	[1]),
112     ?T(<<4,3,<<1,2>>:1/binary>>,
113	[4,3,1]),
114
115     ?T(<<(256*45+47)>>,
116	[47]),
117
118     ?T(<<57:0>>,
119	[]),
120
121     ?T(<<"apa">>,
122	"apa"),
123
124     ?T(<<1:3,"string",9:5>>,
125	[46,110,142,77,45,204,233]),
126
127     ?T(<<>>,
128	[]),
129
130     ?T(<<37.98:64/native-float>>,
131	native_3798()),
132
133     ?T(<<32978297842987249827298387697777669766334937:128/native-integer>>,
134	native_bignum()),
135
136     %% Unit tests.
137     ?T(<<<<5:3>>/bitstring>>, <<5:3>>),
138     ?T(<<42,<<7:4>>/binary-unit:4>>, <<42,7:4>>),
139     ?T(<<<<344:17>>/binary-unit:17>>, <<344:17>>),
140     ?T(<<<<42,3,7656:16>>/binary-unit:16>>, <<42,3,7656:16>>)
141
142     ].
143
144native_3798() ->
145    case <<1:16/native>> of
146	<<0,1>> -> [64,66,253,112,163,215,10,61];
147	<<1,0>> -> [61,10,215,163,112,253,66,64]
148    end.
149
150native_bignum() ->
151    case <<1:16/native>> of
152	<<0,1>> -> [129,205,18,177,1,213,170,101,39,231,109,128,176,11,73,217];
153	<<1,0>> -> [217,73,11,176,128,109,231,39,101,170,213,1,177,18,205,129]
154    end.
155
156evaluate(Str, Vars) ->
157    {ok,Tokens,_} =
158	erl_scan:string(Str ++ " . "),
159    {ok, [Expr]} = erl_parse:parse_exprs(Tokens),
160    case erl_eval:expr(Expr, Vars) of
161	{value, Result, _} ->
162	    Result
163    end.
164
165eval_list([], _Vars) ->
166    [];
167eval_list([{C_bin, Str, Bytes} | Rest], Vars) ->
168    case catch evaluate(Str, Vars) of
169	{'EXIT', Error} ->
170	    io:format("Evaluation error: ~p, ~p, ~p~n", [Str, Vars, Error]),
171	    exit(Error);
172	E_bin ->
173	    [{C_bin, E_bin, Str, Bytes} | eval_list(Rest, Vars)]
174    end.
175
176one_test({C_bin, E_bin, Str, Bytes}) when is_list(Bytes) ->
177    io:format("  ~s, ~p~n", [Str, Bytes]),
178    Bin = list_to_binary(Bytes),
179    if
180	C_bin == Bin ->
181	    ok;
182	true ->
183	    io:format("ERROR: Compiled: ~p. Expected ~p. Got ~p.~n",
184		      [Str, Bytes, binary_to_list(C_bin)]),
185	    ct:fail(comp)
186    end,
187    if
188	E_bin == Bin ->
189	    ok;
190	true ->
191	    io:format("ERROR: Interpreted: ~p. Expected ~p. Got ~p.~n",
192		      [Str, Bytes, binary_to_list(E_bin)]),
193	    ct:fail(comp)
194    end;
195one_test({C_bin, E_bin, Str, Result}) ->
196    io:format("  ~s ~p~n", [Str, C_bin]),
197    if
198	C_bin == E_bin ->
199	    ok;
200	true ->
201	    Arbitrary = case Result of
202			    unknown ->
203				size(C_bin);
204			    _ ->
205				Result
206			end,
207	    case equal_lists(binary_to_list(C_bin),
208			     binary_to_list(E_bin),
209			     Arbitrary) of
210		false ->
211		    io:format("ERROR: Compiled not equal to interpreted:"
212			      "~n ~p, ~p.~n",
213			      [binary_to_list(C_bin), binary_to_list(E_bin)]),
214		    ct:fail(comp);
215		0 ->
216		    ok;
217		%% For situations where the final bits may not matter, like
218		%% for floats:
219		N when is_integer(N) ->
220		    io:format("Info: compiled and interpreted differ in the"
221			      " last bytes:~n ~p, ~p.~n",
222			      [binary_to_list(C_bin), binary_to_list(E_bin)]),
223		    ok
224	    end
225    end.
226
227equal_lists([], [], _) ->
228    0;
229equal_lists([], _, _) ->
230    false;
231equal_lists(_, [], _) ->
232    false;
233equal_lists([A|AR], [A|BR], R) ->
234    equal_lists(AR, BR, R);
235equal_lists(A, B, R) ->
236    if
237	length(A) /= length(B) ->
238	    false;
239	length(A) =< R ->
240	    R;
241	true ->
242	    false
243    end.
244
245fail_check({'EXIT',{badarg,_}}, Str, Vars) ->
246    try	evaluate(Str, Vars) of
247	Res ->
248	    io:format("Interpreted result: ~p", [Res]),
249	    ct:fail(did_not_fail_in_intepreted_code)
250    catch
251	error:badarg ->
252	    ok
253    end;
254fail_check(Res, _, _) ->
255    io:format("Compiled result: ~p", [Res]),
256    ct:fail(did_not_fail_in_compiled_code).
257
258%%% Simple working cases
259test1(Config) when is_list(Config) ->
260    I_13 = i(13),
261    I_big1 = big(1),
262    Vars = [{'I_13', I_13},
263		  {'I_big1', I_big1}],
264    lists:foreach(fun one_test/1, eval_list(l(I_13, I_big1), Vars)).
265
266%%% Misc
267
268%%% <<A:S, A:(N-S)>>
269comp(N, A, S) ->
270    M1 = (1 bsl S) - 1,
271    M2 = (1 bsl (N-S)) - 1,
272    [((A band M1) bsl (N-S)) bor (A band M2)].
273
274gen(N, S, A) ->
275    [?T(<<A:S, A:(N-S)>>, comp(N, A, S))].
276
277gen_l(N, S, A) ->
278    [?T(<<A:S/little, A:(N-S)/little>>, comp(N, A, S))].
279
280test2(Config) when is_list(Config) ->
281    test2(0, 8, 2#10101010101010101),
282    test2(0, 8, 2#1111111111).
283
284test2(End, End, _) ->
285    ok;
286test2(I, End, A) ->
287    test2(I, A),
288    test2(I+1, End, A).
289
290test2(S, A) ->
291    N = 8,
292    Vars = [{'A',A}, {'N',N}, {'S',S}],
293    io:format("Vars: ~p\n", [Vars]),
294    lists:foreach(fun one_test/1, eval_list(gen(N, S, A), Vars)),
295    lists:foreach(fun one_test/1, eval_list(gen_l(N, S, A), Vars)).
296
297%%% Tests without facit
298
299t3() ->
300    [?N(<<4711:13, 9876:13, 3:6>>),
301     ?N(<<4.57:64/float>>),
302     ?N(<<4.57:32/float>>),
303
304     ?N(<<>>)
305    ].
306
307test3(Config) when is_list(Config) ->
308    Vars = [],
309    lists:foreach(fun one_test/1, eval_list(t3(), Vars)).
310
311gen_u(N, S, A) ->
312    [?N(<<A:S, A:(N-S)>>)].
313
314gen_u_l(N, S, A) ->
315    [?N(<<A:S/little, A:(N-S)/little>>)].
316
317test4(Config) when is_list(Config) ->
318    test4(0, 16, 2#10101010101010101),
319    test4(0, 16, 2#1111111111).
320
321test4(End, End, _) ->
322    ok;
323test4(I, End, A) ->
324    test4(I, A),
325    test4(I+1, End, A).
326
327test4(S, A) ->
328    N = 16,
329    Vars = [{'A', A}, {'N', 16}, {'S', S}],
330    lists:foreach(fun one_test/1, eval_list(gen_u(N, S, A), Vars)),
331    lists:foreach(fun one_test/1, eval_list(gen_u_l(N, S, A), Vars)).
332
333gen_b(N, S, A) ->
334    [?T(<<A:S/binary-unit:1, A:(N-S)/binary-unit:1>>,
335	binary_to_list(<<A:S/binary-unit:1, A:(N-S)/binary-unit:1>>))].
336
337%% OTP-3995
338test5(Config) when is_list(Config) ->
339    test5(0, 8, <<73>>),
340    test5(0, 8, <<68>>).
341
342test5(End, End, _) ->
343    ok;
344test5(I, End, A) ->
345    test5(I, A),
346    test5(I+1, End, A).
347
348test5(S, A) ->
349    N = 8,
350    Vars = [{'A', A}, {'N', 8}, {'S', S}],
351    lists:foreach(fun one_test/1, eval_list(gen_b(N, S, A), Vars)).
352
353%%% Failure cases
354testf(Config) when is_list(Config) ->
355    ?FAIL(<<3.14>>),
356    ?FAIL(<<<<1,2>>>>),
357
358    ?FAIL(<<2.71/binary>>),
359    ?FAIL(<<24334/binary>>),
360    ?FAIL(<<24334344294788947129487129487219847/binary>>),
361    BigInt = id(24334344294788947129487129487219847),
362    ?FAIL_VARS(<<BigInt/binary>>, [{'BigInt',BigInt}]),
363    ?FAIL_VARS(<<42,BigInt/binary>>, [{'BigInt',BigInt}]),
364    ?FAIL_VARS(<<BigInt:2/binary>>, [{'BigInt',BigInt}]),
365
366    %% One negative field size, but the sum of field sizes will be 1 byte.
367    %% Make sure that we reject that properly.
368    I_minus_777 = id(-777),
369    I_minus_2047 = id(-2047),
370    ?FAIL_VARS(<<I_minus_777:2048/unit:8,57:I_minus_2047/unit:8>>,
371		     ordsets:from_list([{'I_minus_777',I_minus_777},
372					{'I_minus_2047',I_minus_2047}])),
373    ?FAIL(<<<<1,2,3>>/float>>),
374
375    %% Negative field widths.
376    testf_1(-8, <<1,2,3,4,5>>),
377    ?FAIL(<<0:(-(1 bsl 100))>>),
378
379    ?FAIL(<<42:(-16)>>),
380    ?FAIL(<<3.14:(-8)/float>>),
381    ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>),
382    ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>),
383    ?FAIL(<<<<23,56,0,2>>:(anka)>>),
384    ?FAIL(<<<<23,56,0,2>>:(anka)>>),
385
386    %% Unit failures.
387    ?FAIL(<<<<1:1>>/binary>>),
388    Sz = id(1),
389    ?FAIL_VARS(<<<<1:Sz>>/binary>>, [{'Sz',Sz}]),
390    {'EXIT',{badarg,_}} = (catch <<<<1:(id(1))>>/binary>>),
391    ?FAIL(<<<<7,8,9>>/binary-unit:16>>),
392    ?FAIL(<<<<7,8,9,3:7>>/binary-unit:16>>),
393    ?FAIL(<<<<7,8,9,3:7>>/binary-unit:17>>),
394
395    ok.
396
397testf_1(W, B) ->
398    Vars = [{'W',W}],
399    ?FAIL_VARS(<<42:W>>, Vars),
400    ?FAIL_VARS(<<3.14:W/float>>, Vars),
401    ?FAIL_VARS(<<B:W/binary>>, [{'B',B}|Vars]).
402
403%% Test that constructed binaries that are not used will still give an exception.
404not_used(Config) when is_list(Config) ->
405    ok = not_used1(3, <<"dum">>),
406    {'EXIT',{badarg,_}} = (catch not_used1(3, "dum")),
407    {'EXIT',{badarg,_}} = (catch not_used2(444, -2)),
408    {'EXIT',{badarg,_}} = (catch not_used2(444, anka)),
409    {'EXIT',{badarg,_}} = (catch not_used3(444)),
410    ok.
411
412not_used1(I, BinString) ->
413    <<I:32,BinString/binary>>,
414    ok.
415
416not_used2(I, Sz) ->
417    <<I:Sz>>,
418    ok.
419
420not_used3(I) ->
421    <<I:(-8)>>,
422    ok.
423
424in_guard(Config) when is_list(Config) ->
425    1 = in_guard(<<16#74ad:16>>, 16#e95, 5),
426    2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>),
427    3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415),
428    3 = in_guard(<<16#FBCD:14,3/float,3:2>>, 16#FBCD, 3),
429    3 = in_guard(<<16#FBCD:14,(2 bsl 226)/float,3:2>>, 16#FBCD, 2 bsl 226),
430    nope = in_guard(<<1>>, 42, b),
431    nope = in_guard(<<1>>, a, b),
432    nope = in_guard(<<1,2>>, 1, 1),
433    nope = in_guard(<<4,5>>, 1, 2.71),
434    nope = in_guard(<<4,5>>, 1, <<12,13>>),
435    ok.
436
437in_guard(Bin, A, B) when <<A:13,B:3>> == Bin -> 1;
438in_guard(Bin, A, B) when <<A:16,B/binary>> == Bin -> 2;
439in_guard(Bin, A, B) when <<A:14,B/float,3:2>> == Bin -> 3;
440in_guard(Bin, A, B) when {a,b,<<A:14,B/float,3:2>>} == Bin -> cant_happen;
441in_guard(_, _, _) -> nope.
442
443%% Make sure that construction has no memory leak
444mem_leak(Config) when is_list(Config) ->
445    B = make_bin(16, <<0>>),
446    mem_leak(1024, B),
447    ok.
448
449mem_leak(0, _) -> ok;
450mem_leak(N, B) ->
451    big_bin(B, <<23>>),
452    {'EXIT',{badarg,_}} = (catch big_bin(B, bad)),
453    mem_leak(N-1, B).
454
455big_bin(B1, B2) ->
456    <<B1/binary,B1/binary,B1/binary,B1/binary,
457      B1/binary,B1/binary,B1/binary,B1/binary,
458      B1/binary,B1/binary,B1/binary,B1/binary,
459      B1/binary,B1/binary,B1/binary,B1/binary,
460      B2/binary>>.
461
462make_bin(0, Acc) -> Acc;
463make_bin(N, Acc) -> make_bin(N-1, <<Acc/binary,Acc/binary>>).
464
465-define(COF(Int0),
466	(fun(Int) ->
467		       true = <<Int:32/float>> =:= <<(float(Int)):32/float>>,
468		       true = <<Int:64/float>> =:= <<(float(Int)):64/float>>
469			   end)(nonliteral(Int0)),
470 	true = <<Int0:32/float>> =:= <<(float(Int0)):32/float>>,
471 	true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>).
472
473-define(COF64(Int0),
474	(fun(Int) ->
475		       true = <<Int:64/float>> =:= <<(float(Int)):64/float>>
476			   end)(nonliteral(Int0)),
477 	true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>).
478
479nonliteral(X) -> X.
480
481coerce_to_float(Config) when is_list(Config) ->
482    ?COF(0),
483    ?COF(-1),
484    ?COF(1),
485    ?COF(42),
486    ?COF(255),
487    ?COF(-255),
488    ?COF(38474),
489    ?COF(387498738948729893849444444443),
490    ?COF(-37489378937773899999999999999993),
491    ?COF64(298748888888888888888888888883478264866528467367364766666666666666663),
492    ?COF64(-367546729879999999999947826486652846736736476555566666663),
493    ok.
494
495bjorn(Config) when is_list(Config) ->
496    error = bjorn_1(),
497    ok.
498
499bjorn_1() ->
500    Bitstr = <<7:13>>,
501    try
502	do_something()
503    catch
504	throw:blurf ->
505	    ignore
506    end,
507    do_more(Bitstr, 13).
508
509do_more(Bin, Sz) ->
510    %% Previous bug in the bs_bits_to_bytes instruction: The exeption code
511    %% was not set - the previous exception (throw:blurf) would be used,
512    %% causing the catch to slip.
513    try <<Bin:Sz/binary>> of
514	_V -> ok
515    catch
516	error:_ ->
517	    error
518    end.
519
520do_something() ->
521    throw(blurf).
522
523huge_float_field(Config) when is_list(Config) ->
524    {'EXIT',{badarg,_}} = (catch <<0.0:9/float-unit:8>>),
525    huge_float_check(catch <<0.0:67108865/float-unit:64>>),
526    huge_float_check(catch <<0.0:((1 bsl 26)+1)/float-unit:64>>),
527    huge_float_check(catch <<0.0:(id(67108865))/float-unit:64>>),
528%%  huge_float_check(catch <<0.0:((1 bsl 60)+1)/float-unit:64>>),
529    huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 26)+1)/float-unit:64>>),
530%%  huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 60)+1)/float-unit:64>>),
531    ok.
532
533huge_float_check({'EXIT',{system_limit,_}}) -> ok;
534huge_float_check({'EXIT',{badarg,_}}) -> ok.
535
536huge_binary(Config) when is_list(Config) ->
537    ct:timetrap({seconds, 60}),
538    16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>),
539    garbage_collect(),
540    FreeMem = free_mem(),
541    io:format("Free memory (Mb): ~p\n", [FreeMem]),
542    {Shift,Return} = case free_mem() of
543			 undefined ->
544			     %% This test has to be inlined inside the case to
545			     %% use a literal Shift
546			     garbage_collect(),
547			     id(<<0:((1 bsl 32)-1)>>),
548			     {32,ok};
549			 Mb when Mb > 600 ->
550			     garbage_collect(),
551			     id(<<0:((1 bsl 32)-1)>>),
552			     {32,ok};
553			 Mb when Mb > 300 ->
554			     garbage_collect(),
555			     id(<<0:((1 bsl 31)-1)>>),
556			     {31,"Limit huge binaries to 256 Mb"};
557			 Mb when Mb > 200 ->
558			     garbage_collect(),
559			     id(<<0:((1 bsl 30)-1)>>),
560			     {30,"Limit huge binary to 128 Mb"};
561			 _ ->
562			     garbage_collect(),
563			     id(<<0:((1 bsl 29)-1)>>),
564                             {29,"Limit huge binary to 64 Mb"}
565		     end,
566    garbage_collect(),
567    id(<<0:((1 bsl Shift)-1)>>),
568    garbage_collect(),
569    id(<<0:(id((1 bsl Shift)-1))>>),
570    garbage_collect(),
571    case Return of
572	ok -> ok;
573	Comment -> {comment, Comment}
574    end.
575
576%% Return the amount of free memory in Mb.
577free_mem() ->
578    {ok,Apps} = application:ensure_all_started(os_mon),
579    Mem = memsup:get_system_memory_data(),
580    [ok = application:stop(App)||App <- Apps],
581    case proplists:get_value(free_memory,Mem) of
582        undefined -> undefined;
583        Val -> Val div (1024*1024)
584    end.
585
586system_limit(Config) when is_list(Config) ->
587    WordSize = erlang:system_info(wordsize),
588    BitsPerWord = WordSize * 8,
589    {'EXIT',{system_limit,_}} =
590	(catch <<0:(id(0)),42:(id(1 bsl BitsPerWord))>>),
591    {'EXIT',{system_limit,_}} =
592	(catch <<42:(id(1 bsl BitsPerWord)),0:(id(0))>>),
593    {'EXIT',{system_limit,_}} =
594	(catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>),
595
596    %% Would fail to load.
597    {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 67)>>),
598    {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 64)+1)>>),
599
600    case WordSize of
601	4 ->
602	    system_limit_32();
603	8 ->
604	    ok
605    end.
606
607system_limit_32() ->
608    {'EXIT',{badarg,_}} = (catch <<42:(-1)>>),
609    {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>),
610    {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>),
611    {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>),
612    {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>),
613    {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>),
614    {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:(id(536870912))/unit:8>>),
615
616    %% The size would be silently truncated, resulting in a crash.
617    {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 35)>>),
618    {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 32)+1)>>),
619
620    %% Would fail to load.
621    {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>),
622    {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>),
623    ok.
624
625badarg(Config) when is_list(Config) ->
626    {'EXIT',{badarg,_}} = (catch <<0:(id(1 bsl 100)),0:(id(-1))>>),
627    {'EXIT',{badarg,_}} = (catch <<0:(id(1 bsl 100)),0:(id(-(1 bsl 70)))>>),
628    {'EXIT',{badarg,_}} = (catch <<0:(id(-(1 bsl 70))),0:(id(1 bsl 100))>>),
629    {'EXIT',{badarg,_}} = (catch <<(id(<<>>))/binary,0:(id(-(1 bsl 100)))>>),
630    ok.
631
632copy_writable_binary(Config) when is_list(Config) ->
633    [copy_writable_binary_1(I) || I <- lists:seq(0, 256)],
634    ok.
635
636copy_writable_binary_1(_) ->
637    Bin0 = <<(id(<<>>))/binary,0,1,2,3,4,5,6,7>>,
638    SubBin = make_sub_bin(Bin0),
639    id(<<42,34,55,Bin0/binary>>),		%Make reallocation likelier.
640    Pid = spawn(fun() ->
641			      copy_writable_binary_holder(Bin0, SubBin)
642		      end),
643    Tab = ets:new(holder, []),
644    ets:insert(Tab, {17,Bin0}),
645    ets:insert(Tab, {42,SubBin}),
646    id(<<Bin0/binary,0:(64*1024*8)>>),
647    Pid ! self(),
648    [{17,Bin0}] = ets:lookup(Tab, 17),
649    [{42,Bin0}] = ets:lookup(Tab, 42),
650    receive
651	{Pid,Bin0,Bin0} -> ok;
652	Other ->
653	    ct:fail("Unexpected message: ~p", [Other])
654    end,
655    ok.
656
657copy_writable_binary_holder(Bin, SubBin) ->
658    receive
659	Pid ->
660	    Pid ! {self(),Bin,SubBin}
661    end.
662
663make_sub_bin(Bin0) ->
664    N = bit_size(Bin0),
665    <<_:17,Bin:N/bitstring,_:5>> = <<(-1):17,Bin0/bitstring,(-1):5>>,
666    Bin = Bin0,					%Assertion.
667    Bin.
668
669%% Make sure that bit syntax expression with huge field size are
670%% not constructed at compile time.
671
672kostis(Config) when is_list(Config) ->
673    case have_250_terabytes_of_ram() of
674	true ->
675	    Bin = <<0:800000000000>>,
676	    EmbeddedBin = <<0,(<<0:99999999999>>)/bitstring,1>>,
677	    Bin0 = list_to_binary([Bin,Bin,Bin,Bin,Bin]),
678	    Bin1 = list_to_binary([Bin0,Bin0,Bin0,Bin0,Bin0,Bin0]),
679	    Bin2 = list_to_binary([Bin1,Bin1]),
680	    id({EmbeddedBin,Bin0,Bin1,Bin2});
681	false ->
682	    ok
683    end.
684
685%% I'm not even certain how much 250 TB really is...
686%% but I'm sure I don't have it :-)
687
688have_250_terabytes_of_ram() -> false.
689
690%% Test that different ways of using bit syntax instructions
691%% give the same result.
692
693dynamic(Config) when is_list(Config) ->
694    dynamic_1(fun dynamic_big/5),
695    dynamic_1(fun dynamic_little/5),
696    ok.
697
698dynamic_1(Dynamic) ->
699    <<Lpad:128>> = erlang:md5([0]),
700    <<Rpad:128>> = erlang:md5([1]),
701    <<Int:128>> = erlang:md5([2]),
702    8385 = dynamic_2(0, {Int,Lpad,Rpad,Dynamic}, 0).
703
704dynamic_2(129, _, Count) -> Count;
705dynamic_2(Bef, Data, Count0) ->
706    Count = dynamic_3(Bef, 128-Bef, Data, Count0),
707    dynamic_2(Bef+1, Data, Count).
708
709dynamic_3(_, -1, _, Count) -> Count;
710dynamic_3(Bef, N, {Int0,Lpad,Rpad,Dynamic}=Data, Count) ->
711    Int1 = Int0 band ((1 bsl (N+3))-1),
712    Dynamic(Bef, N, Int1, Lpad, Rpad),
713    Dynamic(Bef, N, -Int1, Lpad, Rpad),
714
715    %% OTP-7085: Test a small number in a wide field.
716    Int2 = Int0 band 16#FFFFFF,
717    Dynamic(Bef, N, Int2, Lpad, Rpad),
718    Dynamic(Bef, N, -Int2, Lpad, Rpad),
719    dynamic_3(Bef, N-1, Data, Count+1).
720
721dynamic_big(Bef, N, Int, Lpad, Rpad) ->
722    NumBin = id(<<Int:N>>),
723    MaskedInt = Int band ((1 bsl N) - 1),
724    <<MaskedInt:N>> = NumBin,
725
726    %% Construct the binary in two different ways.
727    Bin = id(<<Lpad:Bef,NumBin/bitstring,Rpad:(128-Bef-N)>>),
728    Bin = <<Lpad:Bef,Int:N,Rpad:(128-Bef-N)>>,
729
730    %% Further verify the result by matching.
731    LpadMasked = Lpad band ((1 bsl Bef) - 1),
732    RpadMasked = Rpad band ((1 bsl (128-Bef-N)) - 1),
733    Rbits = (128-Bef-N),
734    <<LpadMasked:Bef,MaskedInt:N,RpadMasked:Rbits>> = id(Bin),
735    ok.
736
737dynamic_little(Bef, N, Int, Lpad, Rpad) ->
738    NumBin = id(<<Int:N/little>>),
739    MaskedInt = Int band ((1 bsl N) - 1),
740    <<MaskedInt:N/little>> = NumBin,
741
742    %% Construct the binary in two different ways.
743    Bin = id(<<Lpad:Bef/little,NumBin/bitstring,Rpad:(128-Bef-N)/little>>),
744    Bin = <<Lpad:Bef/little,Int:N/little,Rpad:(128-Bef-N)/little>>,
745
746    %% Further verify the result by matching.
747    LpadMasked = Lpad band ((1 bsl Bef) - 1),
748    RpadMasked = Rpad band ((1 bsl (128-Bef-N)) - 1),
749    Rbits = (128-Bef-N),
750    <<LpadMasked:Bef/little,MaskedInt:N/little,RpadMasked:Rbits/little>> = id(Bin),
751    ok.
752
753%% Test that the bs_add/5 instruction handles big numbers correctly.
754bs_add(Config) when is_list(Config) ->
755    Mod = bs_construct_bs_add,
756    N = 2000,
757    Code = [{module, Mod},
758	    {exports, [{bs_add,2}]},
759	    {labels, 2},
760
761	    %% bs_add(Number, -SmallestBig) -> Number + N
762	    {function, bs_add, 2, 2},
763	    {label,1},
764	    {func_info,{atom,Mod},{atom,bs_add},2},
765
766	    {label,2},
767	    {move,{x,0},{x,2}}] ++
768	lists:duplicate(N-1, {bs_add,{f,0},[{x,2},{integer,1},1],{x,2}}) ++
769	[{gc_bif,abs,{f,0},3,[{x,1}],{x,4}},	%Force GC, ignore result.
770	 {gc_bif,'+',{f,0},3,[{x,2},{integer,1}],{x,0}}, %Safe result in {x,0}
771	 return],
772
773    %% Write assembly file and assemble it.
774    PrivDir = proplists:get_value(priv_dir, Config),
775    RootName = filename:join(PrivDir, atom_to_list(Mod)),
776    AsmFile = RootName ++ ".S",
777    {ok,Fd} = file:open(AsmFile, [write]),
778    [io:format(Fd, "~p. \n", [T]) || T <- Code],
779    ok = file:close(Fd),
780    {ok,Mod} = compile:file(AsmFile, [from_asm,report,{outdir,PrivDir}]),
781    LoadRc = code:load_abs(RootName),
782    {module,_Module} = LoadRc,
783
784    %% Find smallest positive bignum.
785    SmallestBig = smallest_big(),
786    io:format("~p\n", [SmallestBig]),
787    Expected = SmallestBig + N,
788    DoTest = fun() ->
789		     exit(Mod:bs_add(SmallestBig, -SmallestBig))
790	     end,
791    {Pid,Mref} = spawn_monitor(DoTest),
792    receive
793	{'DOWN',Mref,process,Pid,Res} -> ok
794    end,
795    Expected = Res,
796
797    %% Clean up.
798    ok = file:delete(AsmFile),
799    ok = file:delete(code:which(Mod)),
800    ok.
801
802
803smallest_big() ->
804    smallest_big_1(1 bsl 24).
805
806smallest_big_1(N) ->
807    case erts_debug:flat_size(N) of
808	0 -> smallest_big_1(N+N);
809	_  -> N
810    end.
811
812otp_7422(Config) when is_list(Config) ->
813    otp_7422_int(0),
814    otp_7422_bin(0).
815
816otp_7422_int(N) when N < 512 ->
817    T = erlang:make_tuple(N, []),
818    spawn_link(fun() ->
819		       id(T),
820		       %% A size of field 0 would write one byte beyond
821		       %% the current position in the binary. It could
822		       %% overwrite the continuation pointer stored on
823		       %% the stack if HTOP was equal to E (the stack pointer).
824		       id(<<0:(id(0))>>)
825	       end),
826    otp_7422_int(N+1);
827otp_7422_int(_) -> ok.
828
829otp_7422_bin(N) when N < 512 ->
830    T = erlang:make_tuple(N, []),
831    Z = id(<<>>),
832    spawn_link(fun() ->
833		       id(T),
834		       id(<<Z:(id(0))/bits>>)
835	       end),
836    otp_7422_bin(N+1);
837otp_7422_bin(_) -> ok.
838
839zero_width(Config) when is_list(Config) ->
840    Z = id(0),
841    Small = id(42),
842    Big = id(1 bsl 128),
843    <<>> = <<Small:Z>>,
844    <<>> = <<Small:0>>,
845    <<>> = <<Big:Z>>,
846    <<>> = <<Big:0>>,
847
848    {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>),
849    {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):Z>>),
850    {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):0>>),
851
852    ok.
853
854bad_append(_) ->
855    do_bad_append(<<127:1>>, fun append_unit_3/1),
856    do_bad_append(<<127:2>>, fun append_unit_3/1),
857    do_bad_append(<<127:17>>, fun append_unit_3/1),
858
859    do_bad_append(<<127:3>>, fun append_unit_4/1),
860    do_bad_append(<<127:5>>, fun append_unit_4/1),
861    do_bad_append(<<127:7>>, fun append_unit_4/1),
862    do_bad_append(<<127:199>>, fun append_unit_4/1),
863
864    do_bad_append(<<127:7>>, fun append_unit_8/1),
865    do_bad_append(<<127:9>>, fun append_unit_8/1),
866
867    do_bad_append(<<0:8>>, fun append_unit_16/1),
868    do_bad_append(<<0:15>>, fun append_unit_16/1),
869    do_bad_append(<<0:17>>, fun append_unit_16/1),
870    ok.
871
872do_bad_append(Bin0, Appender) ->
873    {'EXIT',{badarg,_}} = (catch Appender(Bin0)),
874
875    Bin1 = id(<<0:3,Bin0/bitstring>>),
876    <<_:3,Bin2/bitstring>> = Bin1,
877    {'EXIT',{badarg,_}} = (catch Appender(Bin2)),
878
879    %% Create a writable binary.
880    Empty = id(<<>>),
881    Bin3 = <<Empty/bitstring,Bin0/bitstring>>,
882    {'EXIT',{badarg,_}} = (catch Appender(Bin3)),
883    ok.
884
885append_unit_3(Bin) ->
886    <<Bin/binary-unit:3,0:1>>.
887
888append_unit_4(Bin) ->
889    <<Bin/binary-unit:4,0:1>>.
890
891append_unit_8(Bin) ->
892    <<Bin/binary,0:1>>.
893
894append_unit_16(Bin) ->
895    <<Bin/binary-unit:16,0:1>>.
896
897%% Produce a large result of bs_add that, if cast to signed int, would overflow
898%% into a negative number that fits a smallnum.
899bs_add_overflow(_Config) ->
900    Memsize = memsize(),
901    io:format("Memsize = ~w Bytes~n", [Memsize]),
902    case erlang:system_info(wordsize) of
903	8 ->
904	    {skip, "64-bit architecture"};
905        _ when Memsize < (2 bsl 30) ->
906	    {skip, "Less then 2 GB of memory"};
907	4 ->
908            {'EXIT', {system_limit, _}} = (catch bs_add_overflow_signed()),
909            {'EXIT', {system_limit, _}} = (catch bs_add_overflow_unsigned()),
910	    ok
911    end.
912
913bs_add_overflow_signed() ->
914    %% Produce a large result of bs_add that, if cast to signed int, would
915    %% overflow into a negative number that fits a smallnum.
916    Large = <<0:((1 bsl 30)-1)>>,
917    <<Large/bits, Large/bits, Large/bits, Large/bits,
918      Large/bits, Large/bits, Large/bits, Large/bits,
919      Large/bits>>.
920
921bs_add_overflow_unsigned() ->
922    %% Produce a large result of bs_add that goes beyond the limit of an
923    %% unsigned word. This used to succeed but produced an incorrect result
924    %% where B =:= C!
925    A = <<0:((1 bsl 32)-8)>>,
926    B = <<2, 3>>,
927    C = <<A/binary,1,B/binary>>,
928    true = byte_size(B) < byte_size(C).
929
930id(I) -> I.
931
932memsize() ->
933    application:ensure_all_started(os_mon),
934    {Tot,_Used,_}  = memsup:get_memory_data(),
935    Tot.
936