1:- module(probat, [property_test/0, property_test/1]). 2
3:- ["generators.pl"]. 4:- ["shrinkers.pl"]. 5
6:- multifile valid_generator/1. 7:- multifile random_element/2. 8:- multifile random_element/4. 9:- multifile generate_shrinking_alternatives/3. 10:- dynamic property/1. 11
12:- meta_predicate property(?). 13
14:- setting(trials, integer, 100, "Number of test"). 15:- setting(depth, integer, 8, "Max shrink depth."). 16:- setting(max_len_list, integer, 32, "Max list length."). 17:- setting(verbosity, integer, 1, "Verbosity."). 18:- setting(min_val, integer, -2147483648, "Min val to generate."). 19:- setting(max_val, integer, 2147483648, "Max val to generate."). 20
26setup_arguments(Predicate,[[A0|TA0]],ToCall,Remaining):-
27 ToCall =.. [Predicate,A0],
28 Remaining = [TA0].
29setup_arguments(Predicate,[[A0|TA0],[A1|TA1]],ToCall,Remaining):-
30 ToCall =.. [Predicate,A0,A1],
31 Remaining = [TA0,TA1].
32setup_arguments(Predicate,[[A0|TA0],[A1|TA1],[A2|TA2]],ToCall,Remaining):-
33 ToCall =.. [Predicate,A0,A1,A2],
34 Remaining = [TA0,TA1,TA2].
35setup_arguments(Predicate,[[A0|TA0],[A1|TA1],[A2|TA2],[A3|TA3]],ToCall,Remaining):-
36 ToCall =.. [Predicate,A0,A1,A2,A3],
37 Remaining = [TA0,TA1,TA2,TA3].
38setup_arguments(Predicate,[[A0|TA0],[A1|TA1],[A2|TA2],[A3|TA3],[A4|TA4]],ToCall,Remaining):-
39 ToCall =.. [Predicate,A0,A1,A2,A3,A4],
40 Remaining = [TA0,TA1,TA2,TA3,TA4].
41
42test_shrank(Predicate,LArgs,F0):-
43 setup_arguments(Predicate,LArgs,ToCall,Remaining),
44 setting(verbosity,V),
45 ( V > 1 ->
46 format("Testing ~w~n",[ToCall]) ;
47 true
48 ),
49 ( \+ catch(ToCall, _Error, false) ->
50 F0 = ToCall ;
51 test_shrank(Predicate,Remaining,F0)
52 ).
53
54test_loop(I,_,_,L,L):- I =< 0, !.
55test_loop(I,Predicate,Arguments,LF,FailuresList):-
56 I > 0,
57 I1 is I - 1,
58 59 maplist(random_element,Arguments,LRandomElements), !,
60 ToCall =.. [Predicate|LRandomElements],
61 ( catch(ToCall, _Error, false) ->
62 test_loop(I1,Predicate,Arguments,LF,FailuresList) ;
63 maplist(generate_shrinking_alternatives,Arguments,LRandomElements,PossibleShrinks),
64 setting(verbosity,V),
65 ( V > 1 ->
66 format("Calling with ~w~n",[PossibleShrinks]) ;
67 true
68 ),
69 ( test_shrank(Predicate,PossibleShrinks,F) ->
70 FailingInstance = F ;
71 FailingInstance = LRandomElements 72 ),
73 test_loop(I1,Predicate,Arguments,[FailingInstance|LF],FailuresList)
74 ).
75
76run_test(Test,Result):-
77 setting(trials,Trials),
78 Test =.. [Predicate|Arguments],
79 ( maplist(valid_generator,Arguments) ->
80 true ;
81 format("Some generators for ~w are not valid~n",[Test]),
82 false
83 ),
84 format("Executing test: ~w ..... ", Test),
85 test_loop(Trials,Predicate,Arguments,[],FailuresList),
86 length(FailuresList,NFailures),
87 FailureRatio is roundtoward((NFailures / Trials)*100, to_nearest),
88 sort(FailuresList,FS),
89 90 format("Run ~w attempts, ~w failures (~w %) ..... ",[Trials,NFailures,FailureRatio]),
91 ( NFailures > 0 ->
92 FS = [Smallest|_],
93 reverse(FS,FSRev),
94 FSRev = [Greatest|_],
95 ansi_format([fg(red)],"FAILED~nSmallest failing ~w~nGreatest failing ~w~n",[Smallest,Greatest]),
96 Result = -1 ;
97 ansi_format([fg(green)],"Passed~n",[]),
98 Result = 1
99 ).
100
101pretty_print_arguments([Arg,Def]):-
102 format("- ~w (default: ~w)~n",[Arg,Def]).
103set_argument(seed(N)):-
104 set_random(seed(N)).
105set_argument(Arg):-
106 Arg =.. [Argument,Value],
107 member(Argument,[trials,depth,max_len_list,verbosity]),
108 ( integer(Value), Value > 0 ->
109 set_setting(Argument,Value) ;
110 format("~w must be an integer > 0, found ~w~n",[Argument,Value]),
111 fail
112 ).
113set_argument(Arg):-
114 Arg =.. [Argument,Value],
115 member(Argument,[min_val,max_val]),
116 ( number(Value) ->
117 set_setting(Argument,Value) ;
118 format("~w must be a number, found ~w~n",[Argument,Value]),
119 fail
120 ).
121set_argument(A):-
122 format("Argument ~w not found~n",[A]),
123 findall([Arg,Default],setting(Arg,Default),LAS),
124 writeln("Available arguments:"),
125 maplist(pretty_print_arguments,LAS),
126 fail.
127
128
129property_test:-
130 property_test_.
131property_test(Arguments):-
132 ( is_list(Arguments) ->
133 maplist(set_argument,Arguments), !,
134 setting(min_val,MinV),
135 setting(max_val,MaxV),
136 ( MinV >= MaxV ->
137 writeln("min_val must be less than max_val"),
138 fail ;
139 true
140 ),
141 property_test_ ;
142 writeln("Arguments must be passed inside a list"),
143 false
144 ).
145
148check_existence(Predicate,DoesExist):-
149 functor(Predicate, Name, Arity),
150 ( ((atom(Predicate) ; compound(Predicate)), current_predicate(user:Name/Arity)) ->
151 DoesExist = 1 ;
152 DoesExist = 0
153 ),
154 ( Arity > 5 ->
155 format("Currently predicates with at most 5 arguments are supported, found ~w in ~w~n",[Arity,Predicate]),
156 false ;
157 true
158 ).
159
160write_predicates_not_found(Predicate,0):-
161 format("Predicate ~w not defined~n", [Predicate]).
162write_predicates_not_found(_,1).
163
164property_test_:-
165 catch(
166 user:property(_),
167 error(existence_error(_,_),_),
168 (writeln("Please specify at least one property to test"), false)
169 ), !,
170 findall(Test,user:property(Test),LTests),
171 172 maplist(check_existence,LTests,ExistOrNot),
173 ( member(0,ExistOrNot) ->
174 maplist(write_predicates_not_found,LTests,ExistOrNot),
175 false ;
176 true
177 ),
178 length(LTests,NTests),
179 ( ( NTests = 0; NTests = 1 ) ->
180 format("Found ~w test.~n",[NTests]);
181 format("Found ~w tests.~n",[NTests])
182 ),
183 184 ( NTests > 0 ->
185 call_time(maplist(run_test,LTests,Results), Runtime),
186 findall(-1,member(-1,Results),LFailed),
187 length(LFailed,NFailed),
188 length(Results,NTested),
189 Ratio is roundtoward((NFailed / NTested)*100,to_nearest),
190 Runtime = time{cpu:_CT, inferences:_I, wall:W},
191 writeln("--- Summary ---"),
192 format("Executed ~w test in ~w seconds~n",[NTested,W]),
193 format("Failed ~w over ~w (~w %)~n.",[NFailed,NTested,Ratio]) ;
194 true
195 )