1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2004-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
21%% This module tests the ordsets, sets, and gb_sets modules.
22%%
23
24-module(sets_SUITE).
25
26-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
27	 init_per_group/2,end_per_group/2,
28	 init_per_testcase/2,end_per_testcase/2,
29	 create/1,add_element/1,del_element/1,
30	 subtract/1,intersection/1,union/1,is_subset/1,
31	 is_disjoint/1,is_set/1,is_empty/1,fold/1,filter/1,
32	 take_smallest/1,take_largest/1, iterate/1]).
33
34-include_lib("common_test/include/ct.hrl").
35
36-import(lists, [foldl/3,reverse/1]).
37
38init_per_testcase(_Case, Config) ->
39    Config.
40
41end_per_testcase(_Case, _Config) ->
42    ok.
43
44suite() ->
45    [{ct_hooks,[ts_install_cth]},
46     {timetrap,{minutes,5}}].
47
48all() ->
49    [create, add_element, del_element, subtract,
50     intersection, union, is_subset, is_set, fold, filter,
51     take_smallest, take_largest, iterate, is_empty, is_disjoint].
52
53groups() ->
54    [].
55
56init_per_suite(Config) ->
57    Config.
58
59end_per_suite(_Config) ->
60    ok.
61
62init_per_group(_GroupName, Config) ->
63    Config.
64
65end_per_group(_GroupName, Config) ->
66    Config.
67
68
69create(Config) when is_list(Config) ->
70    test_all(fun create_1/1).
71
72create_1(M) ->
73    S0 = M(empty, []),
74    [] = M(to_list, S0),
75    0 = M(size, S0),
76    true = M(is_empty, S0),
77    E = make_ref(),
78    One = M(singleton, E),
79    1 = M(size, One),
80    false = M(is_empty, One),
81    [E] = M(to_list, One),
82    S0.
83
84add_element(Config) when is_list(Config) ->
85    test_all([{0,132},{253,258},{510,514}], fun add_element_1/2).
86
87add_element_1(List, M) ->
88    S = M(from_list, List),
89    SortedSet = lists:usort(List),
90    SortedSet = lists:sort(M(to_list, S)),
91
92    %% Make sure that we get the same result by inserting
93    %% elements one at the time.
94    S2 = foldl(fun(El, Set) -> M(add_element, {El,Set}) end,
95	       M(empty, []), List),
96    true = M(equal, {S,S2}),
97
98    %% Insert elements, randomly delete inserted elements,
99    %% and re-inserted all deleted elements at the end.
100    S3 = add_element_del(List, M, M(empty, []), [], []),
101    true = M(equal, {S2,S3}),
102    true = M(equal, {S,S3}),
103    S.
104
105add_element_del([H|T], M, S, Del, []) ->
106    add_element_del(T, M, M(add_element, {H,S}), Del, [H]);
107add_element_del([H|T], M, S0, Del, Inserted) ->
108    S1 = M(add_element, {H,S0}),
109    case rand:uniform(3) of
110	1 ->
111	    OldEl = lists:nth(rand:uniform(length(Inserted)), Inserted),
112	    S = M(del_element, {OldEl,S1}),
113	    add_element_del(T, M, S, [OldEl|Del], [H|Inserted]);
114	_ ->
115	    add_element_del(T, M, S1, Del, [H|Inserted])
116    end;
117add_element_del([], M, S, Del, _) ->
118    M(union, {S,M(from_list, Del)}).
119
120del_element(Config) when is_list(Config) ->
121    test_all([{0,132},{253,258},{510,514},{1022,1026}], fun del_element_1/2).
122
123del_element_1(List, M) ->
124    S0 = M(from_list, List),
125    Empty = foldl(fun(El, Set) -> M(del_element, {El,Set}) end, S0, List),
126    true = M(equal, {Empty,M(empty, [])}),
127    true = M(is_empty, Empty),
128    S1 = foldl(fun(El, Set) ->
129		       M(add_element, {El,Set})
130	       end, S0, reverse(List)),
131    true = M(equal, {S0,S1}),
132    S1.
133
134subtract(Config) when is_list(Config) ->
135    test_all(fun subtract_empty/1),
136
137    %% Note: No empty set.
138    test_all([{2,69},{126,130},{253,258},511,512,{1023,1030}], fun subtract_1/2).
139
140subtract_empty(M) ->
141    Empty = M(empty, []),
142    true = M(is_empty, M(subtract, {Empty,Empty})),
143    M(subtract, {Empty,Empty}).
144
145subtract_1(List, M) ->
146    S0 = M(from_list, List),
147    Empty = M(empty, []),
148
149    %% Trivial cases.
150    true = M(is_empty, M(subtract, {Empty,S0})),
151    true = M(equal, {S0,M(subtract, {S0,Empty})}),
152
153    %% Not so trivial.
154    subtract_check(List, mutate_some(remove_some(List, 0.4)), M),
155    subtract_check(List, rnd_list(length(List) div 2 + 5), M),
156    subtract_check(List, rnd_list(length(List) div 7 + 9), M),
157    subtract_check(List, mutate_some(List), M).
158
159subtract_check(A, B, M) ->
160    one_subtract_check(B, A, M),
161    one_subtract_check(A, B, M).
162
163one_subtract_check(A, B, M) ->
164    ASorted = lists:usort(A),
165    BSorted = lists:usort(B),
166    ASet = M(from_list, A),
167    BSet = M(from_list, B),
168    DiffSet = M(subtract, {ASet,BSet}),
169    Diff = ASorted -- BSorted,
170    true = M(equal, {DiffSet,M(from_list, Diff)}),
171    Diff = lists:sort(M(to_list, DiffSet)),
172    DiffSet.
173
174intersection(Config) when is_list(Config) ->
175    %% Note: No empty set.
176    test_all([{1,65},{126,130},{253,259},{499,513},{1023,1025}], fun intersection_1/2).
177
178intersection_1(List, M) ->
179    S0 = M(from_list, List),
180
181    %% Intersection with self.
182    true = M(equal, {S0,M(intersection, {S0,S0})}),
183    true = M(equal, {S0,M(intersection, [S0,S0])}),
184    true = M(equal, {S0,M(intersection, [S0,S0,S0])}),
185    true = M(equal, {S0,M(intersection, [S0])}),
186
187    %% Intersection with empty.
188    Empty = M(empty, []),
189    true = M(equal, {Empty,M(intersection, {S0,Empty})}),
190    true = M(equal, {Empty,M(intersection, [S0,Empty,S0,Empty])}),
191
192    %% The intersection of no sets is undefined.
193    {'EXIT',_} = (catch M(intersection, [])),
194
195    %% Disjoint sets.
196    Disjoint = [{El} || El <- List],
197    DisjointSet = M(from_list, Disjoint),
198    true = M(is_empty, M(intersection, {S0,DisjointSet})),
199
200    %% Disjoint, different sizes.
201    [begin
202	 SomeRemoved = M(from_list, remove_some(Disjoint, HowMuch)),
203	 true = M(is_empty, M(intersection, {S0,SomeRemoved})),
204	 MoreRemoved = M(from_list, remove_some(List, HowMuch)),
205	 true = M(is_empty, M(intersection, {MoreRemoved,DisjointSet}))
206     end || HowMuch <- [0.3,0.5,0.7,0.9]],
207
208    %% Partial overlap (one or more elements in result set).
209    %% The sets have almost the same size. (Almost because a duplicated
210    %% element in the original list could be mutated and not mutated
211    %% at the same time.)
212    PartialOverlap = mutate_some(List, []),
213    IntersectionSet = check_intersection(List, PartialOverlap, M),
214    false = M(is_empty, IntersectionSet),
215
216    %% Partial overlap, different set sizes. (Intersection possibly empty.)
217    check_intersection(List, remove_some(PartialOverlap, 0.1), M),
218    check_intersection(List, remove_some(PartialOverlap, 0.3), M),
219    check_intersection(List, remove_some(PartialOverlap, 0.5), M),
220    check_intersection(List, remove_some(PartialOverlap, 0.7), M),
221    check_intersection(List, remove_some(PartialOverlap, 0.9), M),
222
223    IntersectionSet.
224
225check_intersection(Orig, Mutated, M) ->
226    OrigSet = M(from_list, Orig),
227    MutatedSet = M(from_list, Mutated),
228    Intersection = [El || El <- Mutated, not is_tuple(El)],
229    SortedIntersection = lists:usort(Intersection),
230    IntersectionSet = M(intersection, {OrigSet,MutatedSet}),
231    true = M(equal, {IntersectionSet,M(from_list, SortedIntersection)}),
232    SortedIntersection = lists:sort(M(to_list, IntersectionSet)),
233
234    IntersectionSet.
235
236
237union(Config) when is_list(Config) ->
238    %% Note: No empty set.
239    test_all([{1,71},{125,129},{254,259},{510,513},{1023,1025}], fun union_1/2).
240
241union_1(List, M) ->
242    S = M(from_list, List),
243
244    %% Union with self and empty.
245    Empty = M(empty, []),
246    true = M(equal, {S,M(union, {S,S})}),
247    true = M(equal, {S,M(union, [S,S])}),
248    true = M(equal, {S,M(union, [S,S,Empty])}),
249    true = M(equal, {S,M(union, [S,Empty,S])}),
250    true = M(equal, {S,M(union, {S,Empty})}),
251    true = M(equal, {S,M(union, [S])}),
252    true = M(is_empty, M(union, [])),
253
254    %% Partial overlap.
255    check_union(List, remove_some(mutate_some(List), 0.9), M),
256    check_union(List, remove_some(mutate_some(List), 0.7), M),
257    check_union(List, remove_some(mutate_some(List), 0.5), M),
258    check_union(List, remove_some(mutate_some(List), 0.3), M),
259    check_union(List, remove_some(mutate_some(List), 0.1), M),
260
261    check_union(List, mutate_some(remove_some(List, 0.9)), M),
262    check_union(List, mutate_some(remove_some(List, 0.7)), M),
263    check_union(List, mutate_some(remove_some(List, 0.5)), M),
264    check_union(List, mutate_some(remove_some(List, 0.3)), M),
265    check_union(List, mutate_some(remove_some(List, 0.1)), M).
266
267check_union(Orig, Other, M) ->
268    OrigSet = M(from_list, Orig),
269    OtherSet = M(from_list, Other),
270    Union = Orig++Other,
271    SortedUnion = lists:usort(Union),
272    UnionSet = M(union, {OrigSet,OtherSet}),
273    SortedUnion = lists:sort(M(to_list, UnionSet)),
274    M(equal, {UnionSet,M(from_list, Union)}),
275    UnionSet.
276
277is_subset(Config) when is_list(Config) ->
278    test_all([{1,132},{253,270},{299,311}], fun is_subset_1/2).
279
280is_subset_1(List, M) ->
281    S = M(from_list, List),
282    Empty = M(empty, []),
283
284    %% Subset of empty and self.
285    true = M(is_subset, {Empty,Empty}),
286    true = M(is_subset, {Empty,S}),
287    false = M(is_subset, {S,Empty}),
288    true = M(is_subset, {S,S}),
289
290    %% Other cases.
291    Res = [false = M(is_subset, {M(singleton, make_ref()),S}),
292	   true = M(is_subset, {M(singleton, hd(List)),S}),
293	   true = check_subset(remove_some(List, 0.1), List, M),
294	   true = check_subset(remove_some(List, 0.5), List, M),
295	   true = check_subset(remove_some(List, 0.9), List, M),
296	   check_subset(mutate_some(List), List, M),
297	   check_subset(rnd_list(length(List) div 2 + 5), List, M),
298	   subtract_check(List, rnd_list(length(List) div 7 + 9), M)
299	  ],
300    res_to_set(Res, M, 0, []).
301
302is_disjoint(Config) when is_list(Config) ->
303    test_all([{1,132},{253,270},{299,311}], fun is_disjoint_1/2).
304
305is_disjoint_1(List, M) ->
306    S = M(from_list, List),
307    Empty = M(empty, []),
308
309    true = M(is_disjoint, {Empty,Empty}),
310    true = M(is_disjoint, {Empty,S}),
311    true = M(is_disjoint, {S,Empty}),
312    false = M(is_disjoint, {S,S}),
313
314    true = M(is_disjoint, {M(singleton, make_ref()),S}),
315    true = M(is_disjoint, {S,M(singleton, make_ref())}),
316    S.
317
318check_subset(X, Y, M) ->
319    check_one_subset(Y, X, M),
320    check_one_subset(X, Y, M).
321
322check_one_subset(X, Y, M) ->
323    XSet = M(from_list, X),
324    YSet = M(from_list, Y),
325    SortedX = lists:usort(X),
326    SortedY = lists:usort(Y),
327    IsSubSet = length(SortedY--SortedX) =:= length(SortedY) - length(SortedX),
328    IsSubSet = M(is_subset, {XSet,YSet}),
329    IsSubSet.
330
331%% Encode all test results as a set to return.
332res_to_set([true|T], M, I, Acc) ->
333    res_to_set(T, M, I+1, [I|Acc]);
334res_to_set([_|T], M, I, Acc) ->
335    res_to_set(T, M, I+1, Acc);
336res_to_set([], M, _, Acc) -> M(from_list, Acc).
337
338is_set(Config) when is_list(Config) ->
339    %% is_set/1 is tested in the other test cases when its argument
340    %% is a set. Here test some arguments that makes it return false.
341
342    false = gb_sets:is_set([a,b]),
343    false = gb_sets:is_set({a,very,bad,tuple}),
344
345    false = sets:is_set([a,b]),
346    false = sets:is_set({a,very,bad,tuple}),
347
348    false = ordsets:is_set([b,a]),
349    false = ordsets:is_set({bad,tuple}),
350
351    %% Now test values that are known to be bad for all set representations.
352    test_all(fun is_set_1/1).
353
354is_set_1(M) ->
355    false = M(is_set, self()),
356    false = M(is_set, blurf),
357    false = M(is_set, make_ref()),
358    false = M(is_set, <<1,2,3>>),
359    false = M(is_set, 42),
360    false = M(is_set, math:pi()),
361    false = M(is_set, {}),
362    M(empty, []).
363
364is_empty(Config) when is_list(Config) ->
365    test_all(fun is_empty_1/1).
366
367is_empty_1(M) ->
368    S = M(from_list, [blurf]),
369    Empty = M(empty, []),
370
371    true = M(is_empty, Empty),
372    false = M(is_empty, S),
373    M(empty, []).
374
375fold(Config) when is_list(Config) ->
376    test_all([{0,71},{125,129},{254,259},{510,513},{1023,1025},{9999,10001}],
377	     fun fold_1/2).
378
379fold_1(List, M) ->
380    S = M(from_list, List),
381    L = M(fold, {fun(E, A) -> [E|A] end,[],S}),
382    true = lists:sort(L) =:= lists:usort(List),
383    M(empty, []).
384
385filter(Config) when is_list(Config) ->
386    test_all([{0,69},{126,130},{254,259},{510,513},{1023,1025},{7999,8000}],
387	     fun filter_1/2).
388
389filter_1(List, M) ->
390    S = M(from_list, List),
391    IsNumber = fun(X) -> is_number(X) end,
392    M(equal, {M(from_list, lists:filter(IsNumber, List)),
393	      M(filter, {IsNumber,S})}),
394    M(filter, {fun(X) -> is_atom(X) end,S}).
395
396%%%
397%%% Test specifics for gb_sets.
398%%%
399
400take_smallest(Config) when is_list(Config) ->
401    test_all([{1,71},{125,129},{254,259},{510,513},{1023,1025}],
402	     fun take_smallest_1/2).
403
404take_smallest_1(List, M) ->
405    case M(module, []) of
406	gb_sets -> take_smallest_2(List, M);
407	_ -> ok
408    end,
409    M(empty, []).
410
411take_smallest_2(List0, M) ->
412    List = lists:usort(List0),
413    S = M(from_list, List0),
414    take_smallest_3(S, List, M).
415
416take_smallest_3(S0, List0, M) ->
417    case M(is_empty, S0) of
418	true -> ok;
419	false ->
420	    Smallest = hd(List0),
421	    Smallest = gb_sets:smallest(S0),
422	    {Smallest,S} = gb_sets:take_smallest(S0),
423	    List = tl(List0),
424	    true = gb_sets:to_list(S) =:= List,
425	    take_smallest_3(S, List, M)
426    end.
427
428take_largest(Config) when is_list(Config) ->
429    test_all([{1,71},{125,129},{254,259},{510,513},{1023,1025}],
430	     fun take_largest_1/2).
431
432take_largest_1(List, M) ->
433    case M(module, []) of
434	gb_sets -> take_largest_2(List, M);
435	_ -> ok
436    end,
437    M(empty, []).
438
439take_largest_2(List0, M) ->
440    List = reverse(lists:usort(List0)),
441    S = M(from_list, List0),
442    take_largest_3(S, List, M).
443
444take_largest_3(S0, List0, M) ->
445    case M(is_empty, S0) of
446	true -> ok;
447	false ->
448	    Largest = hd(List0),
449	    Largest = gb_sets:largest(S0),
450	    {Largest,S} = gb_sets:take_largest(S0),
451	    List = tl(List0),
452	    true = gb_sets:to_list(S) =:= reverse(List),
453	    take_largest_3(S, List, M)
454    end.
455
456iterate(Config) when is_list(Config) ->
457    test_all(fun iterate_1/1).
458
459iterate_1(M) ->
460    case M(module, []) of
461	gb_sets -> iterate_2(M);
462	_ -> ok
463    end,
464    M(empty, []).
465
466iterate_2(M) ->
467    rand:seed(exsplus, {1,2,42}),
468    iter_set(M, 1000).
469
470iter_set(_M, 0) ->
471    ok;
472iter_set(M, N) ->
473    L = [I || I <- lists:seq(1, N)],
474    T = M(from_list, L),
475    L = lists:reverse(iterate_set(M, T)),
476    R = rand:uniform(N),
477    S = lists:reverse(iterate_set(M, R, T)),
478    S = [E || E <- L, E >= R],
479    iter_set(M, N-1).
480
481iterate_set(M, Set) ->
482    I = M(iterator, Set),
483    iterate_set_1(M, M(next, I), []).
484
485iterate_set(M, Start, Set) ->
486    I = M(iterator_from, {Start, Set}),
487    iterate_set_1(M, M(next, I), []).
488
489iterate_set_1(_, none, R) ->
490    R;
491iterate_set_1(M, {E, I}, R) ->
492    iterate_set_1(M, M(next, I), [E | R]).
493
494%%%
495%%% Helper functions.
496%%%
497
498sets_mods() ->
499    Ordsets = sets_test_lib:new(ordsets, fun(X, Y) -> X == Y end),
500
501    NewSets = sets_test_lib:new(sets, fun(X, Y) -> X == Y end,
502				fun() -> sets:new([{version,2}]) end,
503				fun(X) -> sets:from_list(X, [{version,2}]) end),
504
505    MixSets = sets_test_lib:new(sets, fun(X, Y) ->
506				           lists:sort(sets:to_list(X)) ==
507				               lists:sort(sets:to_list(Y)) end,
508				fun mixed_new/0, fun mixed_from_list/1),
509
510    OldSets = sets_test_lib:new(sets, fun(X, Y) ->
511					   lists:sort(sets:to_list(X)) ==
512					       lists:sort(sets:to_list(Y)) end,
513				fun sets:new/0, fun sets:from_list/1),
514
515    Gb = sets_test_lib:new(gb_sets, fun(X, Y) ->
516					    gb_sets:to_list(X) ==
517						gb_sets:to_list(Y) end),
518    [Ordsets,OldSets,MixSets,NewSets,Gb].
519
520mixed_new() ->
521    case erlang:erase(sets_type) of
522        undefined -> erlang:put(sets_type, deprecated), sets:new([{version,2}]);
523        deprecated -> sets:new()
524    end.
525
526mixed_from_list(L) ->
527    case erlang:erase(sets_type) of
528        undefined -> erlang:put(sets_type, deprecated), sets:from_list(L, [{version,2}]);
529        deprecated -> sets:from_list(L)
530    end.
531
532test_all(Tester) ->
533    Res = [begin
534	       rand:seed(exsplus, {1,2,42}),
535	       S = Tester(M),
536	       {M(size, S),lists:sort(M(to_list, S))}
537	   end || M <- sets_mods()],
538    all_same(Res).
539
540test_all([{Low,High}|T], Tester) ->
541    test_all(lists:seq(Low, High)++T, Tester);
542test_all([Sz|T], Tester) when is_integer(Sz) ->
543    List = rnd_list(Sz),
544    Res = [begin
545		     rand:seed(exsplus, {19,2,Sz}),
546		     S = Tester(List, M),
547		     {M(size, S),lists:sort(M(to_list, S))}
548		 end || M <- sets_mods()],
549    all_same(Res),
550    test_all(T, Tester);
551test_all([], _) -> ok.
552
553
554all_same([H|T]) ->
555    all_same_1(T, H).
556
557all_same_1([H|T], H) ->
558    all_same_1(T, H);
559all_same_1([], _) -> ok.
560
561rnd_list(Sz) ->
562    rnd_list_1(Sz, []).
563
564atomic_rnd_term() ->
565    case rand:uniform(3) of
566	1 -> list_to_atom(integer_to_list($\s+rand:uniform(94))++"rnd");
567	2 -> rand:uniform();
568	3 -> rand:uniform(50)-37
569    end.
570
571rnd_list_1(0, Acc) -> Acc;
572rnd_list_1(N, Acc) -> rnd_list_1(N-1, [atomic_rnd_term()|Acc]).
573
574mutate_some(List) ->
575    mutate_some(List, []).
576
577mutate_some([X,Y,Z|T], Acc) ->
578    %% Intentionally change order. (Order should not matter.)
579    mutate_some(T, [{X},Z,Y|Acc]);
580mutate_some([H|T], Acc) ->
581    mutate_some(T, [H|Acc]);
582mutate_some([], Acc) ->
583    %% Intentionally not reversing.
584    Acc.
585
586%% Removes at least one element.
587remove_some(List0, P) ->
588    case remove_some(List0, P, []) of
589	List when length(List0) =:= length(List) ->
590	    tl(List);
591	List ->
592	    List
593    end.
594
595remove_some([H|T], P, Acc) ->
596    case rand:uniform() of
597	F when F < P ->				%Remove.
598	    remove_some(T, P, Acc);
599	_ ->
600	    remove_some(T, P, [H|Acc])
601    end;
602remove_some([], _, Acc) ->
603    %% Intentionally no reverse. Order should not matter.
604    Acc.
605