1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2019. 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-module(proplists_SUITE).
22
23-export([all/0, suite/0,groups/0, init_per_suite/1, end_per_suite/1,
24         init_per_group/2, end_per_group/2,
25	 init_per_testcase/2, end_per_testcase/2,
26         examples/1, map_conversion/1, map_conversion_normalize/1,
27         pm_fold_test/1]).
28
29init_per_testcase(_Case, Config) ->
30    Config.
31
32end_per_testcase(_Case, _Config) ->
33    ok.
34
35suite() ->
36    [{ct_hooks,[ts_install_cth]},
37     {timetrap,{minutes,5}}].
38
39all() ->
40    [examples, map_conversion, map_conversion_normalize, pm_fold_test].
41
42groups() ->
43    [].
44
45init_per_suite(Config) ->
46    Config.
47
48end_per_suite(_Config) ->
49    ok.
50
51init_per_group(_GroupName, Config) ->
52    Config.
53
54end_per_group(_GroupName, Config) ->
55    Config.
56
57%% Test all examples in the documentation.
58
59examples(_Config) ->
60    [1,2,3,4] = proplists:append_values(a, [{a, [1,2]}, {b, 0}, {a, 3}, {c, -1}, {a, [4]}]),
61
62    ExpandRes = [fie, bar, baz, fum],
63    ExpandRes = proplists:expand([{foo, [bar, baz]}], [fie, foo, fum]),
64    ExpandRes = proplists:expand([{{foo, true}, [bar, baz]}], [fie, foo, fum]),
65    ExpandRes = proplists:expand([{{foo, false}, [bar, baz]}], [fie, {foo, false}, fum]),
66
67    [{foo, false}, fie, foo, fum] = proplists:expand([{{foo, true}, [bar, baz]}],
68                                                     [{foo, false}, fie, foo, fum]),
69
70    {[[a], [{b, 5}, b],[{c, 2}, {c, 3, 4}]], [{e, 1}, d]} =
71        proplists:split([{c, 2}, {e, 1}, a, {c, 3, 4}, d, {b, 5}, b], [a, b, c]),
72
73    ColorList = [{color, red}, {colour, green}, color, colour],
74    ColorListRes = [{colour, red}, {colour, green}, colour, colour],
75    ColorListRes = proplists:substitute_aliases([{color, colour}], ColorList),
76
77    NegList = [no_foo, {no_foo, true}, {no_foo, false}, {no_foo, any}, foo],
78    NegListRes = [{foo, false}, {foo, false}, foo, foo, foo],
79    NegListRes = proplists:substitute_negations([{no_foo, foo}], NegList),
80
81    true = #{a => true, b => 1, c => 2} =:= proplists:to_map([a, {b, 1}, {c, 2}, {c, 3}]),
82
83    ok.
84
85map_conversion(_Config) ->
86    %% Simple tests.
87    true = #{} =:= proplists:to_map([]),
88    true = #{a => true, b => true} =:= proplists:to_map([a, b]),
89    true = #{a => true, b => true} =:= proplists:to_map([b, a]),
90    true = #{a => 1, b => true} =:= proplists:to_map([{a, 1}, b]),
91    true = #{a => 1, b => true} =:= proplists:to_map([b, {a, 1}]),
92    true = #{a => 1, b => 2} =:= proplists:to_map([{a, 1}, {b, 2}]),
93    true = #{a => 1, b => 2} =:= proplists:to_map([{b, 2}, {a, 1}]),
94    true = #{b => true} =:= proplists:to_map(["a", b]),
95    true = #{b => true} =:= proplists:to_map([b, "a"]),
96    true = #{b => true} =:= proplists:to_map([{a}, b]),
97    true = #{b => true} =:= proplists:to_map([b, {a}]),
98    true = #{b => true} =:= proplists:to_map([{a, 1, 2}, b]),
99    true = #{b => true} =:= proplists:to_map([b, {a, 1, 2}]),
100
101    %% Ensure that maps:get/3 using the created map yields the same
102    %% results as proplists:get_value/3 on the original proplist does,
103    %% and that proplists:get_value/3 on a proplist created from the
104    %% map yields the same results as proplists:get_value/3 on the
105    %% original proplist, ie they either all return the same `Value',
106    %% or they all return the `Default' given as respective third argument.
107    Default = make_ref(),
108    InList=[a, b, {a, 1}, {}, {a}, {a, 1, 2}, {c, 1, 2}, "foo"],
109    Fun = fun (L1, Acc) ->
110        LKs = proplists:get_keys(L1),
111        M = proplists:to_map(L1),
112        L2 = proplists:from_map(M),
113        true = lists:sort(maps:keys(M)) =:= lists:sort(proplists:get_keys(L2)),
114        lists:foreach(
115            fun (K) ->
116                case
117                    {
118                        maps:get(K, M, Default),
119                        proplists:get_value(K, L1, Default),
120                        proplists:get_value(K, L2, Default)
121                    }
122                of
123                    {Default, Default, Default} -> ok;
124                    {V, V, V} -> ok
125                end
126            end,
127            LKs
128        ),
129        Acc
130    end,
131    _ = pm_fold(Fun, undefined, InList),
132    ok.
133
134map_conversion_normalize(_Config) ->
135    Stages = [
136        {aliases, [{a, alias_a}]},
137        {negations, [{no_b, b}]},
138        {expand, [{c, [d]}]}
139    ],
140
141    M1 = proplists:to_map([], Stages),
142    true = M1 =:= #{},
143    true = M1 =:= proplists:to_map(proplists:normalize([], Stages)),
144
145    List = [a, no_b, c],
146    M2 = proplists:to_map(List, Stages),
147    true = M2 =:= #{alias_a => true, b => false, d => true},
148    true = M2 =:= proplists:to_map(proplists:normalize(List, Stages)),
149
150    ok.
151
152pm_fold(_, _, []) ->
153    [];
154pm_fold(Fun, Acc0, L) ->
155    pm_fold(Fun, Acc0, L, []).
156
157pm_fold(Fun, Acc, [], Mut) ->
158    Fun(Mut, Acc);
159pm_fold(Fun, Acc, L, Mut) ->
160    lists:foldl(
161        fun
162            (X, AccIn) -> pm_fold(Fun, AccIn, lists:delete(X, L), [X|Mut])
163        end,
164        Acc,
165        L
166    ).
167
168pm_fold_test(_Config) ->
169    Fun = fun (M, A) -> [M|A] end,
170
171    [] = pm_fold(Fun, [], []),
172
173    [[1]] = lists:sort(pm_fold(Fun, [], [1])),
174
175    Exp1 = lists:sort([[1, 2], [2, 1]]),
176    Exp1 = lists:sort(pm_fold(Fun, [], [1, 2])),
177
178    Exp2 = lists:sort([[1, 2, 3], [1, 3, 2], [2, 1, 3], [2, 3, 1], [3, 1, 2], [3, 2, 1]]),
179    Exp2 = lists:sort(pm_fold(Fun, [], [1, 2, 3])),
180
181    ok.
182