1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2006-2012, University of Amsterdam 7 VU University Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(test_wizard, 37 [ make_tests/3, % +Module, +File, +Out 38 make_test/3 % +Callable, -Module, -Test 39 ]). 40:- autoload(library(apply),[maplist/2]). 41:- autoload(library(listing),[portray_clause/2]). 42:- autoload(library(lists),[member/2]). 43:- autoload(library(readutil),[read_file_to_terms/3]). 44:- autoload(library(time),[call_with_time_limit/2]). 45 46/** <module> Test Generation Wizard 47 48Tasks 49 50 * Accumulate user queries 51 * Suggest tests from user queries 52*/ 53 54setting(max_time(5)). 55 56 57 /******************************* 58 * UNIT GENERATION * 59 *******************************/ 60 61%! make_tests(+Module, +File, +Out) is det. 62% 63% Create tests from queries stored in File and write the tests for 64% Module to the stream Out. 65 66make_tests(Module, File, Out) :- 67 read_file_to_terms(File, Queries, []), 68 findall(Test, ( member(Q, Queries), 69 make_test(Q, Module, Test)), Tests), 70 ( Tests == [] 71 -> true 72 ; format(Out, ':- begin_tests(~q).~n~n', [Module]), 73 maplist(portray_clause(Out), Tests), 74 format(Out, '~n:- end_tests(~q).~n', [Module]) 75 ). 76 77 78 /******************************* 79 * TEST GENERATION * 80 *******************************/ 81 82%! make_test(+Query:callable, -Module, -Test:term) is det. 83% 84% Generate a test from a query. Test is returned as a clause of 85% test/1 or test/2 to be inserted between begin_tests and 86% end_tests. 87 88make_test(Query0, Module, (test(Name, Options) :- Query)) :- 89 find_test_module(Query0, Module, Query), 90 pred_name(Query, Name), 91 setting(max_time(Max)), 92 test_result(Module:Query, Max, Options). 93 94%! find_test_module(+QuerySpec, ?Module, -Query). 95% 96% Find module to test from a query. Note that it is very common 97% for toplevel usage to rely on SWI-Prolog's DWIM. 98% 99% @tbd What if multiple modules match? We can select the 100% local one or ask the user. 101 102find_test_module(Var, _, _) :- 103 var(Var), !, fail. 104find_test_module(M:Query, M0, Query) :- 105 !, 106 M0 = M. 107find_test_module(Query, M, Query) :- 108 current_predicate(_, M:Query), 109 \+ predicate_property(M:Query, imported_from(_M2)). 110 111%! pred_name(+Callable, -Name) is det. 112% 113% Suggest a name for the test. In the plunit framework the name 114% needs not be unique, so we simply take the predicate name. 115 116pred_name(Callable, Name) :- 117 strip_module(Callable, _, Term), 118 functor(Term, Name, _Arity). 119 120%! test_result(+Callable, +Maxtime, -Result) is det. 121% 122% Try running goal and get meaningful results. Results are: 123% 124% * true(Templ == Var) 125% * fail 126% * all(Templ == Bindings) 127% * throws(Error) 128% * timeout 129 130test_result(Callable, Maxtime, Result) :- 131 term_variables(Callable, Vars), 132 make_template(Vars, Templ), 133 catch(call_with_time_limit(Maxtime, 134 findall(Templ-Det, 135 call_test(Callable, Det), 136 Bindings)), 137 E, true), 138 ( var(E) 139 -> success(Bindings, Templ, Result) 140 ; error(E, Result) 141 ). 142 143%! success(+Bindings, +Templ, -Result) is det. 144% 145% Create test-results from non-error cases. 146 147success([], _, [fail]) :- !. 148success([[]-true], _, []) :- !. 149success([S1-true], Templ, [ true(Templ == S1) ]) :- !. 150success([[]-false], _, [ nondet ]) :- !. 151success([S1-false], Templ, [ true(Templ == S1), nondet ]) :- !. 152success(ListDet, Templ, [all(Templ == List)]) :- 153 strip_det(ListDet, List). 154 155strip_det([], []). 156strip_det([H-_|T0], [H|T]) :- 157 strip_det(T0, T). 158 159%! error(+ErrorTerm, -Result) 160 161error(Error0, [throws(Error)]) :- 162 generalise_error(Error0, Error). 163 164 165generalise_error(error(Formal, _), error(Formal, _)) :- !. 166generalise_error(Term, Term). 167 168 169%! make_template(+Vars, -Template) is det. 170% 171% Make a nice looking template 172 173make_template([], []) :- !. 174make_template([One], One) :- !. 175make_template([One, Two], One-Two) :- !. 176make_template(List, Vars) :- 177 Vars =.. [v|List]. 178 179%! call_test(:Goal, -Det) is nondet. 180% 181% True if Goal succeeded. Det is unified to =true= if Goal left 182% no choicepoints and =false= otherwise. 183 184call_test(Goal, Det) :- 185 , 186 deterministic(Det). 187 188 189 /******************************* 190 * COLLECT * 191 *******************************/ 192 193/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 194Collect toplevel queries if the Prolog flag log_query_file points to the 195name of a writeable file. The file is opened in append-mode for 196exclusive write to allow for concurrent operation from multiple Prolog 197systems using the same logfile. 198 199The file is written in UTF-8 encoding and using ignore_ops(true) to 200ensure it can be read. 201- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 202 203:- multifile 204 user:message_hook/3. 205 206user:message_hook(toplevel_goal(Goal0, Bindings), _Level, _Lines) :- 207 open_query_log(Out), 208 bind_vars(Bindings), 209 clean_goal(Goal0, Goal), 210 call_cleanup(format(Out, '~W.~n', [Goal, [ numbervars(true), 211 quoted(true), 212 ignore_ops(true) 213 ]]), close(Out)), 214 fail. 215 216clean_goal(Var, _) :- 217 var(Var), !, fail. 218clean_goal(user:Goal, Goal) :- !. 219clean_goal(Goal, Goal). 220 221bind_vars([]). 222bind_vars([Name=Var|T]) :- 223 Var = '$VAR'(Name), 224 bind_vars(T). 225 226open_query_log(Out) :- 227 current_prolog_flag(log_query_file, File), 228 exists_file(File), 229 !, 230 open(File, append, Out, 231 [ encoding(utf8), 232 lock(write) 233 ]). 234open_query_log(Out) :- 235 current_prolog_flag(log_query_file, File), 236 access_file(File, write), 237 !, 238 open(File, write, Out, 239 [ encoding(utf8), 240 lock(write), 241 bom(true) 242 ]), 243 format(Out, 244 '/* SWI-Prolog query log. This file contains all syntactically\n \c 245 correct queries issued in this directory. It is used by the\n \c 246 test wizard to generate unit tests.\n\c 247 */~n~n', [])