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]).

   54setting(max_time(5)).
   55
   56
   57                 /*******************************
   58                 *       UNIT GENERATION        *
   59                 *******************************/

 make_tests(+Module, +File, +Out) is det

Create tests from queries stored in File and write the tests for Module to the stream Out.

   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                 *******************************/

 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.

   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).

 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.

  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)).

 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.

  116pred_name(Callable, Name) :-
  117    strip_module(Callable, _, Term),
  118    functor(Term, Name, _Arity).

 test_result(+Callable, +Maxtime, -Result) is det

Try running goal and get meaningful results. Results are:

• true(Templ == Var)
• fail
• all(Templ == Bindings)
• throws(Error)
• timeout

  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    ).

 success(+Bindings, +Templ, -Result) is det

Create test-results from non-error cases.

  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).

 error(+ErrorTerm, -Result)

  161error(Error0, [throws(Error)]) :-
  162    generalise_error(Error0, Error).
  163
  164
  165generalise_error(error(Formal, _), error(Formal, _)) :- !.
  166generalise_error(Term, Term).

 make_template(+Vars, -Template) is det

Make a nice looking template

  173make_template([], []) :- !.
  174make_template([One], One) :- !.
  175make_template([One, Two], One-Two) :- !.
  176make_template(List, Vars) :-
  177    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.

  184call_test(Goal, Det) :-
  185    Goal,
  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', [])