1 :- module(fuzzing,[fuzz/3,fuzz/4,fuzz/5,
2 reproduce_test/4,reproduce_test/5,
3 generate/2,
4 error_occurred/0]).
5
6 :- use_module(library(lists)).
7 :- use_module(library(timeout),[time_out/3]).
8 :- use_module(library(random),[getrand/1,setrand/1]).
9 :- use_module(library(file_systems),[file_members_of_directory/3]).
10
11 %% generate(+Type, -Value).
12 %
13 % True if Value is a randomly generated Prolog term of Type.
14 % For a list of available types see files in 'extensions/prolog_fuzzer/types'.
15 :- multifile generate/2.
16 :- multifile shrink/3.
17
18 %% error_occurred.
19 %
20 % True if fuzzer has detected an errorneous Prolog predicate.
21 :- dynamic error_occurred/0.
22
23 include_type_definition(_-FullPath) :- consult(FullPath).
24
25 % set true to use extension to generate B ASTs
26 b_extension(true).
27
28 include_b_extension :-
29 b_extension(true) ,
30 file_members_of_directory('./types/b_extension/','*.pl',FileList),
31 maplist(include_type_definition,FileList).
32 include_b_extension :-
33 b_extension(false).
34
35 :- file_members_of_directory('./types/','*.pl',FileList),
36 maplist(include_type_definition,FileList) ,
37 include_b_extension.
38
39 :- meta_predicate fuzz(1,+,+).
40 :- meta_predicate fuzz(1,+,+,+).
41 :- meta_predicate fuzz(1,+,+,+,+).
42
43 %% fuzz(+Module:Predicate, +Arity, +Arguments).
44 %
45 % Generate 20000 random tests for a predicate with given argument types.
46 fuzz(Module:Predicate,Arity,Arguments) :-
47 fuzz(Module:Predicate,Arity,20000,Arguments).
48
49 %% fuzz(+Module:Predicate, +Arity, +Testcount, +Arguments).
50 %
51 % Same as fuzz/2 but using a custom amount of tests.
52 fuzz(Module:Predicate,Arity,Testcount,Arguments) :-
53 fuzz(Module:Predicate,Arity,Testcount,5000,Arguments).
54
55 %% fuzz(+Module:Predicate, +Arity, +Testcount, +Arguments).
56 %
57 % Same as fuzz/3 but using a custom timeout in milliseconds.
58 fuzz(Module:Predicate,Arity,Testcount,Timeout,Arguments) :-
59 is_valid_timeout(Timeout),
60 (current_predicate(Module:Predicate/Arity)
61 -> true
62 ; error_process(existence_error,Predicate,_,_,_) , fail) ,
63 % split arguments by ':'
64 get_types(Arguments,Types) ,
65 length(Types,Arity) ,
66 getrand(Seed) ,
67 format('Start fuzzing predicate ~w/~w~n',[Predicate,Arity]) ,
68 format('First state is ~w~n',[Seed]) ,
69 % run randomized tests
70 (run_tests(Predicate,Types,Module,Testcount,Timeout,Result)
71 -> fuzz_aux(Result)
72 ; % run tests failed, error in the code
73 error_process(generation_error,Predicate,_,Types,_)).
74 fuzz(_:Predicate,_,_,_,_) :-
75 error_process(not_enough_arguments,Predicate,_,_,_).
76
77 fuzz_aux(true) :-
78 format('~nAll tests passed~n',[]).
79 fuzz_aux(_).
80
81 is_valid_timeout(Timeout) :-
82 integer(Timeout),
83 Timeout > 0.
84
85 :- meta_predicate reproduce_test(1,+,+,+).
86 :- meta_predicate reproduce_test(1,+,+,+,+).
87
88 %% reproduce_test(+Module:Predicate, +Arity, +Arguments, +Seed).
89 %
90 % Reproduce test case from fuzzing by using a custom seed.
91 reproduce_test(Module:Predicate,Arity,Arguments,Seed) :-
92 reproduce_test(Module:Predicate,Arity,2500,Arguments,Seed).
93
94 %% reproduce_test(+Module:Predicate, +Arity, +Timeout, +Arguments, +Seed).
95 %
96 % Same as reproduce_test/3 but using a custom timeout in milliseconds.
97 reproduce_test(Module:Predicate,Arity,Timeout,Arguments,Seed) :-
98 is_valid_timeout(Timeout),
99 get_types(Arguments,Types) ,
100 length(Types,Arity) ,
101 format('Start fuzzing predicate ~w/~w for given seed~n',[Predicate,Arity]) ,
102 setrand(Seed) ,
103 % run single test
104 (run_tests(Predicate,Types,Module,1,Timeout,Result)
105 -> reproduce_test_aux(Result,Seed)
106 ; % run tests failed
107 error_process(generation_error,Predicate,_,Types,_)).
108 reproduce_test(_,_,Timeout,_,_) :-
109 \+is_valid_timeout(Timeout),
110 !,
111 format("Invalid timeout.~n",[]).
112 reproduce_test(_:Predicate,_,_,_,_) :-
113 error_process(not_enough_arguments,Predicate,_,_,_).
114
115 reproduce_test_aux(true,Seed) :-
116 format('Test passed for seed ~w~n',[Seed]).
117 % pass, because error has already been printed in run_tests
118 reproduce_test_aux(_,_).
119
120 run_tests(_,_,_,0,_,true).
121 % Execute predicate with randomly generated arguments.
122 run_tests(Predicate,Types,Module,Testcount,Timeout,Result) :-
123 getrand(Seed) ,
124 random_arguments(Types,Values) ,
125 Term =.. [Predicate|Values] ,
126 call_term(Module,Term,Timeout,Error) ,
127 % write '.' every thousandth testcase
128 (0 is mod(Testcount,1000)
129 -> write('.')
130 ; true) ,
131 run_tests_aux(Predicate,Types,Module,Testcount,Timeout,Seed,Values,Error,Result).
132
133 run_tests_aux(Predicate,Types,Module,Testcount,Timeout,_Seed,_Values,Error,Result) :-
134 % go on with testing if no error detected
135 Error = none ,
136 NTestcount is Testcount - 1 ,
137 run_tests(Predicate,Types,Module,NTestcount,Timeout,Result).
138 run_tests_aux(Predicate,Types,Module,_Testcount,_Timeout,Seed,Values,Error,Result) :-
139 Error \= none ,
140 Result = false ,
141 % try shrinking arguments and print error
142 format('~nError detected, shrink arguments~n',[]) ,
143 % don't print input from mutation(Input:Type) for user readability
144 minimum_typelist(Types,NTypes) ,
145 shrink_values(Predicate,Module,Types,Values,Shrunken) , nl ,
146 assert(error_occurred) ,
147 error_process(Error,Predicate,Shrunken,NTypes,Seed) , nl.
148
149 % call_term(+Module,+Term,+Timeout,-Error).
150 %
151 % Calls a term within its given module with error and timeout exception.
152 call_term(Module,Term,Timeout,Error) :-
153 Timeout1 is Timeout + 10000,
154 time_out(on_exception(_,Module:call(Term),fail),Timeout1,Result) ,
155 call_term_aux(Result,Error).
156 call_term(_Module,_Timeout,_Term,Error) :-
157 % predicate failed
158 Error = false.
159
160 call_term_aux(success,none).
161 call_term_aux(_,timeout).
162
163 % shrink arguments
164 shrink_values(Predicate,Module,Types,Values,Result) :-
165 % write sth at every shrinking step
166 write('.') ,
167 maplist(shrink_arguments,Types,Values,Shrunken) ,
168 % termination condition
169 Values \= Shrunken ,
170 Term =.. [Predicate|Shrunken] ,
171 % catch timeout and error exception
172 \+ time_out(on_exception(_,Module:call(Term),fail),1000,success) ,
173 shrink_values(Predicate,Module,Types,Shrunken,Result).
174 shrink_values(_,_,_,Result,Result).
175
176 shrink_arguments(Type,Value,Shrunken) :-
177 shrink(Type,Value,Shrunken).
178 shrink_arguments(_,Value,Value).
179
180 % convert types divided by ':' to a list
181 get_types(Type:T,[Type|NT]) :-
182 get_types(T,NT) , !.
183 get_types(Type,[Type]).
184
185 % generate random arguments from a list of types
186 random_arguments([],[]).
187 random_arguments([Type|T1],[Value|T2]) :-
188 generate(Type,Value) ,
189 random_arguments(T1,T2).
190
191 % make typelist readable, i.e. don't print input from mutation(Input:Type)
192 minimum_typelist([],[]).
193 minimum_typelist([mutation(_:Type)|T],[mutation(Type)|NT]) :- ! ,
194 minimum_typelist(T,NT).
195 minimum_typelist([Type|T],[Type|NT]) :-
196 minimum_typelist(T,NT).
197
198 % error prints
199 error_process(existence_error,Predicate,_,_,_) :-
200 format('Predicate ~q does not exist.~n',[Predicate]).
201 error_process(not_enough_arguments,Predicate,_,_,_) :-
202 format('Wrong amount of arguments for predicate ~q~n',[Predicate]).
203 error_process(error(type_error(_,_),_),Predicate,_,Types,_) :-
204 format('Wrong type of arguments in predicate ~q of type ~q~n',[Predicate,Types]).
205 error_process(generation_error,_,_,Types,_) :- % error in generate/2
206 format('Either the type is not defined or there is an implementation error in a prolog file for a type of ~q~n',[Types]).
207 error_process(timeout,Predicate,Values,Types,Seed) :-
208 length(Types,Arity) ,
209 format('Timeout in ~q/~w for input ~q of type ~q~nSeed for reproducing test case: ~w~n',[Predicate,Arity,Values,Types,Seed]).
210 error_process(false,Predicate,Values,Types,Seed) :-
211 length(Types,Arity) ,
212 format('Predicate ~q/~w false for input ~q of type ~q~nSeed for reproducing test case: ~w~n',[Predicate,Arity,Values,Types,Seed]).