%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2008-2017. 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%
%%
%%
-module(asn1_test_lib).

-export([compile/3,compile_all/3,compile_erlang/3,
	 rm_dirs/1,
	 hex_to_bin/1,
	 match_value/2,
	 parallel/0,
	 roundtrip/3,roundtrip/4,roundtrip_enc/3,roundtrip_enc/4,
         map_roundtrip/3]).

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

run_dialyzer() ->
    false.

compile(File, Config, Options) -> compile_all([File], Config, Options).

compile_all(Files, Config, Options0) ->
    DataDir = proplists:get_value(data_dir, Config),
    CaseDir = proplists:get_value(case_dir, Config),
    Options = [{outdir,CaseDir},debug_info|Options0],

    Comp = fun(F) ->
		   compile_file(filename:join(DataDir, F), Options)
	   end,
    p_run(Comp, Files),

    dialyze(Files, Options),
    ok.

parallel() ->
    case erlang:system_info(schedulers) > 1 andalso not run_dialyzer() of
        true  -> [parallel];
        false -> []
    end.

dialyze(Files, Options) ->
    case not run_dialyzer() orelse lists:member(abs, Options) of
	true -> ok;
	false -> dialyze(Files)
    end.

dialyze(Files) ->
    Beams0 = [code:which(module(F)) || F <- Files],
    Beams = [code:which(asn1rt_nif)|Beams0],
    case dialyzer:run([{files,Beams},
		       {warnings,[]},
		       {get_warnings,true}]) of
	[] ->
	    ok;
	[_|_]=Ws ->
	    io:put_chars([[B,$\n] || B <- Beams]),
	    io:put_chars([dialyzer:format_warning(W) || W <- Ws]),
	    error(dialyzer_warnings)
    end.

module(F0) ->
    F1 = filename:basename(F0),
    F2 = case filename:extension(F1) of
	     ".asn" ->
		 filename:rootname(F1);
	     ".asn1" ->
		 filename:rootname(F1);
	     ".py" ->
		 filename:rootname(F1);
	     "" ->
		 F1
	 end,
    F = case filename:extension(F2) of
	    ".set" ->
		filename:rootname(F2);
	    "" ->
		F2
	end,
    list_to_atom(F).
%%    filename:join(CaseDir, F ++ ".beam").

compile_file(File, Options0) ->
    Options = [warnings_as_errors|Options0],
    try
        ok = asn1ct:compile(File, Options),
        ok = compile_maps(File, Options)
    catch
        _:Reason ->
	    ct:print("Failed to compile ~s\n~p", [File,Reason]),
            error
    end.

compile_maps(File, Options) ->
    unload_map_mod(File),
    Incompat = [abs,compact_bit_string,legacy_bit_string,
                legacy_erlang_types,maps,asn1_test_lib_no_maps],
    case lists:any(fun(E) -> lists:member(E, Incompat) end, Options) of
        true ->
            ok;
        false ->
            compile_maps_1(File, Options)
    end.

compile_maps_1(File, Options) ->
    ok = asn1ct:compile(File, [maps,no_ok_wrapper,noobj|Options]),
    OutDir = proplists:get_value(outdir, Options),
    Base0 = filename:rootname(filename:basename(File)),
    Base = case filename:extension(Base0) of
               ".set" ->
                   filename:rootname(Base0);
               _ ->
                   Base0
           end,
    ErlBase = Base ++ ".erl",
    ErlFile = filename:join(OutDir, ErlBase),
    {ok,Erl0} = file:read_file(ErlFile),
    Erl = re:replace(Erl0, <<"-module\\('">>, "&maps_"),
    MapsErlFile = filename:join(OutDir, "maps_" ++ ErlBase),
    ok = file:write_file(MapsErlFile, Erl),
    {ok,_} = compile:file(MapsErlFile, [report,{outdir,OutDir},{i,OutDir}]),
    ok.

unload_map_mod(File0) ->
    File1 = filename:basename(File0),
    File2 = filename:rootname(File1, ".asn"),
    File3 = filename:rootname(File2, ".asn1"),
    File4 = filename:rootname(File3, ".py"),
    File = filename:rootname(File4, ".set"),
    MapMod = list_to_atom("maps_"++File),
    code:delete(MapMod),
    code:purge(MapMod),
    ok.

compile_erlang(Mod, Config, Options) ->
    DataDir = proplists:get_value(data_dir, Config),
    CaseDir = proplists:get_value(case_dir, Config),
    M = list_to_atom(Mod),
    {ok, M} = compile:file(filename:join(DataDir, Mod),
                           [report,{i,CaseDir},{outdir,CaseDir}|Options]).

rm_dirs([Dir|Dirs]) ->
    {ok,L0} = file:list_dir(Dir),
    L = [filename:join(Dir, F) || F <- L0],
    IsDir = fun(F) -> filelib:is_dir(F) end,
    {Subdirs,Files} = lists:partition(IsDir, L),
    _ = [ok = file:delete(F) || F <- Files],
    rm_dirs(Subdirs),
    ok = file:del_dir(Dir),
    rm_dirs(Dirs);
rm_dirs([]) ->
    ok.

hex_to_bin(S) ->
    << <<(hex2num(C)):4>> || C <- S, C =/= $\s >>.

%% match_value(Pattern, Value) -> ok.
%%  Match Pattern against Value. If the Pattern contains in any
%%  position, the corresponding position in the Value can be
%%  anything. Generate an exception if the Pattern and Value don't
%%  match.

match_value('_', _) ->
    ok;
match_value([H1|T1], [H2|T2]) ->
    match_value(H1, H2),
    match_value(T1, T2);
match_value(T1, T2) when tuple_size(T1) =:= tuple_size(T2) ->
    match_value_tuple(1, T1, T2);
match_value(Same, Same) ->
    ok;
match_value(V1, V2) ->
    error({nomatch,V1,V2}).

roundtrip(Mod, Type, Value) ->
    roundtrip(Mod, Type, Value, Value).

roundtrip(Mod, Type, Value, ExpectedValue) ->
    roundtrip_enc(Mod, Type, Value, ExpectedValue).

roundtrip_enc(Mod, Type, Value) ->
    roundtrip_enc(Mod, Type, Value, Value).

roundtrip_enc(Mod, Type, Value, ExpectedValue) ->
    case Mod:encode(Type, Value) of
        {ok,Encoded} ->
            {ok,ExpectedValue} = Mod:decode(Type, Encoded);
        Encoded when is_binary(Encoded) ->
            ExpectedValue = Mod:decode(Type, Encoded)
    end,
    map_roundtrip(Mod, Type, Encoded),
    test_ber_indefinite(Mod, Type, Encoded, ExpectedValue),
    Encoded.

map_roundtrip(Mod, Type, Encoded) ->
    MapMod = list_to_atom("maps_"++atom_to_list(Mod)),
    try MapMod:maps() of
        true ->
            map_roundtrip_1(MapMod, Type, Encoded)
    catch
        error:undef ->
            ok
    end.

%%%
%%% Internal functions.
%%%

map_roundtrip_1(Mod, Type, Encoded) ->
    Decoded = Mod:decode(Type, Encoded),
    case Mod:encode(Type, Decoded) of
        Encoded ->
            ok;
        OtherEncoding ->
            case is_named_bitstring(Decoded) of
                true ->
                    %% In BER, named BIT STRINGs with different number of
                    %% trailing zeroes decode to the same value.
                    ok;
                false ->
                    error({encode_mismatch,Decoded,Encoded,OtherEncoding})
            end
    end,
    ok.

is_named_bitstring([H|T]) ->
    is_atom(H) andalso is_named_bitstring(T);
is_named_bitstring([]) ->
    true;
is_named_bitstring(_) ->
    false.

hex2num(C) when $0 =< C, C =< $9 -> C - $0;
hex2num(C) when $A =< C, C =< $F -> C - $A + 10;
hex2num(C) when $a =< C, C =< $f -> C - $a + 10.

match_value_tuple(I, T1, T2) when I =< tuple_size(T1) ->
    match_value(element(I, T1), element(I, T2)),
    match_value_tuple(I+1, T1, T2);
match_value_tuple(_, _, _) ->
    ok.

test_ber_indefinite(Mod, Type, Encoded, ExpectedValue) ->
    case Mod:encoding_rule() of
	ber ->
	    Indefinite = iolist_to_binary(ber_indefinite(Encoded)),
            case Mod:decode(Type, Indefinite) of
                {ok,ExpectedValue} ->
                    ok;
                ExpectedValue ->
                    ok
            end;
	_ ->
	    ok
    end.

%% Rewrite all definite lengths for constructed values to an
%% indefinite length.
ber_indefinite(Bin0) ->
    case ber_get_tag(Bin0) of
	done ->
	    [];
	primitive ->
	    Bin0;
	{constructed,Tag,Bin1} ->
	    {Len,Bin2} = ber_get_len(Bin1),
	    <<Val0:Len/binary,Bin/binary>> = Bin2,
	    Val = iolist_to_binary(ber_indefinite(Val0)),
	    [<<Tag/binary,16#80,Val/binary,0,0>>|ber_indefinite(Bin)]
    end.

ber_get_tag(<<>>) ->
    done;
ber_get_tag(<<_:2,0:1,_:5,_/binary>>) ->
    primitive;
ber_get_tag(<<_:2,1:1,_:5,_/binary>>=Bin0) ->
    TagLen = ber_tag_length(Bin0),
    <<Tag:TagLen/binary,Bin/binary>> = Bin0,
    {constructed,Tag,Bin}.

ber_tag_length(<<_:3,2#11111:5,T/binary>>) ->
    ber_tag_length_1(T, 1);
ber_tag_length(_) ->
    1.

ber_tag_length_1(<<1:1,_:7,T/binary>>, N) ->
    ber_tag_length_1(T, N+1);
ber_tag_length_1(<<0:1,_:7,_/binary>>, N) ->
    N+1.

ber_get_len(<<0:1,L:7,T/binary>>) ->
    {L,T};
ber_get_len(<<1:1,Octets:7,T0/binary>>) ->
    <<L:Octets/unit:8,T/binary>> = T0,
    {L,T}.

%% p_run(fun(Data) -> ok|error, List) -> ok
%%  Will fail the test case if there were any errors.

p_run(Test, List) ->
    S = erlang:system_info(schedulers),
    N = case test_server:is_cover() of
	    false ->
		S + 1;
	    true ->
		%% Cover is running. Using too many processes
		%% could slow us down.
		min(S, 4)
	end,
    %%io:format("p_run: ~p parallel processes\n", [N]),
    p_run_loop(Test, List, N, [], 0).

p_run_loop(_, [], _, [], Errors) ->
    case Errors of
	0 -> ok;
	N -> ct:fail({N,errors})
    end;
p_run_loop(Test, [H|T], N, Refs, Errors) when length(Refs) < N ->
    {_,Ref} = erlang:spawn_monitor(fun() -> exit(Test(H)) end),
    p_run_loop(Test, T, N, [Ref|Refs], Errors);
p_run_loop(Test, List, N, Refs0, Errors0) ->
    receive
	{'DOWN',Ref,process,_,Res} ->
	    Errors = case Res of
			 ok -> Errors0;
			 error -> Errors0+1
		     end,
	    Refs = Refs0 -- [Ref],
	    p_run_loop(Test, List, N, Refs, Errors)
    end.