1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2003-2020. 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(ct_property_test).
22
23%%% API
24%% Main functions
25-export([init_per_suite/1,
26         init_tool/1,
27         quickcheck/2]).
28
29%% Result presentation
30-export([present_result/4, present_result/5,
31         title/2, title/3,
32         sequential_parallel/1,
33         cmnd_names/1,
34         num_calls/1,
35         print_frequency_ranges/0,
36         print_frequency/0
37        ]).
38
39%%% Mandatory include
40-include_lib("common_test/include/ct.hrl").
41
42%%%================================================================
43%%%
44%%% API
45%%%
46
47%%%----------------------------------------------------------------
48%%%
49%%% Search for a property tester in the lib path, and if found, compile
50%%% the property tests
51%%%
52init_per_suite(Config) ->
53    case init_tool(Config) of
54        {skip, _}=Skip ->
55            Skip;
56        Config1 ->
57            Path = property_tests_path("property_test", Config1),
58            case compile_tests(Path, Config1) of
59                error ->
60                    {fail, "Property test compilation failed in "++Path};
61                {skip,Reason} ->
62                    {skip,Reason};
63                up_to_date ->
64                    add_code_pathz(Path),
65                    [{property_dir, Path} | Config1]
66            end
67    end.
68
69init_tool(Config) ->
70    ToolsToCheck = proplists:get_value(prop_tools, Config, [eqc,proper,triq]),
71    case which_module_exists(ToolsToCheck) of
72	{ok,ToolModule} ->
73            case code:where_is_file(lists:concat([ToolModule,".beam"])) of
74                non_existing ->
75                    ct:log("Found ~p, but ~tp~n is not found",
76                           [ToolModule, lists:concat([ToolModule,".beam"])]),
77                    {skip, "Strange Property testing tool installation"};
78                ToolPath ->
79                    ct:pal("Found property tester ~p~n"
80                           "at ~tp",
81                           [ToolModule, ToolPath]),
82                    [{property_test_tool, ToolModule} | Config]
83            end;
84        not_found ->
85            ct:pal("No property tester found",[]),
86            {skip, "No property testing tool found"}
87    end.
88
89%%%----------------------------------------------------------------
90%%%
91%%% Call the found property tester (if any)
92%%%
93quickcheck(Property, Config) ->
94    Tool = proplists:get_value(property_test_tool,Config),
95    F = function_name(quickcheck, Tool),
96    mk_ct_return( Tool:F(Property), Tool ).
97
98
99%%%----------------------------------------------------------------
100%%%
101%%% Present a nice table of the statem result
102%%%
103present_result(Module, Cmds, Triple, Config) ->
104    present_result(Module, Cmds, Triple, Config, []).
105
106present_result(Module, Cmds, {H,Sf,Result}, Config, Options0) ->
107    DefSpec =
108        if
109            is_tuple(Cmds) ->
110                [{"Distribution sequential/parallel", fun sequential_parallel/1}];
111            is_list(Cmds) ->
112                []
113        end
114        ++ [{"Function calls", fun cmnd_names/1},
115            {"Length of command sequences", fun print_frequency_ranges/0, fun num_calls/1}
116           ],
117    Options = add_default_options(Options0,
118                                  [{print_fun, fun ct:log/2},
119                                   {spec, DefSpec}
120                                  ]),
121    do_present_result(Module, Cmds, H, Sf, Result, Config, Options).
122
123
124title(Str, Fun) ->
125    title(Str, Fun, fun io:format/2).
126
127title(Str, Fun, PrintFun) ->
128    fun(L) -> PrintFun("~n~s~n~n~s~n", [Str,Fun(L)]) end.
129
130print_frequency() ->
131    fun(L) ->
132            [io_lib:format("~5.1f% ~p~n",[Pcnt,V])
133             || {V,_Num,Pcnt} <-
134                    with_percentage(get_frequencies_no_range(L), length(L))
135            ]
136    end.
137
138print_frequency_ranges() ->
139    print_frequency_ranges([{ngroups,10}]).
140
141print_frequency_ranges(Options0) ->
142    fun([]) ->
143            io_lib:format('Empty list!~n',[]);
144       (L ) ->
145            try
146                Options = set_default_print_freq_range_opts(Options0, L),
147                do_print_frequency_ranges(L, Options)
148            catch
149                C:E:S ->
150                    ct:pal("~p:~p ~p:~p~n~p~n~p",[?MODULE,?LINE,C,E,S,L])
151            end
152    end.
153
154%%%================================================================
155%%%
156%%% Local functions
157%%%
158
159%%% Make return values back to the calling Common Test suite
160mk_ct_return(true, _Tool) ->
161    true;
162mk_ct_return(Other, Tool) ->
163    try lists:last(hd(Tool:counterexample()))
164    of
165	{set,{var,_},{call,M,F,Args}} ->
166	    {fail, io_lib:format("~p:~tp/~p returned bad result",[M,F,length(Args)])}
167    catch
168	_:_ ->
169	    {fail, Other}
170    end.
171
172%%% Check if a property testing tool is found
173which_module_exists([Module|Modules]) ->
174    case module_exists(Module) of
175	true -> {ok,Module};
176	false -> which_module_exists(Modules)
177    end;
178which_module_exists(_) ->
179    not_found.
180
181module_exists(Module) ->
182    is_list(catch Module:module_info()).
183
184%%% The path to the property tests
185property_tests_path(Dir, Config) ->
186    DataDir = proplists:get_value(data_dir, Config),
187    filename:join(lists:droplast(filename:split(DataDir))++[Dir]).
188
189%%% Extend the code path with Dir if it not already present
190add_code_pathz(Dir) ->
191    case lists:member(Dir, code:get_path()) of
192	true ->  ok;
193	false ->
194	    true = code:add_pathz(Dir),
195	    ok
196    end.
197
198compile_tests(Path, Config) ->
199    ToolModule = proplists:get_value(property_test_tool, Config),
200    MacroDefs = macro_def(ToolModule),
201    {ok,Cwd} = file:get_cwd(),
202    case file:set_cwd(Path) of
203        ok ->
204            case file:list_dir(".") of
205                {ok,[]} ->
206                    ct:pal("No files found in ~tp", [Path]),
207                    ok = file:set_cwd(Cwd),
208                    {skip, "No files found"};
209                {ok,FileNames} ->
210                    BeamFiles = [F || F<-FileNames,
211                                      filename:extension(F) == ".beam"],
212                    ErlFiles = [F || F<-FileNames,
213                                      filename:extension(F) == ".erl"],
214                    _ = [file:delete(F) || F<-BeamFiles],
215                    ct:pal("Compiling in ~tp~n"
216                           "  Deleted:   ~p~n"
217                           "  ErlFiles:  ~tp~n"
218                           "  MacroDefs: ~p",
219                           [Path,BeamFiles,ErlFiles,MacroDefs]),
220                    Result = make:all([load|MacroDefs]),
221                    ok = file:set_cwd(Cwd),
222                    Result
223            end;
224
225        {error,Error} ->
226            ct:pal("file:set_cwd(~tp) returned ~p.~nCwd = ~tp", [Path, {error,Error}, Cwd]),
227            error
228    end.
229
230
231macro_def(eqc) -> [{d, 'EQC'}];
232macro_def(proper) -> [{d, 'PROPER'}];
233macro_def(triq) -> [{d, 'TRIQ'}].
234
235function_name(quickcheck, triq) -> check;
236function_name(F, _) -> F.
237
238
239%%%================================================================
240%%%================================================================
241%%%================================================================
242%%%
243%%% Result presentation part
244%%%
245do_present_result(_Module, Cmds, _H, _Sf, ok, Config, Options) ->
246    [PrintFun, Spec] = [proplists:get_value(K,Options) || K <- [print_fun,spec]],
247    Tool = proplists:get_value(property_test_tool,Config),
248    AGGREGATE = function_name(aggregate, Tool),
249    lists:foldr(fun({Title, FreqFun, CollecFun}, Result) ->
250                        Tool:AGGREGATE(title(Title, FreqFun(), PrintFun),
251                                       CollecFun(Cmds),
252                                       Result);
253                   ({Title, CollecFun}, Result) ->
254                        Tool:AGGREGATE(title(Title, print_frequency(), PrintFun),
255                                       CollecFun(Cmds),
256                                       Result)
257                end, true, Spec);
258
259do_present_result(Module, Cmds, H, Sf, Result, _Config, Options) ->
260    [PrintFun] = [proplists:get_value(K,Options) || K <- [print_fun]],
261    PrintFun("Module = ~p,~n"
262             "Commands = ~p,~n"
263             "History = ~p,~n"
264             "FinalDynState = ~p,~n"
265             "Result = ~p",
266             [Module, Cmds, H, Sf, Result]),
267    Result == ok. % Proper dislikes non-boolean results while eqc treats non-true as false.
268
269%%%================================================================
270cmnd_names(Cs) -> traverse_commands(fun cmnd_name/1, Cs).
271cmnd_name(L) ->  [F || {set,_Var,{call,_Mod,F,_As}} <- L].
272
273num_calls(Cs) -> traverse_commands(fun num_call/1, Cs).
274num_call(L) -> [length(L)].
275
276sequential_parallel(Cs) ->
277    traverse_commands(fun(L) -> dup_module(L, sequential) end,
278		      fun(L) -> [dup_module(L1, mkmod("parallel",num(L1,L))) || L1<-L] end,
279		      Cs).
280dup_module(L, ModName) -> lists:duplicate(length(L), ModName).
281mkmod(PfxStr,N) -> list_to_atom(PfxStr++"_"++integer_to_list(N)).
282
283%% Meta functions for the aggregate functions
284traverse_commands(Fun, L) when is_list(L) -> Fun(L);
285traverse_commands(Fun, {Seq, ParLs}) -> Fun(lists:append([Seq|ParLs])).
286
287traverse_commands(Fseq, _Fpar, L) when is_list(L) -> Fseq(L);
288traverse_commands(Fseq, Fpar, {Seq, ParLs}) -> lists:append([Fseq(Seq)|Fpar(ParLs)]).
289
290%%%================================================================
291-define(middle_dot, 0183).
292
293set_default_print_freq_range_opts(Opts0, L) ->
294    add_default_options(Opts0, [{ngroups, 10},
295                                {min, 0},
296                                {max, max_in_list(L)}
297                               ]).
298
299add_default_options(Opts0, DefaultOpts) ->
300    [set_def_opt(Key,DefVal,Opts0) || {Key,DefVal} <- DefaultOpts].
301
302set_def_opt(Key, DefaultValue, Opts) ->
303    {Key, proplists:get_value(Key, Opts, DefaultValue)}.
304
305max_in_list(L) ->
306    case lists:last(L) of
307        Max when is_integer(Max) -> Max;
308        {Max,_} -> Max
309    end.
310
311do_print_frequency_ranges(L0, Options) ->
312    [N,Min,Max] = [proplists:get_value(K,Options) || K <- [ngroups, min, max]],
313    L = if
314            N>Max ->
315                %% There will be less than the demanded number of classes,
316                %% insert one last with zero values in it. That will force
317                %% the generation of N classes.
318                L0++[{N,0}];
319            N=<Max ->
320                L0
321        end,
322    try
323        Interval = round((Max-Min)/N),
324        IntervalLowerLimits = lists:seq(Min,Max,Interval),
325        Ranges = [{I,I+Interval-1} || I <- IntervalLowerLimits],
326        Acc0 = [{Rng,0} || Rng <- Ranges],
327        Fs0 = get_frequencies(L, Acc0),
328	SumVal = lists:sum([V||{_,V}<-Fs0]),
329	Fs = with_percentage(Fs0, SumVal),
330        DistInfo = [{"min", lists:min(L)},
331                    {"mean", mean(L)},
332                    {"median", median(L)},
333                    {"max", lists:max(L)}],
334
335	Npos_value = num_digits(SumVal),
336	Npos_range = num_digits(Max),
337        [%% Table heading:
338         io_lib:format("Range~*s: ~s~n",[2*Npos_range-2,"", "Number in range"]),
339         %% Line under heading:
340         io_lib:format("~*c:~*c~n",[2*Npos_range+3,$-, max(16,Npos_value+10),$- ]),
341         %% Lines with values:
342         [io_lib:format("~*w - ~*w:  ~*w  ~5.1f% ~s~n",
343                        [Npos_range,Rlow,
344                         Npos_range,Rhigh,
345                         Npos_value,Val,
346                         Percent,
347                         cond_prt_vals(DistInfo, Interv)
348                        ])
349          || {Interv={Rlow,Rhigh},Val,Percent} <- Fs],
350         %% Line under the table for the total number of values:
351         io_lib:format('~*c    ~*c~n',[2*Npos_range,32, Npos_value+3,$-]),
352         %% The total number of values:
353         io_lib:format('~*c      ~*w~n',[2*Npos_range,32, Npos_value,SumVal])
354        ]
355    catch
356	C:E ->
357	    ct:pal('*** Failed printing (~p:~p) for~n~p~n',[C,E,L])
358    end.
359
360cond_prt_vals(LVs, CurrentInterval) ->
361    [prt_val(Label, Value, CurrentInterval) || {Label,Value} <- LVs].
362
363prt_val(Label, Value, CurrentInterval) ->
364    case in_interval(Value, CurrentInterval) of
365        true ->
366            io_lib:format(" <-- ~s=" ++ if
367                                           is_float(Value) -> "~.1f";
368                                           true -> "~p"
369                                       end,
370                          [Label,Value]);
371        false ->
372            ""
373    end.
374
375get_frequencies([{I,Num}|T], [{{Lower,Upper},Cnt}|Acc]) when Lower=<I,I=<Upper ->
376    get_frequencies(T,  [{{Lower,Upper},Cnt+Num}|Acc]);
377get_frequencies(L=[{I,_Num}|_], [Ah={{_Lower,Upper},_Cnt}|Acc]) when I>Upper ->
378    [Ah | get_frequencies(L,Acc)];
379get_frequencies([I|T], Acc) when is_integer(I) ->
380    get_frequencies([{I,1}|T], Acc);
381get_frequencies([], Acc) ->
382    Acc.
383
384get_frequencies_no_range([]) ->
385    io_lib:format("No values~n", []);
386get_frequencies_no_range(L) ->
387    [H|T] = lists:sort(L),
388    get_frequencies_no_range(T, H, 1, []).
389
390get_frequencies_no_range([H|T], H, N, Acc) ->
391    get_frequencies_no_range(T, H, N+1, Acc);
392get_frequencies_no_range([H1|T], H, N, Acc) ->
393    get_frequencies_no_range(T, H1, 1, [{H,N}|Acc]);
394get_frequencies_no_range([], H, N, Acc) ->
395    lists:reverse(
396      lists:keysort(2, [{H,N}|Acc])).
397
398%% get_frequencies_percent(L) ->
399%%     with_percentage(get_frequencies_no_range(L), length(L)).
400
401
402with_percentage(Fs, Sum) ->
403    [{Rng,Val,100*Val/Sum} || {Rng,Val} <- Fs].
404
405
406num_digits(I) -> 1+trunc(math:log(I)/math:log(10)).
407
408num(Elem, List) -> length(lists:takewhile(fun(E) -> E /= Elem end, List)) + 1.
409
410%%%---- Just for naming an operation for readability
411is_odd(I) -> (I rem 2) == 1.
412
413in_interval(Value, {Rlow,Rhigh}) ->
414    try
415	Rlow=<round(Value) andalso round(Value)=<Rhigh
416    catch
417	_:_ -> false
418    end.
419
420%%%================================================================
421%%% Statistical functions
422
423%%%---- Mean value
424mean(L = [X|_]) when is_number(X) ->
425    lists:sum(L) / length(L);
426mean(L = [{_Value,_Weight}|_]) ->
427    SumOfWeights = lists:sum([W||{_,W}<-L]),
428    WeightedSum = lists:sum([W*V||{V,W}<-L]),
429    WeightedSum / SumOfWeights;
430mean(_) ->
431    undefined.
432
433%%%---- Median
434median(L = [X|_]) when is_number(X) ->
435    Len = length(L),
436    case is_odd(Len) of
437	true ->
438	    hd(lists:nthtail(Len div 2, L));
439	false ->
440	    %%  1) L has at least one element (the one in the is_number test).
441	    %%  2) Length is even.
442	    %%     => Length >= 2
443	    [M1,M2|_] = lists:nthtail((Len div 2)-1, L),
444	    (M1+M2) / 2
445    end;
446%% integer Weights...
447median(L = [{_Value,_Weight}|_]) ->
448    median( lists:append([lists:duplicate(W,V) || {V,W} <- L]) );
449median(_) ->
450    undefined.
451
452