%%
%% %CopyrightBegin%
%% 
%% Copyright Ericsson AB 2004-2025. 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,
         verify_highest_opcode/1,
	 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,
         strings/1,bad_size/1,private_append/1]).

-include_lib("common_test/include/ct.hrl").

suite() ->
    [{ct_hooks,[ts_install_cth]},
     {timetrap,{minutes,1}}].

all() ->
    [{group,p}].

groups() ->
    [{p,[parallel],
      [verify_highest_opcode,
       two,test1,fail,float_bin,in_guard,in_catch,
       nasty_literals,side_effect,opt,otp_7556,float_arith,
       otp_8054,strings,bad_size,private_append]}].


init_per_suite(Config) ->
    test_lib:recompile(?MODULE),
    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.

verify_highest_opcode(_Config) ->
    case ?MODULE of
        bs_construct_r24_SUITE ->
            {ok,Beam} = file:read_file(code:which(?MODULE)),
            case test_lib:highest_opcode(Beam) of
                Highest when Highest =< 176 ->
                    ok;
                TooHigh ->
                    ct:fail({too_high_opcode,TooHigh})
            end;
        bs_construct_r25_SUITE ->
            {ok,Beam} = file:read_file(code:which(?MODULE)),
            case test_lib:highest_opcode(Beam) of
                Highest when Highest =< 180 ->
                    ok;
                TooHigh ->
                    ct:fail({too_high_opcode,TooHigh})
            end;
        _ ->
            ok
    end.

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]),

     %% Test the native flag.
     ?T(<<37.98:64/native-float>>,
	native_3798()),
     ?T(<<32978297842987249827298387697777669766334937:128/native-integer>>,
	native_bignum()),
     ?T(<<$э/native-utf16,$т/native-utf16,$о/native-utf16," спутник"/native-utf16>>,
        native_utf16()),
     ?T(<<$в/native-utf32,"ода"/native-utf32>>,
	native_utf32()),

     ?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 alignment 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]),
     ?T(<< (<<"abc",7:3>>):3/binary >>,
        [$a,$b,$c]),

     %% 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.

native_utf16() ->
    case <<1:16/native>> of
	<<0,1>> -> [4,77,4,66,4,62,0,32,4,65,4,63,4,67,4,66,4,61,4,56,4,58];
        <<1,0>> -> [77,4,66,4,62,4,32,0,65,4,63,4,67,4,66,4,61,4,56,4,58,4]
    end.

native_utf32() ->
    case <<1:16/native>> of
	<<0,1>> -> [0,0,4,50,0,0,4,62,0,0,4,52,0,0,4,48];
        <<1,0>> -> [50,4,0,0,62,4,0,0,52,4,0,0,48,4,0,0]
    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("  ~ts, ~p~n", [Str, Bytes]),
    Bin = list_to_bitstring(Bytes),
    if
	C_bin == Bin ->
	    ok;
	true ->
	    io:format("ERROR: Compiled: ~p.~nExpected ~p.~nGot ~p.~n",
		      [Str, Bytes, bitstring_to_list(C_bin)]),
	    ct:fail(comp)
    end,
    if
	E_bin == Bin ->
	    ok;
	true ->
	    io:format("ERROR: Interpreted: ~p.~nExpected ~p.~nGot ~p.~n",
		      [Str, Bytes, bitstring_to_list(E_bin)]),
	    ct:fail(comp)
    end;
one_test({C_bin, E_bin, Str, Result}) ->
    io:format("  ~ts ~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>>),

    %% Bad literal sizes
    Bin = i(<<>>),
    {'EXIT',{badarg,_}} = (catch <<0:(-1)>>),
    {'EXIT',{badarg,_}} = (catch <<Bin/binary,0:(-1)>>),
    {'EXIT',{badarg,_}} = (catch <<0:(-(1 bsl 100))>>),
    {'EXIT',{badarg,_}} = (catch <<Bin/binary,0:(-(1 bsl 100))>>),

    %% Unaligned sizes with literal binaries.
    {'EXIT',{badarg,_}} = (catch <<0,(<<7777:17>>)/binary>>),

    %% Make sure that variables are bound even if binary
    %% construction fails.
    {'EXIT',{badarg,_}} = (catch case <<face:(V0 = 42)>> of
                                    _Any -> V0
                                end),
    {'EXIT',{badarg,_}} = (catch case <<face:(V1 = 3)>> of
                                     a when V1 ->
                                         office
                                 end),
    {'EXIT',{badarg,_}} = (catch <<13:(put(?FUNCTION_NAME, 17))>>),
    17 = erase(?FUNCTION_NAME),
    {'EXIT',{badarg,_}} = (catch fail_1()),

    %% Size exceeds length of binary. 'native' is redundant for
    %% binaries, but when it was present sys_core_fold would not
    %% detect the overlong binary and beam_ssa_opt would crash.
    {'EXIT',{badarg,_}} = (catch << <<$t/little-signed>>:42/native-bytes >>),
    {'EXIT',{badarg,_}} = (catch << <<$t/little-signed>>:42/bytes >>),

    {'EXIT',{badarg,_}} = catch fail_2(true),

    ok.

fail_1() ->
    case <<(V0 = 1),[]/utf32>> of
        _ when V0 -> true
    end.

fail_2(True) when True ->
    <<0,True/bitstring>>.

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),

    nope = catch in_guard_5(),

    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.

%% Would crash beam_ssa_recv when the no_copt option was given.
in_guard_5() when 0; <<'':32,<<42/native>>>> -> ok;
in_guard_5() -> 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>>),

    %% GH-6643: Excessively large literals could cause the compiler to run out
    %% of memory.
    catch id(<<0:16777216/big-integer-unit:1>>),
    catch id(<<0:(16777216*2)/big-integer-unit:1>>),

    ok.

-define(COF(Int0),
	(fun(Int) ->
		 true = <<Int:16/float>> =:= <<(float(Int)):16/float>>,
		 true = <<Int:32/float>> =:= <<(float(Int)):32/float>>,
		 true = <<Int:64/float>> =:= <<(float(Int)):64/float>>
	 end)(nonliteral(Int0)),
	true = <<Int0:16/float>> =:= <<(float(Int0)):16/float>>,
	true = <<Int0:32/float>> =:= <<(float(Int0)):32/float>>,
	true = <<Int0:64/float>> =:= <<(float(Int0)):64/float>>).

-define(COF32(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(65504),
    ?COF(-65504),
    ?COF32(387498738948729893849444444443),
    ?COF32(-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>>),

    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.

-define(LONG_STRING,
        "3lz7Q4au2i3DJWNlNhWuzmvA7gYWGXG+LAPtgtlEO2VGSxRqL2WOoHW"
        "QxORTQfJw17mNEU8i87UKvEPbo9YY8ppiM7vfaG88TTyfEzgUMTgY3I"
        "vsikMBELPz2AayVz5aaMh9PBFTZ4DkBIFxURBUKHho4Vgt7IzYnWNgn"
        "3ON5D9VS89TPANK5/PwSUoMQYZ2fk5VLbq7D1ExlnCScvTDnF/WHMQ3"
        "m2GUcQWb+ajfOf3bnP7EX4f1Q3d/1Soe6lEpf1KN/5S7A/ugjMhy4+H"
        "Zuo1J1J6CCwEVZ/wDc79OpDPPj/qOGhDK73F8DaMcynZ91El+01vfTn"
        "uUxNFUHLpuoQ==").

strings(Config) ->
    L = length(Config),

    <<$a:16,$b:16,$c:16,L:32>> = <<"abc":16,L:32>>,

    %% Empty strings.
    <<L:16>> = <<L:16,""/utf8>>,
    <<L:16>> = <<L:16,"":(length(Config))>>,
    <<L:16>> = <<L:16,"":(BindMe = 42)>>,
    42 = BindMe,
    <<L:16>> = <<"":70,L:16>>,
    <<L:16>> = <<L:16,"":$F>>,

    %% Cover handling of a huge partially literal string.
    Bin = id(<<L:32,?LONG_STRING>>),
    <<L:32,?LONG_STRING>> = Bin,

    %% Bad sizes for empty strings.
    {'EXIT',{badarg,_}} = (catch <<"":(-42)>>),
    {'EXIT',{badarg,_}} = (catch <<"":bad_size>>),
    {'EXIT',{badarg,_}} = (catch bad_empty_string_1()),
    {'EXIT',{badarg,_}} = (catch bad_empty_string_2()),
    error = bad_empty_string_3(),
    error = bad_empty_string_4(true),
    error = bad_empty_string_4(false),

    ok.

bad_empty_string_1() ->
    <<"":(V0 = true)>>,
    V0.

bad_empty_string_2() ->
    <<"":(V0 = -1)>>,
    V0.

bad_empty_string_3() when <<a, "":96>> -> ok;
bad_empty_string_3() -> error.

bad_empty_string_4(V) when <<"","eFN"/utf8-native>>, V -> ok;
bad_empty_string_4(_) -> error.

bad_size(_Config) ->
    {'EXIT',{badarg,_}} = (catch bad_float_size()),
    {'EXIT',{badarg,_}} = (catch bad_float_size(<<"abc">>)),
    {'EXIT',{badarg,_}} = (catch bad_integer_size()),
    {'EXIT',{badarg,_}} = (catch bad_integer_size(<<"xyz">>)),
    {'EXIT',{badarg,_}} = (catch bad_integer_size2()),
    {'EXIT',{badarg,_}} = (catch bad_binary_size()),
    {'EXIT',{badarg,_}} = (catch bad_binary_size(<<"xyz">>)),
    {'EXIT',{badarg,_}} = (catch bad_binary_size2()),
    {'EXIT',{badarg,_}} = (catch bad_binary_size3(id(<<"abc">>))),
    ok.

bad_float_size() ->
    <<4.087073429964284:case 0 of 0 -> art end/float>>.

bad_float_size(Bin) ->
    <<Bin/binary,4.087073429964284:case 0 of 0 -> art end/float>>.

bad_integer_size() ->
    <<0:case 0 of 0 -> art end/integer>>.

bad_integer_size(Bin) ->
    <<Bin/binary,0:case 0 of 0 -> art end/integer>>.

bad_integer_size2() ->
    <<
      <<(id(42))>>:[ <<>> || <<123:true>> <= <<>> ],
      <<(id(100))>>:7>>.

bad_binary_size() ->
    <<<<"abc">>:case 0 of 0 -> art end/binary>>.

bad_binary_size(Bin) ->
    <<Bin/binary,<<"abc">>:case 0 of 0 -> art end/binary>>.

bad_binary_size2() ->
    <<
      <<(id(42))>>:[ <<>> || <<123:true>> <= <<>> ]/binary,
      <<(id(100))>>:7>>.

bad_binary_size3(Bin) ->
    <<Bin:all/binary>>.

private_append(_Config) ->
    <<"alpha=\"alpha\",beta=\"beta\"">> =
        private_append_1(#{ <<"alpha">> => <<"alpha">>,
                            <<"beta">> => <<"beta">> }),

    <<>> = private_append_2(false),
    {'EXIT', _} = catch private_append_2(true),

    {ok,<<>>} = private_append_3(id(<<>>)),
    {error,<<"wrong parity">>} = private_append_3(id(<<1>>)),

    ok.

%% GH-7121: Alias analysis would not mark fun arguments as aliased,
%% fooling the beam_ssa_destructive_update pass.
private_append_1(M) when is_map(M) ->
    maps:fold(fun (K, V, Acc = <<>>) ->
                        <<Acc/binary, K/binary, "=\"", V/binary, "\"">>;
                    (K, V, Acc) ->
                        <<Acc/binary, ",", K/binary, "=\"", V/binary, "\"">>
                end, <<>>, M).

%% GH-7142: The private append pass crashed on oddly structured code.
private_append_2(Boolean) ->
    <<<<(id(Boolean) orelse <<>>)/binary>>/binary>>.

%% GH-10077. Would crash when attempting patch the
%% {error, <<"wrong parity">>} tuple.
private_append_3(Input) ->
    private_append_3(Input, {ok, <<>>}).

private_append_3(_, {error, Msg}) ->
    {error, Msg};
private_append_3(<<>>, {ok, Acc}) ->
    {ok, Acc};
private_append_3(<<B/bitstring>>, {ok, Acc}) ->
    case B of
        <<>> ->
            private_append_3(<<>>, {ok, <<Acc/bitstring>>});
        _ ->
            %% The compiler would fail to patch this tuple.
            private_append_3(<<>>, {error, <<"wrong parity">>})
    end.
