View source with raw comments or as raw
    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:- use_module(library(time)).   41:- use_module(library(lists)).   42:- use_module(library(listing)).   43:- use_module(library(readutil)).

Test Generation Wizard

Tasks

*/

   53setting(max_time(5)).
   54
   55
   56                 /*******************************
   57                 *       UNIT GENERATION        *
   58                 *******************************/
 make_tests(+Module, +File, +Out) is det
Create tests from queries stored in File and write the tests for Module to the stream Out.
   65make_tests(Module, File, Out) :-
   66    read_file_to_terms(File, Queries, []),
   67    findall(Test, (   member(Q, Queries),
   68                      make_test(Q, Module, Test)), Tests),
   69    (   Tests == []
   70    ->  true
   71    ;   format(Out, ':- begin_tests(~q).~n~n', [Module]),
   72        maplist(portray_clause(Out), Tests),
   73        format(Out, '~n:- end_tests(~q).~n', [Module])
   74    ).
   75
   76
   77                 /*******************************
   78                 *       TEST GENERATION        *
   79                 *******************************/
 make_test(+Query:callable, -Module, -Test:term) is det
Generate a test from a query. Test is returned as a clause of test/1 or test/2 to be inserted between begin_tests and end_tests.
   87make_test(Query0, Module, (test(Name, Options) :- Query)) :-
   88    find_test_module(Query0, Module, Query),
   89    pred_name(Query, Name),
   90    setting(max_time(Max)),
   91    test_result(Module:Query, Max, Options).
 find_test_module(+QuerySpec, ?Module, -Query)
Find module to test from a query. Note that it is very common for toplevel usage to rely on SWI-Prolog's DWIM.
To be done
- What if multiple modules match? We can select the local one or ask the user.
  101find_test_module(Var, _, _) :-
  102    var(Var), !, fail.
  103find_test_module(M:Query, M0, Query) :-
  104    !,
  105    M0 = M.
  106find_test_module(Query, M, Query) :-
  107    current_predicate(_, M:Query),
  108    \+ predicate_property(M:Query, imported_from(_M2)).
 pred_name(+Callable, -Name) is det
Suggest a name for the test. In the plunit framework the name needs not be unique, so we simply take the predicate name.
  115pred_name(Callable, Name) :-
  116    strip_module(Callable, _, Term),
  117    functor(Term, Name, _Arity).
 test_result(+Callable, +Maxtime, -Result) is det
Try running goal and get meaningful results. Results are:
  129test_result(Callable, Maxtime, Result) :-
  130    term_variables(Callable, Vars),
  131    make_template(Vars, Templ),
  132    catch(call_with_time_limit(Maxtime,
  133                               findall(Templ-Det,
  134                                       call_test(Callable, Det),
  135                                       Bindings)),
  136          E, true),
  137    (   var(E)
  138    ->  success(Bindings, Templ, Result)
  139    ;   error(E, Result)
  140    ).
 success(+Bindings, +Templ, -Result) is det
Create test-results from non-error cases.
  146success([], _, [fail]) :- !.
  147success([[]-true],  _, []) :- !.
  148success([S1-true],  Templ, [ true(Templ == S1) ]) :- !.
  149success([[]-false], _, [ nondet ]) :- !.
  150success([S1-false], Templ, [ true(Templ == S1), nondet ]) :- !.
  151success(ListDet, Templ, [all(Templ == List)]) :-
  152    strip_det(ListDet, List).
  153
  154strip_det([], []).
  155strip_det([H-_|T0], [H|T]) :-
  156    strip_det(T0, T).
 error(+ErrorTerm, -Result)
  160error(Error0, [throws(Error)]) :-
  161    generalise_error(Error0, Error).
  162
  163
  164generalise_error(error(Formal, _), error(Formal, _)) :- !.
  165generalise_error(Term, Term).
 make_template(+Vars, -Template) is det
Make a nice looking template
  172make_template([], []) :- !.
  173make_template([One], One) :- !.
  174make_template([One, Two], One-Two) :- !.
  175make_template(List, Vars) :-
  176    Vars =.. [v|List].
 call_test(:Goal, -Det) is nondet
True if Goal succeeded. Det is unified to true if Goal left no choicepoints and false otherwise.
  183call_test(Goal, Det) :-
  184    Goal,
  185    deterministic(Det).
  186
  187
  188                 /*******************************
  189                 *           COLLECT            *
  190                 *******************************/
  191
  192/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  193Collect toplevel queries if the Prolog flag log_query_file points to the
  194name of a writeable  file.  The  file   is  opened  in  append-mode  for
  195exclusive write to allow for concurrent   operation from multiple Prolog
  196systems using the same logfile.
  197
  198The file is written in  UTF-8   encoding  and  using ignore_ops(true) to
  199ensure it can be read.
  200- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  201
  202:- multifile
  203    user:message_hook/3.  204
  205user:message_hook(toplevel_goal(Goal0, Bindings), _Level, _Lines) :-
  206    open_query_log(Out),
  207    bind_vars(Bindings),
  208    clean_goal(Goal0, Goal),
  209    call_cleanup(format(Out, '~W.~n', [Goal, [ numbervars(true),
  210                                               quoted(true),
  211                                               ignore_ops(true)
  212                                             ]]), close(Out)),
  213    fail.
  214
  215clean_goal(Var, _) :-
  216    var(Var), !, fail.
  217clean_goal(user:Goal, Goal) :- !.
  218clean_goal(Goal, Goal).
  219
  220bind_vars([]).
  221bind_vars([Name=Var|T]) :-
  222    Var = '$VAR'(Name),
  223    bind_vars(T).
  224
  225open_query_log(Out) :-
  226    current_prolog_flag(log_query_file, File),
  227    exists_file(File),
  228    !,
  229    open(File, append, Out,
  230         [ encoding(utf8),
  231           lock(write)
  232         ]).
  233open_query_log(Out) :-
  234    current_prolog_flag(log_query_file, File),
  235    access_file(File, write),
  236    !,
  237    open(File, write, Out,
  238         [ encoding(utf8),
  239           lock(write),
  240           bom(true)
  241         ]),
  242    format(Out,
  243           '/* SWI-Prolog query log.  This file contains all syntactically\n   \c
  244                   correct queries issued in this directory.  It is used by the\n   \c
  245                   test wizard to generate unit tests.\n\c
  246                */~n~n', [])