1%% -*- erlang-indent-level: 4;indent-tabs-mode: nil -*-
2%% ex: ts=4 sw=4 et
3%%
4%% This file is part of Triq - Trifork QuickCheck
5%%
6%% Copyright (c) 2010-2013 by Trifork
7%%
8%% Licensed under the Apache License, Version 2.0 (the "License");
9%% you may not use this file except in compliance with the License.
10%% You may obtain a copy of the License at
11%%
12%%     http://www.apache.org/licenses/LICENSE-2.0
13%%
14%% Unless required by applicable law or agreed to in writing, software
15%% distributed under the License is distributed on an "AS IS" BASIS,
16%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
17%% See the License for the specific language governing permissions and
18%% limitations under the License.
19%%
20
21-module(triq).
22
23%%
24%% For each ?FORALL, we try to shrink the value
25%% this many iterations.
26%%
27-define(SHRINK_COUNT, 1000).
28
29%%
30%% The default number of tests to run
31%%
32-define(TEST_COUNT, 100).
33
34-export([check/1,
35         check/2,
36         check/3,
37         fails/1,
38         module/1,
39         module/2,
40         counterexample/0,
41         counterexample/1,
42         numtests/2]).
43
44-import(triq_dom,
45        [pick/2,
46         shrink/2]).
47
48-record(triq, {count=0,
49               context=[],
50               size=?TEST_COUNT,  %% todo: remove this
51               run_iter=?TEST_COUNT,
52               report= fun report_none/2,
53               shrinking= false,
54               result=undefined,
55               body,
56               values=[]}).
57
58%%
59%% Default reporting function, ... is silent
60%%
61report_none(pass, _) ->
62    ok;
63report_none(fail, _) ->
64    ok;
65report_none(skip, _) ->
66    ok.
67
68%%
69%% Reporting function used while testing, prints "..xxxx Failed!"
70%%
71report(pass,_) ->
72    io:format(".");
73report(skip,_) ->
74    io:format("x");
75report(fail,false) ->
76    io:format("Failed!~n");
77report(fail,Value) ->
78    io:format("Failed with: ~p~n", [Value]).
79
80%%
81%%
82%%
83check_input(Fun,Input,IDom,#triq{count=Count,report=DoReport}=QCT) ->
84    try Fun(Input) of
85        true ->
86            DoReport(pass,true),
87            {success, Count+1};
88
89        {success, NewCount} ->
90            {success, NewCount};
91
92        {failure, _, _, _, _}=Fail ->
93            Fail;
94
95        {'prop:timeout', Limit, Fun2, Body2} ->
96            Yield = check_timeout(Fun,Input,IDom,Limit,Fun2,
97                                  QCT#triq{body=Body2}),
98            Yield;
99
100        {'prop:fails', Property} ->
101            case check_input(fun(none)->Property end,none,none,QCT#triq{}) of
102                {success, _} ->
103                    {failure, Fun, Input, IDom,
104                     QCT#triq{result=unexpected_success,
105                              context=[{"?",Fun,Input,IDom}
106                                       |QCT#triq.context]}};
107                _ -> {success, Count+1}
108            end;
109
110        {'prop:implies', false, _, _, _} ->
111            DoReport(skip,true),
112            {success, Count};
113
114        {'prop:implies', true, _Syntax, Fun2, Body2} ->
115            check_input(fun(none)->Fun2()end,none,none,QCT#triq{body=Body2});
116
117        {'prop:numtests', Iters, Property} ->
118            check_input(fun(none)->Property end,none,none,
119                        QCT#triq{ run_iter=Iters });
120
121        {'prop:whenfail', Action, Fun2, Body2} ->
122            case check_input(fun(none)->Fun2()end,none,none,
123                             QCT#triq{body=Body2}) of
124                {success, _}=Success ->
125                    Success;
126                Any when not QCT#triq.shrinking ->
127                    Action(),
128                    Any;
129                Any ->
130                    Any
131            end;
132
133        {'prop:trapexit', Fun2, Body2} ->
134            WasTrap = process_flag(trap_exit, true),
135            Main = self(),
136            PID = spawn_link
137                    (fun() ->
138                             Result = check_input(fun(none)->Fun2()end,none,
139                                                  none,QCT#triq{body=Body2}),
140                             Main ! {self(), Result}
141                     end),
142            receive
143                {PID, Result} ->
144
145                    %% unlink and flush any EXITs
146                    unlink(PID),
147                    process_flag(trap_exit, WasTrap),
148                    receive {'EXIT', PID, _} -> true
149                    after 0 -> true end,
150
151                    Result;
152
153                {'EXIT', PID, Reason} ->
154                    process_flag(trap_exit, WasTrap),
155                    DoReport(fail, Reason),
156                    {failure, Fun, Input, IDom,
157                     QCT#triq{count=Count+1,result={'EXIT', Reason}}}
158
159            end;
160
161        {'prop:forall', Dom2, Syntax2, Fun2, Body2} ->
162            check_forall(0, QCT#triq.run_iter, Dom2, Fun2, Syntax2,
163                         QCT#triq{body=Body2});
164
165        Any ->
166            DoReport(fail,Any),
167            {failure, Fun, Input, IDom, QCT#triq{count=Count+1,result=Any}}
168
169    catch
170        Class : Exception ->
171            DoReport(fail, {Class, Exception, erlang:get_stacktrace()}),
172            {failure, Fun, Input, IDom, QCT#triq{count=Count+1,
173                                                 result={'EXIT',Exception}}}
174
175    end.
176
177
178check_timeout(Fun,Input,IDom,Limit,Fun2,
179              #triq{count=Count,report=DoReport}=QCT) ->
180    Main = self(),
181    Controller =
182        spawn
183          (fun() ->
184                   process_flag(trap_exit, true),
185                   Controller = self(),
186
187                   Slave = spawn_link
188                             (fun() ->
189                                      Slave = self(),
190                                      Result = check_input(fun(none)->Fun2()end,
191                                                           none,
192                                                           none,
193                                                           QCT),
194                                      Controller ! {Slave, Result}
195                              end),
196
197                   receive
198                       {Slave, Result} ->
199                           %% from Slave
200                           Main ! {Controller, Result };
201
202                       {'EXIT', Slave, Reason} ->
203                           %% from Slave
204                           DoReport(fail, Reason),
205                           Main ! {Controller,
206                                   {failure, Fun, Input, IDom,
207                                    QCT#triq{count=Count+1,
208                                             result={'EXIT', Reason}}}};
209
210                       {'EXIT', _, timeout} ->
211                           %% from Main
212                           erlang:exit(Slave,kill)
213                   end
214           end),
215
216    Yield = receive
217                {Controller, Result} ->
218                    Result
219
220            after Limit ->
221
222                    %% Yank the controller (and the slave)
223                    erlang:exit(Controller, timeout),
224
225                    %% flush any reply from our queue
226                    receive {Controller, _} -> ignore
227                    after 5 -> ignore end,
228
229                    Reason = {timeout, Limit},
230                    DoReport(fail, Reason),
231                    {failure, Fun, Input, IDom,
232                     QCT#triq{count=Count+1,result={'EXIT', Reason}}}
233            end,
234
235    Yield.
236
237check_forall(N,N,_,_,_,#triq{count=Count}) ->
238    {success, Count};
239check_forall(N,NMax,Dom,Fun,Syntax,#triq{context=Context,values=Values}=QCT) ->
240
241    DomSize = 2 + 2*N,
242
243    {{InputDom,Input},NewValues} =
244        case Values of
245            [V|Vs] ->
246                {{V, V}, Vs};
247            [] ->
248                {pick(Dom, DomSize), []}
249        end,
250
251    case check_input(Fun,Input,InputDom,
252                     QCT#triq{size=DomSize,
253                              context=[{Syntax,Fun,Input,InputDom}|Context],
254                              values=NewValues})
255    of
256
257        %% it did not fail, try again with N := N+1
258        {success,NewCount} ->
259            check_forall(N+1, NMax, Dom, Fun, Syntax, QCT#triq{count=NewCount});
260
261        %% it failed, report it!
262        {failure, _, _, _, Ctx} ->
263            {failure, Fun, Input, InputDom, Ctx}
264    end.
265
266
267all(_Fun,[]) ->
268    true;
269all(Fun,[H|T]) ->
270    case Fun(H) of
271        true -> all(Fun,T);
272        NonTrue ->
273            NonTrue
274    end.
275
276
277%%--------------------------------------------------------------------
278%% @doc
279%% Run QuickCheck on all properties in a module.
280%% If all checks succeed, true is returned; otherwise return the
281%% result of the first check that fails.
282%%
283%% @spec module( atom() ) -> true | any()
284%% @end
285%%--------------------------------------------------------------------
286module(Module) when is_atom(Module) ->
287    module(Module, ?TEST_COUNT).
288
289module(Module, RunIters) when is_integer(RunIters), RunIters>0 ->
290    Info = Module:module_info(exports),
291    all(fun({Fun,0}) ->
292                case atom_to_list(Fun) of
293                    "prop_" ++ _ ->
294                        io:format("Testing ~p:~p/0~n", [Module, Fun]),
295                        check(Module:Fun(), RunIters);
296                    _ -> true
297                end;
298           ({_,_}) -> true
299        end,
300        Info).
301
302
303%%--------------------------------------------------------------------
304%% @doc
305%% Run QuickCheck.  If argument is an atom, it runs triq:module/1
306%% checking all the properties in said module; otherwise if the
307%% argument is a property, it runs QuickCheck on said property.
308%%
309%% @spec check( atom() | property() ) -> any()
310%% @end
311%%--------------------------------------------------------------------
312check(Module) when is_atom(Module)->
313    module(Module);
314check(Property) ->
315    check(Property, [], ?TEST_COUNT).
316
317check(Module, RunIters) when is_atom(Module), is_integer(RunIters), RunIters>0 ->
318    module(Module, RunIters);
319check(Property, RunIters) when is_integer(RunIters), RunIters>0 ->
320    check(Property, [], RunIters);
321check(Property, CounterExample) when is_list(CounterExample) ->
322    check(Property, CounterExample, ?TEST_COUNT).
323
324
325%%--------------------------------------------------------------------
326%% @doc
327%% Run QuickCheck on a property, specifying a specific example to test.
328%% The example can be obtained by calling {@link counterexample/0}.
329%%
330%% @spec check( property(), [any()], integer() ) -> any()
331%% @end
332%%--------------------------------------------------------------------
333check(Property, Counterexample, RunIters) ->
334    generate_randomness(),
335    case check_input(fun(nil)->Property end,
336                     nil,
337                     nil,
338                     #triq{report=fun report/2, run_iter=RunIters,
339                           values=Counterexample}) of
340
341        {failure, Fun, Input, InputDom, #triq{count=Count,context=Ctx,
342                                              body=_Body,result=Error}} ->
343
344            io:format("~nFailed after ~p tests with ~p~n", [Count,Error]),
345
346            %%
347            %% Context is a [{Syntax,Fun,Input,Domain}...] list
348            %% one element for each ?FORALL level in the property.
349            %% the check/5 function constructs in backwards, so...
350            %%
351            Context = lists:reverse(Ctx),
352
353            %% Run the shrinking function
354            %%
355            Simp = shrink_loop(Fun,Input,InputDom,?SHRINK_COUNT,tl(Context)),
356
357            %%
358            %% Compute the counter example
359            %%
360            CounterExample = [{Syntax,Fun2,SimplifiedInput,Dom2} ||
361                                 {{Syntax,Fun2,_Input,Dom2}, SimplifiedInput}
362                                     <- lists:zip(Context,Simp)],
363
364            %% save the counter example
365            put('triq:counterexample', CounterExample),
366
367            io:format("Simplified:~n"),
368            print_counter_example(CounterExample),
369
370            Error;
371
372        {success, Count} ->
373            io:format("~nRan ~p tests~n", [Count]),
374            true
375    end.
376
377print_counter_example(CounterExample) ->
378    lists:foreach(fun({Syntax,_Fun,Val,_Dom}) ->
379                          io:format("\t~s = ~w~n", [Syntax,Val])
380                  end,
381                  CounterExample).
382
383counterexample(Prop) ->
384    case check(Prop) of
385        true -> true;
386        _ -> counterexample()
387    end.
388
389counterexample() ->
390    [ Val || {_,_,Val,_} <- get('triq:counterexample') ].
391
392%%
393%% when the property has nested ?FORALL statements,
394%% this is the function that tries to make the inner
395%% ?FORALL smaller; after trying the outer.
396%%
397shrink_deeper(Input,[{_,F1,I1,G1}|T]) ->
398    [Input | shrink_loop(F1,I1,G1,?SHRINK_COUNT,T)];
399shrink_deeper(Input,[]) -> [Input].
400
401
402%% this is the main logic for the simplify function
403shrink_loop(Fun,Input,InputDom,GS,Context) ->
404    InitialTested = gb_sets:add(Input,gb_sets:new()),
405    shrink_loop(Fun,Input,InputDom,GS,Context, InitialTested).
406
407shrink_loop(_,Input,_,0,Context,_) ->
408    shrink_deeper(Input,Context);
409
410shrink_loop(Fun,Input,InputDom,GS,Context,Tested) ->
411    %%
412    %% simplify_value will attempt to shrink the
413    %% value of Input (beloging to the InputDom domain).
414    %% There is randomness involved, so it may just
415    %% return it's Input argument...
416    %%
417    {NewDom,NewInput} = shrink(InputDom,Input),
418
419    %%io:format("simp ~p -> ~p (~p)~n", [Input, NewInput, InputDom]),
420
421    IsTested = gb_sets:is_member(NewInput,Tested),
422
423    if
424        IsTested ->
425            %% aparently, there was some randomness in the
426            %% shrinking that made us shrink again to a value
427            %% we shrunk to before.
428            shrink_loop(Fun,Input,InputDom,GS-1,Context,Tested);
429
430        Input =:= NewInput ->
431            shrink_deeper(Input, Context);
432
433        true ->
434            NewTested = gb_sets:add(NewInput,Tested),
435
436            case check_input(Fun,NewInput,NewDom,
437                             #triq{size=GS,shrinking=true}) of
438
439                %% still failed, try to simplify some more
440                {failure, _, _, _, #triq{context=C2}} ->
441                    shrink_loop(Fun,NewInput,NewDom,GS,C2,NewTested);
442
443                %% oops, we simplified too much; try again
444                %% with the same inputs
445                {success, _} ->
446                    shrink_loop(Fun,Input,InputDom,GS-1,Context,NewTested)
447            end
448    end.
449
450%%--------------------------------------------------------------------
451%% @doc
452%% A Property which succeeds when its argument fails, and fails
453%% if the argument succeeds.  This is very handy for properties
454%% that <em>should fail</em>.
455%%
456%% @spec fails( property() ) -> property()
457%% @end
458%%--------------------------------------------------------------------
459fails(Prop) ->
460    {'prop:fails', Prop}.
461numtests(Num,Prop) ->
462    {'prop:numtests', Num, Prop}.
463
464%%
465%% 12 crypto-safe random bytes to seed erlang random number generator
466%%
467generate_randomness() ->
468    <<A:32, B:32, C:32>> = crypto:rand_bytes(12),
469    random:seed({A, B, C}).
470