%%
%% %CopyrightBegin%
%%
%% SPDX-License-Identifier: Apache-2.0
%%
%% Copyright Ericsson AB 1999-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%
%%
-module(pdict_SUITE).


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

-define(M(A,B),m(A,B,?MODULE,?LINE)).
-ifdef(DEBUG).
-define(DEBUGF(A,B), io:format(A,B)).
-else.
-define(DEBUGF(A,B), noop).
-endif.

-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
	 init_per_group/2,end_per_group/2,
	 mixed/1,
         literals/1,
         destructive/1,
	 simple/1, complicated/1, heavy/1, simple_all_keys/1, info/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
-export([other_process/2]).

-export([put_do/2, get_do/1, erase_do/1]).

init_per_testcase(_Case, Config) ->
    Config.

end_per_testcase(_Case, _Config) ->
    ok.

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

all() -> 
    [simple, complicated, heavy, simple_all_keys, info,
     literals,
     destructive,
     mixed].

groups() -> 
    [].

init_per_suite(Config) ->
    Config.

end_per_suite(_Config) ->
    ok.

init_per_group(_GroupName, Config) ->
    Config.

end_per_group(_GroupName, Config) ->
    Config.


%% Tests simple functionality in process dictionary.
simple(Config) when is_list(Config) ->
    XX = get(),
    ok = match_keys(XX),
    erase(),
    L = [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,
	    q,r,s,t,u,v,x,y,z,'A','B','C','D'],
    ins_list_0(L),
    ins_list_1(L),
    L2 = lists:keysort(1, lists:map(fun(X) ->
					    {X, atom_to_list(X)}
				    end,
				    L)),
    ?DEBUGF("~p~n",[L2]),
    ?M(L2,lists:keysort(1, get())),
    ins_list_2(L),
    L3 = lists:keysort(1, lists:map(fun(X) ->
					    {hd(atom_to_list(X)) - $a, 
					     atom_to_list(X)}
				    end,
				    L) ++ L2),
    ?DEBUGF("~p~n",[L3]),
    ?M(L3, lists:keysort(1, get())),
    L4 = lists:map(fun(X) ->
			   lists:sort(get_keys(atom_to_list(X)))
		   end,
		   L),
    ?DEBUGF("~p~n",[L4]),
    ?M(L4,lists:map(fun(X) ->
			   lists:sort([X, hd(atom_to_list(X)) - $a])
		   end,
		   L)),
    erase(),
    ?M([],get()),
    [put(Key, Value) || {Key,Value} <- XX],
    ok.

complicated(Config) when is_list(Config) ->
    Previous = get(),
    ok = match_keys(Previous),
    Previous = erase(),
    N = case test_server:is_debug() of
	    false -> 500000;
	    true -> 5000
	end,
    comp_1(N),
    comp_2(N),
    N = comp_3(lists:sort(get()), 1),
    ok = match_keys(get()),
    comp_4(get()),
    [] = get(),
    [] = get_keys(),
    [put(Key, Value) || {Key,Value} <- Previous],
    ok.

comp_1(0) -> ok;
comp_1(N) ->
    undefined = put({key,N}, {value,N}),
    comp_1(N-1).

comp_2(0) -> ok;
comp_2(N) ->
    {value,N} = put({key,N}, {value,N*N}),
    comp_2(N-1).

comp_3([{{key,K},{value,V}}], K) when V =:= K*K ->
    K;
comp_3([{{key,K},{value,V}}|T], K) when V =:= K*K ->
    comp_3(T, K+1).

comp_4([{{key,_}=K,{value,_}=Val}|T]) ->
    Val = erase(K),
    comp_4(T);
comp_4([]) -> ok.

%% Tests heavy usage of the process dictionary.
heavy(Config) when is_list(Config) ->
    XX = get(),
    erase(),
    time(50),
    ?M([],get()),
    time(500),
    ?M([],get()),
    time(5000),
    ?M([],get()),
    case {os:type(),test_server:is_debug()} of
	{_,true} -> ok;	    
	_ ->
	    time(50000),
	    ?M([], get())
    end,
    [put(Key, Value) || {Key,Value} <- XX],
    ok.

simple_all_keys(Config) when is_list(Config) ->
    erase(),
    ok = simple_all_keys_add_loop(1000),
    [] = get_keys(),
    [] = get(),
    ok.

simple_all_keys_add_loop(0) ->
    simple_all_keys_del_loop(erlang:get_keys());
simple_all_keys_add_loop(N) ->
   put(gen_key(N),value),
   ok = match_keys(get()),
   simple_all_keys_add_loop(N-1).

simple_all_keys_del_loop([]) -> ok;
simple_all_keys_del_loop([K|Ks]) ->
    value = erase(K),
    ok = match_keys(get()),
    simple_all_keys_del_loop(Ks).

%% Tests process_info(Pid, dictionary).
info(Config) when is_list(Config) ->
    L = [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,
	    q,r,s,t,u,v,x,y,z,'A','B','C','D'],
    process_flag(trap_exit,true),
    Pid = spawn_link(?MODULE, other_process, [L,self()]),
    Dict = receive
	       {Pid, D} ->
		   D
	   end,
    ?M({dictionary, Dict}, process_info(Pid, dictionary)), 
    Pid ! bye,
    receive
	{'EXIT', Pid, _} ->
	    ok
    end,
    ok.
    
other_process(List,From) ->
    erase(),
    ins_list_1(List),
    From ! {self(), get()},
    receive
	bye ->
	    ok
    end.
    
ins_list_2([]) ->
    done;
ins_list_2([H|T]) ->
    X = {hd(atom_to_list(H)) - $a, atom_to_list(H)},
    _Y = put(element(1,X), element(2,X)),
    ?DEBUGF("Inserting ~w: ~w~n",[X,_Y]),
    ins_list_2(T).

ins_list_1([]) ->
    done;
ins_list_1([H|T]) ->
    X = {H, atom_to_list(H)},
    _Y = put(element(1,X), element(2,X)),
    ?DEBUGF("Inserting ~w: ~w~n",[X,_Y]),
    ins_list_1(T).

ins_list_0([]) ->
    done;
ins_list_0([H|T]) ->
    X = {H, H},
    _Y = put(element(1,X), element(2,X)),
    ?DEBUGF("Inserting ~w: ~w~n",[X,_Y]),
    ins_list_0(T).

time(N) ->
    ?DEBUGF("~p~n",[erlang:process_info(self())]),
    TT1 = erlang:now(),
    T1 = insert_testloop(N,N,0),
    TT2 = erlang:now(),
    T2 = lookup_testloop(N,N,0),
    TT3 = erlang:now(),
    T5 = delete_testloop(N,N,0),
    TT6 = erlang:now(),
    io:format("~p inserts took ~.2f(~.2f) seconds~n",
	      [N, nowdiff3(TT1,TT2), T1 / 100]),
    io:format("~p lookups took ~.2f(~.2f) seconds~n",
	      [N, nowdiff3(TT2,TT3), T2 / 100]),
    io:format("~p deletes took ~.2f(~.2f) seconds~n",
	      [N, nowdiff3(TT3,TT6), T5 / 100]),
    io:format("Total time for ~p elements is ~.2f(~.2f) seconds~n",
	      [N, nowdiff3(TT1,TT6), (T1+T2+T5) / 100]),
    ok.

key_to_object(Key) ->
    {Key, Key,[Key, Key, {Key, banan}]}.

time_call(Fun,Acc) ->
    T1 = erlang:now(),
    Ret = Fun(),
    T2 = erlang:now(),
    {nowdiff2(T1,T2)+Acc,Ret}.

delete_testloop(0, _X, Acc) ->
    ?DEBUGF("all ~p deleted~n",[_X]),
    Acc;

delete_testloop(N, X, Acc) ->
    Key = gen_key(N),
    Obj = key_to_object(Key),
    case get(Key) of
	Obj ->
	    ok;
	Y ->
	    io:format("Error - Object ~p does not exist when we are "
		      "gonna delete!(N=~p, result=~p)~n",[Obj,N,Y]),
	    exit({inconsistent_1, delete_testloop, Obj, N, Y})
    end,
    
    {T, Obj2} = time_call(fun() -> erase(Key) end, Acc),
    ?M(Obj,Obj2),
    case {(X-N) rem 10000,(X-N)} of
	{_,0} ->
	    ok;
	{0,_} ->
	    ?DEBUGF("~p~n",[X-N]);
	_ ->
	    ok
    end,
    case get(Key) of
	undefined ->
	    ok;
	Else ->
	    io:format("Error - Object ~p does still exist after "
		      "delete!(N=~p, result=~p)~n",[Obj,N,Else]),
	    exit({inconsistent_2, delete_testloop, Obj, N, Else})
    end,
    delete_testloop(N-1,X,T).

lookup_testloop(0, X, Acc) ->
    io:format("all ~p looked up~n",[X]),
    Acc;
lookup_testloop(N, X, Acc) ->
    Key = gen_key(N),
    D = key_to_object(Key),
    {T, D2} = time_call(fun() -> get(Key) end, Acc),
    ?M(D,D2),
    case {(X-N) rem 10000,(X-N)} of
	{_,0} ->
	    ok;
	{0,_} ->
	    ?DEBUGF("~p~n",[X-N]);
	_ ->
	    ok
    end,
    lookup_testloop(N-1,X,T).
    
insert_testloop(0,X,Acc) ->
    io:format("all ~p inserted~n",[X]),
    Acc;
insert_testloop(N,X,Acc) ->
    Key = gen_key(N),
    D = key_to_object(Key),
    {T,_} = time_call(fun() -> put(Key,D) end, Acc),
    case {(X-N) rem 10000,(X-N)} of
	{_,0} ->
	    ok;
	{0,_} ->
	    ?DEBUGF("~p~n",[X-N]);
	_ ->
	    ok
    end,
    insert_testloop(N-1,X,T).
    

gen_key(0,A)->
    A;
gen_key(N,A) ->
    X = ((N-1) rem 26) + $a,
    gen_key((N-1) div 26, [X|A]).
gen_key(N) ->
    gen_key(N+1,[]).

nowtonumber({Mega, Secs, Milli}) ->
    Milli div 10000 + Secs * 100 + Mega * 100000000.

nowdiff2(T1,T2) ->
    nowtonumber(T2) - nowtonumber(T1).
nowdiff3(T1,T2) ->
    (nowtonumber(T2) - nowtonumber(T1)) / 100.

m(A,B,Module,Line) ->
    case A == B of
	true ->
	    ok;
	_ ->
	    io:format("~p does not match ~p in module ~p, line ~p, exit.~n",
		      [A,B,Module,Line]),
	    exit({no_match,{A,B},Module,Line})
    end.

match_keys(All) ->
    Ks = lists:sort([K||{K,_}<-All]),
    Ks = lists:sort(erlang:get_keys()),
    ok.


%% Test destructive put optimization of immed values
%% does not affect get/0 or process_info.
destructive(_Config) ->
    Keys = lists:seq(1,100),
    [put(Key, 17) || Key <- Keys],
    Get1 = get(),
    {dictionary,PI1} = process_info(self(), dictionary),

    [begin
         {Key, 17} = lists:keyfind(Key, 1, Get1),
         {Key, 17} = lists:keyfind(Key, 1, PI1)
     end
     || Key <- Keys],

    [17 = put(Key, 42) || Key <- Keys],   % Mutate

    Get2 = get(),
    {dictionary,PI2} = process_info(self(), dictionary),

    [begin
         {Key, 17} = lists:keyfind(Key, 1, Get1),
         {Key, 17} = lists:keyfind(Key, 1, PI1),
         {Key, 42} = lists:keyfind(Key, 1, Get2),
         {Key, 42} = lists:keyfind(Key, 1, PI2)

     end
     || Key <- Keys],

    ok.

%% Do random mixed put/erase to test grow/shrink
%% Written for a temporary bug in gc during shrink
mixed(_Config) ->
    Rand0 = rand:seed_s(exsplus),
    io:format("Random seed = ~p\n\n", [rand:export_seed_s(Rand0)]),

    erts_debug:set_internal_state(available_internal_state, true),
    try
	C = do_mixed([10,0,100,50,1000,500,600,100,150,1,11,2,30,0],
		     0,
		     array:new(),
		     1,
		     Rand0),
	io:format("\nDid total of ~p operations\n", [C])
    after
	erts_debug:set_internal_state(available_internal_state, false)
    end.

do_mixed([], _, _, C, _) ->
    C;
do_mixed([GoalN | Tail], GoalN, Array, C, Rand0) ->
    io:format("Reached goal of ~p keys in dict after ~p mixed ops\n",[GoalN, C]),
    GoalN = array:size(Array),
    do_mixed(Tail, GoalN, Array, C, Rand0);
do_mixed([GoalN | _]=Goals, CurrN, Array0, C, Rand0) ->
    CurrN = array:size(Array0),
    GrowPercent = case GoalN > CurrN of
		      true when CurrN == 0 -> 100;
		      true -> 75;
		      false -> 25
		  end,
    {R, Rand1} = rand:uniform_s(100, Rand0),
    case R of
	_ when R =< GrowPercent ->   %%%%%%%%%%%%% GROW
	    {Key, Rand2} = rand:uniform_s(10000, Rand1),
	    case put(Key, {Key,C}) of
		undefined ->
		    Array1 = array:set(CurrN, Key, Array0),
		    do_mixed(Goals, CurrN+1, Array1, C+1, Rand2);
		_ ->
		    do_mixed(Goals, CurrN, Array0, C+1, Rand2)
	    end;

	_ ->                          %%%%%%%%%% SHRINK
	    {Kix, Rand2} = rand:uniform_s(CurrN, Rand1),
	    Key = array:get(Kix-1, Array0),

	    %% provoke GC during shrink
	    erts_debug:set_internal_state(fill_heap, true),

	    {Key, _} = erase(Key),
	    Array1 = array:set(Kix-1, array:get(CurrN-1, Array0), Array0),
	    Array2 = array:resize(CurrN-1, Array1),
	    do_mixed(Goals, CurrN-1, Array2, C+1, Rand2)
    end.

%% Test hash precalculation of literal keys
literals(_Config) ->
    %% Put literal -> get variable
    put(1742, "1742"),
    "1742" = ?MODULE:get_do(1742),
    "1742" = ?MODULE:erase_do(1742),

    put(-1742, "-1742"),
    "-1742" = ?MODULE:get_do(-1742),
    "-1742" = ?MODULE:erase_do(-1742),

    put([], "NIL"),
    "NIL" = ?MODULE:get_do([]),
    "NIL" = ?MODULE:erase_do([]),

    put(<<"binary">>, "binary"),
    "binary" = ?MODULE:get_do(<<"binary">>),
    "binary" = ?MODULE:erase_do(<<"binary">>),

    BigBin = <<"A large binary with a lot of bytes to make it go off heap as shared and reference counted">>,
    put(BigBin, "bigbin"),
    "bigbin" = ?MODULE:get_do(BigBin),
    "bigbin" = ?MODULE:erase_do(BigBin),

    %% Put variable -> get literal
    ?MODULE:put_do(4217, "4217"),
    "4217" = get(4217),
    "4217" = erase(4217),

    ?MODULE:put_do(-4217, "-4217"),
    "-4217" = get(-4217),
    "-4217" = erase(-4217),

    ?MODULE:put_do([], "NIL"),
    "NIL" = get([]),
    "NIL" = erase([]),

    ?MODULE:put_do(<<"bytes">>, "bytes"),
    "bytes" = get(<<"bytes">>),
    "bytes" = erase(<<"bytes">>),

    ?MODULE:put_do(BigBin, "BigBin"),
    "BigBin" = get(BigBin),
    "BigBin" = erase(BigBin),

    ok.

put_do(K, V) ->
    put(K, V).

get_do(K) ->
    get(K).

erase_do(K) ->
    erase(K).
