1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1999-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-module(pdict_SUITE).
21
22
23-include_lib("common_test/include/ct.hrl").
24
25-define(M(A,B),m(A,B,?MODULE,?LINE)).
26-ifdef(DEBUG).
27-define(DEBUGF(A,B), io:format(A,B)).
28-else.
29-define(DEBUGF(A,B), noop).
30-endif.
31
32-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
33	 init_per_group/2,end_per_group/2,
34	 mixed/1,
35         literals/1,
36         destructive/1,
37	 simple/1, complicated/1, heavy/1, simple_all_keys/1, info/1]).
38-export([init_per_testcase/2, end_per_testcase/2]).
39-export([other_process/2]).
40
41-export([put_do/2, get_do/1, erase_do/1]).
42
43init_per_testcase(_Case, Config) ->
44    Config.
45
46end_per_testcase(_Case, _Config) ->
47    ok.
48
49suite() ->
50    [{ct_hooks,[ts_install_cth]},
51     {timetrap,{minutes,1}}].
52
53all() ->
54    [simple, complicated, heavy, simple_all_keys, info,
55     literals,
56     destructive,
57     mixed].
58
59groups() ->
60    [].
61
62init_per_suite(Config) ->
63    Config.
64
65end_per_suite(_Config) ->
66    ok.
67
68init_per_group(_GroupName, Config) ->
69    Config.
70
71end_per_group(_GroupName, Config) ->
72    Config.
73
74
75%% Tests simple functionality in process dictionary.
76simple(Config) when is_list(Config) ->
77    XX = get(),
78    ok = match_keys(XX),
79    erase(),
80    L = [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,
81	    q,r,s,t,u,v,x,y,z,'A','B','C','D'],
82    ins_list_0(L),
83    ins_list_1(L),
84    L2 = lists:keysort(1, lists:map(fun(X) ->
85					    {X, atom_to_list(X)}
86				    end,
87				    L)),
88    ?DEBUGF("~p~n",[L2]),
89    ?M(L2,lists:keysort(1, get())),
90    ins_list_2(L),
91    L3 = lists:keysort(1, lists:map(fun(X) ->
92					    {hd(atom_to_list(X)) - $a,
93					     atom_to_list(X)}
94				    end,
95				    L) ++ L2),
96    ?DEBUGF("~p~n",[L3]),
97    ?M(L3, lists:keysort(1, get())),
98    L4 = lists:map(fun(X) ->
99			   lists:sort(get_keys(atom_to_list(X)))
100		   end,
101		   L),
102    ?DEBUGF("~p~n",[L4]),
103    ?M(L4,lists:map(fun(X) ->
104			   lists:sort([X, hd(atom_to_list(X)) - $a])
105		   end,
106		   L)),
107    erase(),
108    ?M([],get()),
109    [put(Key, Value) || {Key,Value} <- XX],
110    ok.
111
112complicated(Config) when is_list(Config) ->
113    Previous = get(),
114    ok = match_keys(Previous),
115    Previous = erase(),
116    N = case test_server:is_debug() of
117	    false -> 500000;
118	    true -> 5000
119	end,
120    comp_1(N),
121    comp_2(N),
122    N = comp_3(lists:sort(get()), 1),
123    ok = match_keys(get()),
124    comp_4(get()),
125    [] = get(),
126    [] = get_keys(),
127    [put(Key, Value) || {Key,Value} <- Previous],
128    ok.
129
130comp_1(0) -> ok;
131comp_1(N) ->
132    undefined = put({key,N}, {value,N}),
133    comp_1(N-1).
134
135comp_2(0) -> ok;
136comp_2(N) ->
137    {value,N} = put({key,N}, {value,N*N}),
138    comp_2(N-1).
139
140comp_3([{{key,K},{value,V}}], K) when V =:= K*K ->
141    K;
142comp_3([{{key,K},{value,V}}|T], K) when V =:= K*K ->
143    comp_3(T, K+1).
144
145comp_4([{{key,_}=K,{value,_}=Val}|T]) ->
146    Val = erase(K),
147    comp_4(T);
148comp_4([]) -> ok.
149
150%% Tests heavy usage of the process dictionary.
151heavy(Config) when is_list(Config) ->
152    XX = get(),
153    erase(),
154    time(50),
155    ?M([],get()),
156    time(500),
157    ?M([],get()),
158    time(5000),
159    ?M([],get()),
160    case {os:type(),test_server:is_debug()} of
161	{_,true} -> ok;
162	_ ->
163	    time(50000),
164	    ?M([], get())
165    end,
166    [put(Key, Value) || {Key,Value} <- XX],
167    ok.
168
169simple_all_keys(Config) when is_list(Config) ->
170    erase(),
171    ok = simple_all_keys_add_loop(1000),
172    [] = get_keys(),
173    [] = get(),
174    ok.
175
176simple_all_keys_add_loop(0) ->
177    simple_all_keys_del_loop(erlang:get_keys());
178simple_all_keys_add_loop(N) ->
179   put(gen_key(N),value),
180   ok = match_keys(get()),
181   simple_all_keys_add_loop(N-1).
182
183simple_all_keys_del_loop([]) -> ok;
184simple_all_keys_del_loop([K|Ks]) ->
185    value = erase(K),
186    ok = match_keys(get()),
187    simple_all_keys_del_loop(Ks).
188
189%% Tests process_info(Pid, dictionary).
190info(Config) when is_list(Config) ->
191    L = [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,
192	    q,r,s,t,u,v,x,y,z,'A','B','C','D'],
193    process_flag(trap_exit,true),
194    Pid = spawn_link(?MODULE, other_process, [L,self()]),
195    Dict = receive
196	       {Pid, D} ->
197		   D
198	   end,
199    ?M({dictionary, Dict}, process_info(Pid, dictionary)),
200    Pid ! bye,
201    receive
202	{'EXIT', Pid, _} ->
203	    ok
204    end,
205    ok.
206
207other_process(List,From) ->
208    erase(),
209    ins_list_1(List),
210    From ! {self(), get()},
211    receive
212	bye ->
213	    ok
214    end.
215
216ins_list_2([]) ->
217    done;
218ins_list_2([H|T]) ->
219    X = {hd(atom_to_list(H)) - $a, atom_to_list(H)},
220    _Y = put(element(1,X), element(2,X)),
221    ?DEBUGF("Inserting ~w: ~w~n",[X,_Y]),
222    ins_list_2(T).
223
224ins_list_1([]) ->
225    done;
226ins_list_1([H|T]) ->
227    X = {H, atom_to_list(H)},
228    _Y = put(element(1,X), element(2,X)),
229    ?DEBUGF("Inserting ~w: ~w~n",[X,_Y]),
230    ins_list_1(T).
231
232ins_list_0([]) ->
233    done;
234ins_list_0([H|T]) ->
235    X = {H, H},
236    _Y = put(element(1,X), element(2,X)),
237    ?DEBUGF("Inserting ~w: ~w~n",[X,_Y]),
238    ins_list_0(T).
239
240time(N) ->
241    ?DEBUGF("~p~n",[erlang:process_info(self())]),
242    TT1 = erlang:now(),
243    T1 = insert_testloop(N,N,0),
244    TT2 = erlang:now(),
245    T2 = lookup_testloop(N,N,0),
246    TT3 = erlang:now(),
247    T5 = delete_testloop(N,N,0),
248    TT6 = erlang:now(),
249    io:format("~p inserts took ~.2f(~.2f) seconds~n",
250	      [N, nowdiff3(TT1,TT2), T1 / 100]),
251    io:format("~p lookups took ~.2f(~.2f) seconds~n",
252	      [N, nowdiff3(TT2,TT3), T2 / 100]),
253    io:format("~p deletes took ~.2f(~.2f) seconds~n",
254	      [N, nowdiff3(TT3,TT6), T5 / 100]),
255    io:format("Total time for ~p elements is ~.2f(~.2f) seconds~n",
256	      [N, nowdiff3(TT1,TT6), (T1+T2+T5) / 100]),
257    ok.
258
259key_to_object(Key) ->
260    {Key, Key,[Key, Key, {Key, banan}]}.
261
262time_call(Fun,Acc) ->
263    T1 = erlang:now(),
264    Ret = Fun(),
265    T2 = erlang:now(),
266    {nowdiff2(T1,T2)+Acc,Ret}.
267
268delete_testloop(0, _X, Acc) ->
269    ?DEBUGF("all ~p deleted~n",[_X]),
270    Acc;
271
272delete_testloop(N, X, Acc) ->
273    Key = gen_key(N),
274    Obj = key_to_object(Key),
275    case get(Key) of
276	Obj ->
277	    ok;
278	Y ->
279	    io:format("Error - Object ~p does not exist when we are "
280		      "gonna delete!(N=~p, result=~p)~n",[Obj,N,Y]),
281	    exit({inconsistent_1, delete_testloop, Obj, N, Y})
282    end,
283
284    {T, Obj2} = time_call(fun() -> erase(Key) end, Acc),
285    ?M(Obj,Obj2),
286    case {(X-N) rem 10000,(X-N)} of
287	{_,0} ->
288	    ok;
289	{0,_} ->
290	    ?DEBUGF("~p~n",[X-N]);
291	_ ->
292	    ok
293    end,
294    case get(Key) of
295	undefined ->
296	    ok;
297	Else ->
298	    io:format("Error - Object ~p does still exist after "
299		      "delete!(N=~p, result=~p)~n",[Obj,N,Else]),
300	    exit({inconsistent_2, delete_testloop, Obj, N, Else})
301    end,
302    delete_testloop(N-1,X,T).
303
304lookup_testloop(0, X, Acc) ->
305    io:format("all ~p looked up~n",[X]),
306    Acc;
307lookup_testloop(N, X, Acc) ->
308    Key = gen_key(N),
309    D = key_to_object(Key),
310    {T, D2} = time_call(fun() -> get(Key) end, Acc),
311    ?M(D,D2),
312    case {(X-N) rem 10000,(X-N)} of
313	{_,0} ->
314	    ok;
315	{0,_} ->
316	    ?DEBUGF("~p~n",[X-N]);
317	_ ->
318	    ok
319    end,
320    lookup_testloop(N-1,X,T).
321
322insert_testloop(0,X,Acc) ->
323    io:format("all ~p inserted~n",[X]),
324    Acc;
325insert_testloop(N,X,Acc) ->
326    Key = gen_key(N),
327    D = key_to_object(Key),
328    {T,_} = time_call(fun() -> put(Key,D) end, Acc),
329    case {(X-N) rem 10000,(X-N)} of
330	{_,0} ->
331	    ok;
332	{0,_} ->
333	    ?DEBUGF("~p~n",[X-N]);
334	_ ->
335	    ok
336    end,
337    insert_testloop(N-1,X,T).
338
339
340gen_key(0,A)->
341    A;
342gen_key(N,A) ->
343    X = ((N-1) rem 26) + $a,
344    gen_key((N-1) div 26, [X|A]).
345gen_key(N) ->
346    gen_key(N+1,[]).
347
348nowtonumber({Mega, Secs, Milli}) ->
349    Milli div 10000 + Secs * 100 + Mega * 100000000.
350
351nowdiff2(T1,T2) ->
352    nowtonumber(T2) - nowtonumber(T1).
353nowdiff3(T1,T2) ->
354    (nowtonumber(T2) - nowtonumber(T1)) / 100.
355
356m(A,B,Module,Line) ->
357    case A == B of
358	true ->
359	    ok;
360	_ ->
361	    io:format("~p does not match ~p in module ~p, line ~p, exit.~n",
362		      [A,B,Module,Line]),
363	    exit({no_match,{A,B},Module,Line})
364    end.
365
366match_keys(All) ->
367    Ks = lists:sort([K||{K,_}<-All]),
368    Ks = lists:sort(erlang:get_keys()),
369    ok.
370
371
372%% Test destructive put optimization of immed values
373%% does not affect get/0 or process_info.
374destructive(_Config) ->
375    Keys = lists:seq(1,100),
376    [put(Key, 17) || Key <- Keys],
377    Get1 = get(),
378    {dictionary,PI1} = process_info(self(), dictionary),
379
380    [begin
381         {Key, 17} = lists:keyfind(Key, 1, Get1),
382         {Key, 17} = lists:keyfind(Key, 1, PI1)
383     end
384     || Key <- Keys],
385
386    [17 = put(Key, 42) || Key <- Keys],   % Mutate
387
388    Get2 = get(),
389    {dictionary,PI2} = process_info(self(), dictionary),
390
391    [begin
392         {Key, 17} = lists:keyfind(Key, 1, Get1),
393         {Key, 17} = lists:keyfind(Key, 1, PI1),
394         {Key, 42} = lists:keyfind(Key, 1, Get2),
395         {Key, 42} = lists:keyfind(Key, 1, PI2)
396
397     end
398     || Key <- Keys],
399
400    ok.
401
402%% Do random mixed put/erase to test grow/shrink
403%% Written for a temporary bug in gc during shrink
404mixed(_Config) ->
405    Rand0 = rand:seed_s(exsplus),
406    io:format("Random seed = ~p\n\n", [rand:export_seed_s(Rand0)]),
407
408    erts_debug:set_internal_state(available_internal_state, true),
409    try
410	C = do_mixed([10,0,100,50,1000,500,600,100,150,1,11,2,30,0],
411		     0,
412		     array:new(),
413		     1,
414		     Rand0),
415	io:format("\nDid total of ~p operations\n", [C])
416    after
417	erts_debug:set_internal_state(available_internal_state, false)
418    end.
419
420do_mixed([], _, _, C, _) ->
421    C;
422do_mixed([GoalN | Tail], GoalN, Array, C, Rand0) ->
423    io:format("Reached goal of ~p keys in dict after ~p mixed ops\n",[GoalN, C]),
424    GoalN = array:size(Array),
425    do_mixed(Tail, GoalN, Array, C, Rand0);
426do_mixed([GoalN | _]=Goals, CurrN, Array0, C, Rand0) ->
427    CurrN = array:size(Array0),
428    GrowPercent = case GoalN > CurrN of
429		      true when CurrN == 0 -> 100;
430		      true -> 75;
431		      false -> 25
432		  end,
433    {R, Rand1} = rand:uniform_s(100, Rand0),
434    case R of
435	_ when R =< GrowPercent ->   %%%%%%%%%%%%% GROW
436	    {Key, Rand2} = rand:uniform_s(10000, Rand1),
437	    case put(Key, {Key,C}) of
438		undefined ->
439		    Array1 = array:set(CurrN, Key, Array0),
440		    do_mixed(Goals, CurrN+1, Array1, C+1, Rand2);
441		_ ->
442		    do_mixed(Goals, CurrN, Array0, C+1, Rand2)
443	    end;
444
445	_ ->                          %%%%%%%%%% SHRINK
446	    {Kix, Rand2} = rand:uniform_s(CurrN, Rand1),
447	    Key = array:get(Kix-1, Array0),
448
449	    %% provoke GC during shrink
450	    erts_debug:set_internal_state(fill_heap, true),
451
452	    {Key, _} = erase(Key),
453	    Array1 = array:set(Kix-1, array:get(CurrN-1, Array0), Array0),
454	    Array2 = array:resize(CurrN-1, Array1),
455	    do_mixed(Goals, CurrN-1, Array2, C+1, Rand2)
456    end.
457
458%% Test hash precalculation of literal keys
459literals(_Config) ->
460    %% Put literal -> get variable
461    put(1742, "1742"),
462    "1742" = ?MODULE:get_do(1742),
463    "1742" = ?MODULE:erase_do(1742),
464
465    put(-1742, "-1742"),
466    "-1742" = ?MODULE:get_do(-1742),
467    "-1742" = ?MODULE:erase_do(-1742),
468
469    put([], "NIL"),
470    "NIL" = ?MODULE:get_do([]),
471    "NIL" = ?MODULE:erase_do([]),
472
473    put(<<"binary">>, "binary"),
474    "binary" = ?MODULE:get_do(<<"binary">>),
475    "binary" = ?MODULE:erase_do(<<"binary">>),
476
477    BigBin = <<"A large binary with a lot of bytes to make it go off heap as shared and reference counted">>,
478    put(BigBin, "bigbin"),
479    "bigbin" = ?MODULE:get_do(BigBin),
480    "bigbin" = ?MODULE:erase_do(BigBin),
481
482    %% Put variable -> get literal
483    ?MODULE:put_do(4217, "4217"),
484    "4217" = get(4217),
485    "4217" = erase(4217),
486
487    ?MODULE:put_do(-4217, "-4217"),
488    "-4217" = get(-4217),
489    "-4217" = erase(-4217),
490
491    ?MODULE:put_do([], "NIL"),
492    "NIL" = get([]),
493    "NIL" = erase([]),
494
495    ?MODULE:put_do(<<"bytes">>, "bytes"),
496    "bytes" = get(<<"bytes">>),
497    "bytes" = erase(<<"bytes">>),
498
499    ?MODULE:put_do(BigBin, "BigBin"),
500    "BigBin" = get(BigBin),
501    "BigBin" = erase(BigBin),
502
503    ok.
504
505put_do(K, V) ->
506    put(K, V).
507
508get_do(K) ->
509    get(K).
510
511erase_do(K) ->
512    erase(K).
513