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(maxLenList, integer, 32, "Max list length."). 17:- setting(verbosity, integer, 1, "Verbosity."). 18:- setting(minVal, integer, -2147483648, "Min val to generate."). 19:- setting(maxVal, 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 ( \+ToCall ->
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 ( ToCall ->
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~n", Test),
85 test_loop(Trials,Predicate,Arguments,[],FailuresList),
86 length(FailuresList,NFailures),
87 FailureRatio is NFailures / Trials,
88 sort(FailuresList,FS),
89 format("Run ~w attempts, ~w failures (~w %)~n",[Trials,NFailures,FailureRatio]),
90 ( NFailures > 0 ->
91 format("Failures list ~w~n--- FAILED ---~n",[FS]),
92 Result = -1 ;
93 writeln("Passed"),
94 Result = 1
95 ).
96
97pretty_print_arguments([Arg,Def]):-
98 format("- ~w (default: ~w)~n",[Arg,Def]).
99set_argument(seed(N)):-
100 set_random(seed(N)).
101set_argument(Arg):-
102 Arg =.. [Argument,Value],
103 member(Argument,[trial,depth,maxLenList,verbosity]),
104 ( integer(Value), Value > 0 ->
105 set_setting(Argument,Value) ;
106 format("~w must be an integer > 0, found ~w~n",[Argument,Value]),
107 fail
108 ).
109set_argument(Arg):-
110 Arg =.. [Argument,Value],
111 member(Argument,[minVal,maxVal]),
112 ( number(Value) ->
113 set_setting(Argument,Value) ;
114 format("~w must be a number, found ~w~n",[Argument,Value]),
115 fail
116 ).
117set_argument(A):-
118 format("Argument ~w not found~n",[A]),
119 findall([Arg,Default],setting(Arg,Default),LAS),
120 writeln("Available arguments:"),
121 maplist(pretty_print_arguments,LAS),
122 fail.
123
124
125property_test:-
126 property_test_.
127property_test(Arguments):-
128 ( is_list(Arguments) ->
129 maplist(set_argument,Arguments), !,
130 setting(minVal,MinV),
131 setting(maxVal,MaxV),
132 ( MinV >= MaxV ->
133 writeln("minVal must be less than maxVal"),
134 fail ;
135 true
136 ),
137 property_test_ ;
138 writeln("Arguments must be passed inside a list"),
139 false
140 ).
141
144check_existence(Predicate,DoesExist):-
145 functor(Predicate, Name, Arity),
146 ( current_predicate(user:Name/Arity) ->
147 DoesExist = 1 ;
148 DoesExist = 0
149 ),
150 ( Arity > 5 ->
151 format("Currently predicates with at most 5 arguments are supported, found ~w in ~w~n",[Arity,Predicate]),
152 false ;
153 true
154 ).
155
156write_predicates_not_found(Predicate,0):-
157 format("Predicate ~w not defined~n", [Predicate]).
158write_predicates_not_found(_,1).
159
160property_test_:-
161 catch(
162 user:property(_),
163 error(existence_error(_,_),_),
164 (writeln("Please specify at least one property to test"), false)
165 ), !,
166 findall(Test,user:property(Test),LTests),
167 168 maplist(check_existence,LTests,ExistOrNot),
169 ( member(0,ExistOrNot) ->
170 maplist(write_predicates_not_found,LTests,ExistOrNot),
171 false ;
172 true
173 ),
174 length(LTests,NTests),
175 format("Found ~w tests~n",[NTests]),
176 177 ( NTests > 0 ->
178 call_time(maplist(run_test,LTests,Results), Runtime),
179 findall(-1,member(-1,Results),LFailed),
180 length(LFailed,NFailed),
181 length(Results,NTested),
182 Ratio is NFailed / NTested,
183 Runtime = time{cpu:_CT, inferences:_I, wall:W},
184 writeln("--- Summary ---"),
185 format("Executed ~w test in ~w seconds~n",[NTested,W]),
186 format("Failed ~w over ~w (~w %)~n.",[NFailed,NTested,Ratio]) ;
187 true
188 )