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)).
26gen_doctests(File) :-
27 gen_doctests(File, []).
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 ).
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 ).
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).
125get_queries(Block, Queries) :-
126 get_queries(Block, _, [], Queries).
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 ).
200my_portray_clause(Q-(Head :- _Body)) :-
201 portray_clause(Head :- Q).
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).
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).
258names_compat([], _). 259 260names_compat([A = V | L], Names) :- 261 memberchk(A = V, Names), 262 names_compat(L, Names)
PlUnit test runner for PlDoc code examples
This module looks for fenced code blocks (using
~~~
or==
) in PlDoc comments and turns them into unit tests for the PlUnit framework each time there is a query identified by?-