PlUnit test runner for PlDoc code examples

   12:- module(doctest,
   13         [
   14           gen_doctests/1,
   15           gen_doctests/2
   16         ]).   17
   18:- use_module(library(test_wizard)).   19:- use_module(library(prolog_xref)).   20:- use_module(library(pcre)).

 gen_doctests(+File) is det

Same as gen_doctests/2 with default options to File

   26gen_doctests(File) :-
   27  gen_doctests(File, []).

 gen_doctests(+File, +Options) is det

Generate the tests from the PlDoc of File in TestFile and run them all. Options can contain the outfile(Name) overriding the default adding a 't' to File and the parse_output(true) flag to use the new test maker instead of make_test/3.

The new test maker will try to parse the output of the queries in the code blocks whereas otherwise the query is run using the test_wizard library

File must define a proper module.

   41gen_doctests(File, Options) :-
   42  atom_concat(File, 't', DefaultTestFile),
   43  option(outfile(TestFile), Options, DefaultTestFile),
   44  option(parse_output(ParseOutput), Options, false),
   45  (
   46    exists_file(TestFile)
   47  ->
   48    permission_error(generate, new, TestFile)
   49  ;
   50    true
   51  ),
   52  xref_source(File, [silent(true)]),
   53  xref_module(File, Module),
   54  user:use_module(File),
   55  xref_source(File, [silent(true)]),
   56  setup_call_cleanup(
   57    open(TestFile, write, Stream),
   58    with_output_to(
   59      Stream,
   60      (
   61        format(':- use_module(~q).~n:- begin_tests(~q).~n~n', [File, Module]),
   62        forall(
   63          (
   64            xref_comment(File, _Title, Comment)
   65          ;
   66            xref_comment(File, _Head, _Summary, Comment)
   67          ),
   68          process_comment(Comment, ParseOutput)
   69        ),
   70        format(':- end_tests(~q).~n~n', [Module])
   71      )
   72    ),
   73    close(Stream)
   74  ).

 process_comment(+CommentString, +ParseOutput) is det

Process a PlDoc comment

   80process_comment(Comment, ParseOutput) :-
   81  re_split("^%*\\s*(~~~.*|==\\s*)$\\n*"/m, Comment, [_ | Split]),
   82  get_code_blocks(Split, Blocks),
   83  (
   84    Blocks = [_ | _]
   85  ->
   86    forall(
   87      member(B, Blocks),
   88      (
   89        get_queries(B, Queries),
   90        forall(
   91            member(Q, Queries),
   92            write_test(Q, ParseOutput)
   93        )
   94      )
   95    )
   96  ;
   97    true
   98  ).

 get_code_blocks(+Split, -Blocks) is det

Blocks is a list of lists of strings for each code block in Split

  104get_code_blocks([], []).
  105
  106get_code_blocks([_], []) :-
  107  print_message(error, syntax_error("==")).
  108
  109get_code_blocks([_, _], []) :-
  110  print_message(error, syntax_error("==")).
  111
  112get_code_blocks([_, _, _], []) :-
  113  print_message(error, syntax_error("==")).
  114
  115get_code_blocks([_, B, _, _ | Split], [BB | Blocks]) :-
  116  split_string(B, "\n", "\s\t%", L),
  117  append(BB, [_], L),
  118  get_code_blocks(Split, Blocks).

 get_queries(+Block, -Queries) is det

Queries is the list of all query terms in Block For now, ignore the answers.

  125get_queries(Block, Queries) :-
  126  get_queries(Block, _, [], Queries).

 get_queries(+Lines, ?CurrentQuery, -Answers, -QueriesAnswersList) is det

Build a list of Query-ListOfAnswers from a list of lines.

  133get_queries(B, Q, A, _) :-
  134  debug(doctest, "~w~n", [get_queries(B, Q, A)]),
  135  fail.
  136
  137get_queries([], Q-V, AnswerStrings, L) :-
  138  reverse(AnswerStrings, AS),
  139  atomic_list_concat(AS, Answer),
  140  catch(
  141    (
  142      term_string(A, Answer, [variable_names(VV)]),
  143      L = [Q-(A-V)]
  144    ),
  145    Error,
  146    (
  147      print_message(error, Error),
  148      L = []
  149    )
  150  ),
  151  names_compat(VV, V).
  152
  153get_queries([H | T], Q, AnswerStrings, Queries) :-
  154  (
  155    H == ""
  156  ->
  157    get_queries(T, Q, AnswerStrings, Queries)
  158  ;
  159    string_concat("?-", _, H)
  160  ->
  161    catch(
  162      (
  163        term_string('?-'(Query), H, [variable_names(V)]),
  164        (
  165          var(Q)
  166        ->
  167          get_queries(T, Query-V, [], Queries)
  168        ;
  169          Q = QQ-VV,
  170          reverse(AnswerStrings, AS),
  171          atomic_list_concat(AS, Answer),
  172          catch(
  173            (
  174              term_string(A, Answer, [variable_names(VVV)]),
  175              names_compat(VVV, VV),
  176              Queries = [QQ-(A-VV) | QQueries]
  177            ),
  178            Error,
  179            (
  180              print_message(error, Error),
  181              QQueries = Queries
  182            )
  183          ),
  184          get_queries(T, Query-V, [], QQueries)
  185        )
  186      ),
  187     Error,
  188     print_message(error, Error)
  189   )
  190  ;
  191    get_queries(T, Q, [H | AnswerStrings], Queries)
  192  ).

 my_portray_clause(+C) is det

C is Q-(Head :- Body) portray as Head :- Q since Q is a fully qualified version of Body that unfortunately make_test/3 does simplify.

  200my_portray_clause(Q-(Head :- _Body)) :-
  201  portray_clause(Head :- Q).

 write_test(Query, +ParseOutput) is det

Query is of the form Q-(A-V) Generate a test clause for the query Q with answers A and variables V if ParseOutput is false, use make_test/3 otherwise use make_test_from_output/2

  209write_test(Q-_, false) :-
  210  % will incorrectly label nondet anything since it calls it inside a findall
  211  nonvar(Q),
  212  make_test(Q, _, Test),
  213  my_portray_clause(Q-Test).
  214
  215write_test(Q-(A-V), true) :-
  216  nonvar(Q),
  217  debug(doctest, "~w~n", [Q-(A-V)]),
  218  make_test_from_output(Q-(A-V), Test),
  219  current_output(Stream),  % needed because portray_clause/2 needs the stream!
  220  portray_clause(Stream, Test, [variable_names(V)]).
  221
  222write_test(Q-_, _) :-
  223  var(Q).

 make_test_from_output(+Query, -Test) is det

Generate a test clause for Query=Q-(A-V) using the answers in A and the variables in V

  230make_test_from_output(Query-(true-[]), T) :-
  231  test_wizard:pred_name(Query, Name),
  232  T = (test(Name) :- Query).
  233
  234make_test_from_output(Query-(false-[]), T) :-
  235  test_wizard:pred_name(Query, Name),
  236  T = (test(Name, [fail]) :- Query).
  237
  238make_test_from_output(Query-((_;_)-[]), T) :-
  239  test_wizard:pred_name(Query, Name),
  240  T = (test(Name, [nondet]) :- Query).
  241
  242make_test_from_output(Query-(Answers-VariableNames), T) :-
  243  debug(doctest, "~w~n", [Query-(Answers-VariableNames)]),
  244  maplist(([X, Y]>>(X=(_=Y))), VariableNames, Variables),
  245  test_wizard:make_template(Variables, Templ),
  246  findall(
  247    Templ,
  248    call(Answers),
  249    Bindings
  250  ),
  251  test_wizard:pred_name(Query, Name),
  252  T = (test(Name, [all(Templ =@= Bindings)]) :- Query).

 names_compat(?Names, ?AllNames) is det

ensure the Name = Var bindings in Names all appear in AllNames.

  258names_compat([], _).
  259
  260names_compat([A = V | L], Names) :-
  261  memberchk(A = V, Names),
  262  names_compat(L, Names)