| 1 | % (c) 2009-2019 Lehrstuhl fuer Softwaretechnik und Programmiersprachen, | |
| 2 | % Heinrich Heine Universitaet Duesseldorf | |
| 3 | % This software is licenced under EPL 1.0 (http://www.eclipse.org/org/documents/epl-v10.html) | |
| 4 | ||
| 5 | :- module(self_check, | |
| 6 | [assert_pre/2, assert_post/2,pp_mnf/1, pp_cll/1, mnf/1, mnf/2, | |
| 7 | mnf_det/1, det_call/1, force_det_call/1, | |
| 8 | assert_must_succeed/1,assert_must_fail/1, | |
| 9 | assert_must_succeed_multiple/1, assert_must_succeed_any/1, | |
| 10 | must_fail/1, must_succeed/1, must_succeed_without_residue/1, | |
| 11 | ||
| 12 | run_time_type_check_mode/1, | |
| 13 | turn_on_run_time_type_checks/0,turn_off_run_time_type_checks/0, | |
| 14 | ||
| 15 | get_module_list/1, | |
| 16 | ||
| 17 | perform_self_check/0, perform_self_check/1, | |
| 18 | perform_verbose_self_check/0, perform_verbose_self_check/1, | |
| 19 | display_self_checks/0, | |
| 20 | ||
| 21 | disable_interaction_on_errors/0, | |
| 22 | ||
| 23 | % time_out_call/2, time_out_with_factor_call/3, time_out_call/1, % now in tools_timeout | |
| 24 | ||
| 25 | check_deterministic/1, check_det/1, | |
| 26 | ||
| 27 | list_skeleton/1, | |
| 28 | ||
| 29 | self_checks_exist/0, | |
| 30 | check_eq/2, | |
| 31 | check_eqeq/2 | |
| 32 | ||
| 33 | ]). | |
| 34 | ||
| 35 | :- use_module(debugging_calls). | |
| 36 | %:- disable_debugging_calls. | |
| 37 | ||
| 38 | :- use_module(module_information,[module_info/2]). | |
| 39 | :- module_info(group,infrastructure). | |
| 40 | :- module_info(description,'This module provides predicates to define and run unit tests.'). | |
| 41 | ||
| 42 | :- use_module(tools_printing,[format_with_colour/4]). | |
| 43 | ||
| 44 | % first code which asserts pre-, post-conditions and self-checks | |
| 45 | ||
| 46 | % first a copy of print_error; so that this bit of self-check does not rely on other modules | |
| 47 | my_print_error(Error) :- | |
| 48 | (var(Error) | |
| 49 | -> print_message(error,'_') | |
| 50 | ; write(user_error,'! '),write_term(user_error,Error,[max_depth(50),numbervars(true)]),nl(user_error) | |
| 51 | ). | |
| 52 | ||
| 53 | my_portray_error(Query) :- portray_clause(user_error,Query). | |
| 54 | ||
| 55 | :- meta_predicate nonvar_call(0). | |
| 56 | :- dynamic pre_condition/2, post_condition/2. | |
| 57 | :- meta_predicate assert_pre(0,0). | |
| 58 | assert_pre(X,Pre) :- % print(adding_pre(X)),nl, | |
| 59 | ((nonvar_call(X),nonvar_call(Pre)) | |
| 60 | -> retractall(pre_condition(X,_)),assert(pre_condition(X,Pre)) | |
| 61 | ; my_print_error('### illegal variable(s) in: '), | |
| 62 | my_print_error(assert_pre(X,Pre)),fail | |
| 63 | ). | |
| 64 | :- meta_predicate assert_post(0,0). | |
| 65 | assert_post(X,Post) :- | |
| 66 | ((nonvar_call(X),nonvar_call(Post)) | |
| 67 | -> retractall(post_condition(X,_)),assert(post_condition(X,Post)) | |
| 68 | ; my_print_error('### illegal variable(s) in: '), | |
| 69 | my_print_error(assert_post(X,Post)),fail | |
| 70 | ). | |
| 71 | ||
| 72 | nonvar_call(M:P) :- !,nonvar(M),nonvar(P). | |
| 73 | nonvar_call(_). | |
| 74 | ||
| 75 | :- dynamic self_check/2. | |
| 76 | :- dynamic self_check_module/1. | |
| 77 | :- volatile self_check/2, self_check_module/1. % this means that self-check cannot be run in the compiled versions ! | |
| 78 | ||
| 79 | % used to check if there are self checks. if not, tcl/tk interface does not show the button | |
| 80 | self_checks_exist :- self_check(_,_). | |
| 81 | ||
| 82 | % has a strange behaviour; investigate :- meta_predicate self_check(:,*). | |
| 83 | ||
| 84 | ||
| 85 | :- load_files(library(system), [when(compile_time), imports([environ/2])]). | |
| 86 | :- if(environ(prob_release,true)). | |
| 87 | add_self_check(_,_) :- !. % comment in to not include self-checks in distribution | |
| 88 | :- endif. | |
| 89 | add_self_check(Module,X) :- | |
| 90 | (self_check_module(Module) -> true; | |
| 91 | otherwise -> assert(self_check_module(Module))), | |
| 92 | (nonvar(X) | |
| 93 | ? | -> (self_check(X,Module) -> true ; |
| 94 | otherwise -> assert(self_check(X,Module))); | |
| 95 | otherwise -> my_print_error('### trying to assert variable as self_check: '),my_print_error(X),fail | |
| 96 | ). | |
| 97 | ||
| 98 | ||
| 99 | :- meta_predicate assert_must_succeed_any(0). | |
| 100 | :- meta_predicate assert_must_succeed(0). | |
| 101 | :- meta_predicate assert_must_succeed_multiple(0). | |
| 102 | :- meta_predicate assert_must_fail(0). | |
| 103 | %:- meta_predicate kernel_waitflags:assert_must_abort_wf(0,*). | |
| 104 | ||
| 105 | assert_must_succeed_any(M:X) :- | |
| 106 | add_self_check(M,must_succeed(M:X)). | |
| 107 | assert_must_succeed(M:X) :- | |
| 108 | add_self_check(M,must_succeed_without_residue(M:X)). | |
| 109 | assert_must_succeed_multiple(M:X) :- | |
| 110 | add_self_check(M,must_succeed_multiple_without_residue(M:X)). | |
| 111 | assert_must_fail(M:X) :- | |
| 112 | add_self_check(M,must_fail(M:X)). | |
| 113 | ||
| 114 | ||
| 115 | % ------------------------ | |
| 116 | ||
| 117 | %:- use_module(gensym). % so that self-checks can make use of this module | |
| 118 | :- use_module(debug). | |
| 119 | :- use_module(tools_printing). | |
| 120 | %:- use_module(typechecker). % so that self-checks can make use of this module | |
| 121 | :- use_module(error_manager). | |
| 122 | :- use_module(junit_tests). | |
| 123 | :- use_module(library(lists)). | |
| 124 | :- use_module(tools_meta,[call_residue/2,safe_numbervars/3]). | |
| 125 | ||
| 126 | /* Example use: | |
| 127 | ||
| 128 | :- assert_pre(user:b_fd_type(_G,_L,_U),true). | |
| 129 | :- assert_post(user:b_fd_type(G,L,U),(atomic(G),(integer(L),integer(U)))). | |
| 130 | ||
| 131 | */ | |
| 132 | ||
| 133 | % avoid dependency on tools | |
| 134 | print_message(X) :- print_message(informational,X). | |
| 135 | ||
| 136 | ||
| 137 | ||
| 138 | /* some auxilary predicates that can be used for pre,post conditions: */ | |
| 139 | ||
| 140 | % used in some pre- and post-conditions | |
| 141 | list_skeleton(X) :- | |
| 142 | (nonvar(X),list_skel2(X) -> true | |
| 143 | ; (my_print_error('### not list skeleton: '), my_print_error(X),fail)). | |
| 144 | list_skel2([]). | |
| 145 | list_skel2([_H|T]) :- nonvar(T), list_skel2(T). | |
| 146 | ||
| 147 | ||
| 148 | ||
| 149 | :- dynamic run_time_type_check_mode/1. | |
| 150 | run_time_type_check_mode(on). | |
| 151 | ||
| 152 | turn_on_run_time_type_checks :- | |
| 153 | retract(run_time_type_check_mode(_)), | |
| 154 | assert(run_time_type_check_mode(on)). | |
| 155 | ||
| 156 | turn_off_run_time_type_checks :- | |
| 157 | retract(run_time_type_check_mode(_)), | |
| 158 | assert(run_time_type_check_mode(off)). | |
| 159 | ||
| 160 | ||
| 161 | /* ===================================================== */ | |
| 162 | ||
| 163 | :- dynamic prepost_no_error_so_far/0. | |
| 164 | ||
| 165 | prepost_no_error_so_far. % :- fail. | |
| 166 | /* as errors are now displayed by error_manager, no need for interaction ?? */ | |
| 167 | ||
| 168 | disable_interaction_on_errors :- | |
| 169 | retractall(prepost_no_error_so_far). | |
| 170 | ||
| 171 | ||
| 172 | /* ===================================================== */ | |
| 173 | ||
| 174 | :- register_debugging_call pp_mnf(*), pp_cll(*), mnf(*), mnf(-,*), det_call(*). | |
| 175 | :- meta_predicate pp_mnf(0), pp_cll(0), mnf(0), mnf(-,0), det_call(0). | |
| 176 | :- meta_predicate mnf_call(0), mnf_call_with_pp(-,0), prepost_mnf_call(0). | |
| 177 | :- meta_predicate prepost_call(0). | |
| 178 | ||
| 179 | pp_mnf(X) :- prepost_mnf_call(X). | |
| 180 | pp_cll(X) :- prepost_call(X). | |
| 181 | mnf(X) :- mnf_call(X). | |
| 182 | mnf(ProgramPoint,X) :- mnf_call_with_pp(ProgramPoint,X). | |
| 183 | ||
| 184 | ||
| 185 | /* ===================================================== */ | |
| 186 | ||
| 187 | ||
| 188 | :- use_module(library(timeout)). | |
| 189 | :- meta_predicate check_exception_call(0). | |
| 190 | :- meta_predicate rt_timeout_call(0). | |
| 191 | ||
| 192 | rt_timeout_call(Call) :- run_time_type_check_mode(off),!,check_exception_call(Call). | |
| 193 | rt_timeout_call(Call) :- time_out(check_exception_call(Call),5000,TimeOutRes), | |
| 194 | (TimeOutRes = success -> true ; inc_error_count, add_error(self_check,'### TIMEOUT: ',Call),fail). | |
| 195 | ||
| 196 | % just catch exceptions and print them nicely | |
| 197 | check_exception_call(X) :- | |
| 198 | on_exception(Error, call(X), | |
| 199 | ( write('! EXCEPTION: '),nl, | |
| 200 | write('! '),print_numbervars(X),nl, | |
| 201 | write('! '),write_term(Error,[max_depth(20),numbervars(true)]),nl,nl, | |
| 202 | throw(Error)) ). | |
| 203 | ||
| 204 | print_numbervars(X) :- safe_numbervars(X,0,_), print(X),fail. | |
| 205 | print_numbervars(_). | |
| 206 | ||
| 207 | prepost_call(X) :- | |
| 208 | /* print(pre(X)),nl, */ | |
| 209 | (verify_pre(X) -> true ; my_print_error(verify_pre_failed(X))), | |
| 210 | rt_timeout_call(X), | |
| 211 | /* print(post(X)),nl, */ | |
| 212 | (verify_post(X) -> true ; my_print_error(verify_post_failed(X))). | |
| 213 | ||
| 214 | verify_pre(Call) :- | |
| 215 | (run_time_type_check_mode(off) -> true | |
| 216 | ; | |
| 217 | (pre_condition(Call,Pre) | |
| 218 | ->( (\+(rt_timeout_call(Pre)) | |
| 219 | -> (get_predicate_arity(Call,Pred,Arity), | |
| 220 | add_error(verify_pre,'### PRE-CONDITION ERROR OCCURRED: ',Pred/Arity), | |
| 221 | add_error(verify_pre,'### CALL: ',Call),nl, | |
| 222 | prepost_user_interaction | |
| 223 | ) | |
| 224 | ; (true) | |
| 225 | ) | |
| 226 | ) | |
| 227 | ; (get_predicate_arity(Call,Pred,Arity), | |
| 228 | add_error(verify_pre,'### No PRE-CONDITION for ',Pred/Arity), | |
| 229 | print_term_summary(Call), | |
| 230 | prepost_user_interaction ) | |
| 231 | )). | |
| 232 | ||
| 233 | verify_post(Call) :- | |
| 234 | (run_time_type_check_mode(off) -> true | |
| 235 | ; | |
| 236 | (post_condition(Call,Post) | |
| 237 | ->( (\+(rt_timeout_call(Post)) | |
| 238 | -> (get_predicate_arity(Call,Pred,Arity), | |
| 239 | add_error(verify_post,'### POST-CONDITION ERROR OCCURRED: ',Pred/Arity), | |
| 240 | add_error(verify_post,'### CALL: ',Call),nl, | |
| 241 | prepost_user_interaction | |
| 242 | ) | |
| 243 | ; (true) | |
| 244 | ) | |
| 245 | ) | |
| 246 | ; (get_predicate_arity(Call,Pred,Arity), | |
| 247 | add_error(verify_post,'### No POST-CONDITION for ',Pred/Arity), | |
| 248 | prepost_user_interaction ) | |
| 249 | )). | |
| 250 | ||
| 251 | ||
| 252 | prepost_user_interaction :- prepost_no_error_so_far,!, | |
| 253 | my_print_error('### => Stop at next error (y/n/halt/trace) => '), | |
| 254 | read(Answer), | |
| 255 | (Answer='y' -> true | |
| 256 | ; Answer='halt' -> halt | |
| 257 | ; Answer='trace' -> trace | |
| 258 | ; retract(prepost_no_error_so_far)). | |
| 259 | prepost_user_interaction. | |
| 260 | ||
| 261 | ||
| 262 | get_predicate_arity(':'(Module,Call),Res,Arity) :- !,Res=Module:Pred, | |
| 263 | functor(Call,Pred,Arity). | |
| 264 | get_predicate_arity(Call,Pred,Arity) :- | |
| 265 | functor(Call,Pred,Arity). | |
| 266 | ||
| 267 | /* ===================================================== */ | |
| 268 | ||
| 269 | prepost_mnf_call(X) :- % print(prepost_mnf_call(X)),nl, | |
| 270 | (run_time_type_check_mode(off) | |
| 271 | -> call(X) | |
| 272 | ; if(prepost_call(X),true, | |
| 273 | (add_error(mnf,'### WARNING CALL HAS FAILED: ',X), | |
| 274 | print_call(X), | |
| 275 | prepost_user_interaction, | |
| 276 | fail) | |
| 277 | ) | |
| 278 | ). | |
| 279 | ||
| 280 | mnf_call(X) :- | |
| 281 | (run_time_type_check_mode(off) | |
| 282 | -> call(X) | |
| 283 | ; if(call(X),true, | |
| 284 | (add_error(mnf,'### WARNING CALL HAS FAILED: ',X), | |
| 285 | print_call(X), | |
| 286 | prepost_user_interaction, | |
| 287 | fail) | |
| 288 | ) | |
| 289 | ). | |
| 290 | ||
| 291 | print_call(X) :- | |
| 292 | print('### Call: '),print_quoted_with_max_depth(X,10),nl, | |
| 293 | print('### Summary: '),print_term_summary(X),nl, | |
| 294 | print('### Predicate: '), | |
| 295 | (X = ':'(M,C) -> (print(M),print(':')) ; C=X), | |
| 296 | functor(C,F,N), | |
| 297 | print(F), print('/'), print(N),nl. | |
| 298 | ||
| 299 | ||
| 300 | mnf_call_with_pp(ProgramPoint,X) :- | |
| 301 | (run_time_type_check_mode(off) | |
| 302 | -> call(X) | |
| 303 | ; if(rt_timeout_call(X),true, | |
| 304 | (add_error(mnf,'### WARNING CALL HAS FAILED: ',(X,ProgramPoint)), | |
| 305 | print_call(X), | |
| 306 | print('### at program point:'),print(ProgramPoint),nl, | |
| 307 | prepost_user_interaction, | |
| 308 | fail) | |
| 309 | ) | |
| 310 | ). | |
| 311 | ||
| 312 | :- volatile found_det_sol/4. | |
| 313 | :- dynamic found_det_sol/4. | |
| 314 | :- meta_predicate mnf_det(0). | |
| 315 | ||
| 316 | mnf_det(X) :- | |
| 317 | (run_time_type_check_mode(off) | |
| 318 | -> call(X) | |
| 319 | ; (get_functor_module(X,Module,F,Arity), | |
| 320 | retractall(found_det_sol(F,Arity,Module,_)), /* cannot be nested for same predicate !*/ | |
| 321 | copy_term(X,CopyX), | |
| 322 | mnf_call(X), | |
| 323 | (found_det_sol(F,Arity,Module,Previous) -> | |
| 324 | (add_error(mnf,'### WARNING CALL HAS MULTIPLE SOLUTIONS: ',CopyX),nl, | |
| 325 | print('### Solution 1: '),print_quoted_with_max_depth(Previous,60),nl,nl, | |
| 326 | print('### Solution 2: '),print_quoted_with_max_depth(X,60),nl,nl, | |
| 327 | prepost_user_interaction) | |
| 328 | ; assert(found_det_sol(F,Arity,Module,X)) | |
| 329 | ) | |
| 330 | ) | |
| 331 | ). | |
| 332 | ||
| 333 | % det_call(';'(X=a,X=b)). | |
| 334 | get_functor_module(Module:Call,Module,F,Arity) :- !, functor(Call,F,Arity). | |
| 335 | get_functor_module(Call,unknown,F,Arity) :- functor(Call,F,Arity). | |
| 336 | ||
| 337 | :- meta_predicate force_det_call(0). | |
| 338 | det_call(X) :- | |
| 339 | (run_time_type_check_mode(off) | |
| 340 | -> call(X) | |
| 341 | ; force_det_call(X) | |
| 342 | ). | |
| 343 | ||
| 344 | :- meta_predicate residue_check_call(0). | |
| 345 | residue_check_call(X) :- | |
| 346 | copy_term(X,CX), | |
| 347 | call_residue(X,CallResidue), | |
| 348 | (CallResidue=[] -> true | |
| 349 | ; add_error(must_succeed_without_residue,'### Call has residue: ',X), | |
| 350 | add_error(must_succeed_without_residue,'### Residue: ',CallResidue), | |
| 351 | safe_numbervars(CX,0,_), | |
| 352 | format('### Original call: ~w~n',[CX]) | |
| 353 | ). | |
| 354 | ||
| 355 | force_det_call(X) :- | |
| 356 | get_functor_module(X,Module,F,Arity), | |
| 357 | retractall(found_det_sol(F,Arity,Module,_)), /* cannot be nested for same predicate !*/ | |
| 358 | copy_term(X,CopyX), | |
| 359 | %print(det_call(X)),nl, | |
| 360 | residue_check_call(X), % was rt_timeout_call(X) | |
| 361 | (found_det_sol(F,Arity,Module,Previous) -> | |
| 362 | (add_error(mnf,'### WARNING CALL HAS MULTIPLE SOLUTIONS: ',CopyX),nl, | |
| 363 | print('### Solution 1: '),print_quoted_with_max_depth(Previous,60),nl,nl, | |
| 364 | print('### Solution 2: '),print_quoted_with_max_depth(X,60),nl,nl, | |
| 365 | prepost_user_interaction) | |
| 366 | ; assert(found_det_sol(F,Arity,Module,X)) | |
| 367 | ). | |
| 368 | ||
| 369 | /* ===================================================== */ | |
| 370 | ||
| 371 | :- meta_predicate must_fail(0). | |
| 372 | must_fail(X) :- | |
| 373 | copy_term(X,Y), | |
| 374 | rt_timeout_call(X),!, | |
| 375 | (safe_numbervars(Y,0,_) -> true ; true), | |
| 376 | inc_error_count, | |
| 377 | add_error(must_fail,'### Unit Test Failed !!! Call succeeded: ',Y), | |
| 378 | my_print_error('### The call: '), | |
| 379 | my_portray_error(Y), | |
| 380 | my_print_error('### should have failed but succeeded with:'), | |
| 381 | my_print_error(X). | |
| 382 | must_fail(_X). | |
| 383 | ||
| 384 | ||
| 385 | :- meta_predicate must_succeed(0). | |
| 386 | ||
| 387 | must_succeed(X) :- %print(must_suceed(X)),nl, | |
| 388 | \+ rt_timeout_call(X),!, | |
| 389 | (safe_numbervars(X,0,_) -> true ; true), | |
| 390 | inc_error_count, | |
| 391 | add_error(must_succeed,'### Unit Test Failed !!! Call failed: ',X). | |
| 392 | %my_print_error('### The call: '), | |
| 393 | %my_print_error(X), | |
| 394 | %my_print_error('### should have succeeded but failed !'). | |
| 395 | must_succeed(_X). % :- print(ok_must_succeed(_X)),nl. | |
| 396 | ||
| 397 | :- volatile found_must_succeed_sol/1, found_id/1. | |
| 398 | :- dynamic found_must_succeed_sol/1, found_id/1. | |
| 399 | found_id(0). | |
| 400 | get_found_id(Nr) :- retract(found_id(Nr)), N1 is Nr+1, assert(found_id(N1)). | |
| 401 | reset_found_id :- retractall(found_must_succeed_sol(_)), | |
| 402 | retractall(found_id(_)), assert(found_id(0)). | |
| 403 | ||
| 404 | :- meta_predicate must_succeed_without_residue(0). | |
| 405 | must_succeed_without_residue(X) :- get_found_id(ID), | |
| 406 | must_succeed(residue_check_call(X)), | |
| 407 | retractall(found_must_succeed_sol(ID)), | |
| 408 | %residue_check_call(X), | |
| 409 | (found_must_succeed_sol(ID) | |
| 410 | -> (add_error(must_succeed_without_residue,'### Self-Check has multiple solutions: ',X), | |
| 411 | inc_error_count, | |
| 412 | !) | |
| 413 | ; assert(found_must_succeed_sol(ID)),fail | |
| 414 | ). | |
| 415 | must_succeed_without_residue(_). | |
| 416 | ||
| 417 | :- meta_predicate must_succeed_multiple_without_residue(0). | |
| 418 | :- public must_succeed_multiple_without_residue/1. % used by assert_must_succeed_multiple | |
| 419 | must_succeed_multiple_without_residue(X) :- get_found_id(ID), | |
| 420 | must_succeed(X), | |
| 421 | retractall(found_must_succeed_sol(ID)), | |
| 422 | call_residue(X,CallResidue), | |
| 423 | (CallResidue=[] -> true | |
| 424 | ; add_error(must_succeed_multiple_without_residue,'### Self-Check has residue: ',X), | |
| 425 | add_error(must_succeed_multiple_without_residue,'### Residue: ',CallResidue), | |
| 426 | inc_error_count | |
| 427 | ), | |
| 428 | (found_must_succeed_sol(ID) | |
| 429 | -> (true,!) | |
| 430 | ; assert(found_must_succeed_sol(ID)),fail | |
| 431 | ). | |
| 432 | must_succeed_multiple_without_residue(X) :- | |
| 433 | inc_error_count, | |
| 434 | add_error(must_succeed_multiple_without_residue, | |
| 435 | '### Self-Check did not succeed multiple times: ',X). | |
| 436 | ||
| 437 | ||
| 438 | :- meta_predicate safe_call(0). | |
| 439 | ||
| 440 | safe_call(X) :- on_exception(Exception, | |
| 441 | call(X), | |
| 442 | (print(exception(X,Exception)),nl,nl, | |
| 443 | inc_error_count, | |
| 444 | add_error(safe_call,'### Exception occurred during self-check: ',X:Exception))). | |
| 445 | ||
| 446 | :- dynamic starttime/1. | |
| 447 | ||
| 448 | get_module_list(ML) :- findall(Module,self_check_module(Module),Modules), sort(Modules,ML). | |
| 449 | ||
| 450 | ||
| 451 | ||
| 452 | ||
| 453 | :- dynamic errors_in_module/2, current_module_under_test/1, tests_in_module/2. | |
| 454 | set_current_module(M) :- | |
| 455 | retractall(current_module_under_test(_)), | |
| 456 | assert(current_module_under_test(M)). | |
| 457 | inc_error_count :- current_module_under_test(Module),!, | |
| 458 | (retract(errors_in_module(Module,Nr)) -> true ; Nr=0), | |
| 459 | N1 is Nr+1, | |
| 460 | assert(errors_in_module(Module,N1)). | |
| 461 | inc_error_count :- print('No current module.'),nl. | |
| 462 | print_error_summary :- errors_in_module(Module,Nr), format('Module: ~w errors: ~w.~n',[Module,Nr]), fail. | |
| 463 | print_error_summary. | |
| 464 | print_summary :- findall(T,tests_in_module(_,T),NrTests), | |
| 465 | length(NrTests,NrModules), | |
| 466 | sumlist(NrTests,TotTests), | |
| 467 | format('Number of Tests: ~w in ~w modules~n',[TotTests,NrModules]). | |
| 468 | reset_error_summary :- | |
| 469 | retractall(errors_in_module(_,_)), | |
| 470 | retractall(tests_in_module(_,_)). | |
| 471 | ||
| 472 | check_module(Module,Results,Verbose) :- | |
| 473 | findall(testcase(Module,X), self_check(X,Module), Calls), | |
| 474 | length(Calls,Len), | |
| 475 | assert(tests_in_module(Module,Len)), | |
| 476 | %maplist(check_test_case, Calls, Results). | |
| 477 | check_test_cases(Calls,Results,0,Module,Verbose). | |
| 478 | ||
| 479 | check_test_cases([],[],Nr,Module,_Verbose) :- format('Number of unit tests run in ~w: ~w~n',[Module,Nr]). | |
| 480 | check_test_cases([H|T],[V|VT],Nr,Module,Verbose) :- | |
| 481 | N1 is Nr+1, | |
| 482 | (Verbose=silent -> true ; format('Running unit test ~w in module ~w~n',[N1,Module])), | |
| 483 | get_total_number_of_errors(NrBefore), (real_error_occurred -> AlreadyInErr=true ; AlreadyInErr=false), | |
| 484 | check_test_case(H,V,Verbose), | |
| 485 | get_total_number_of_errors(NrAfter), | |
| 486 | (NrBefore=NrAfter -> true | |
| 487 | ; AlreadyInErr=true -> true % we already have a previous unit test failure | |
| 488 | ; error_manager:test_error_occurred(Source) -> | |
| 489 | format_with_colour(user_error,[red,bold],'~n*** UNIT TEST ~w FAILED in module ~w (source: Source ~w)~n~n',[N1,Module,Source]) | |
| 490 | ; true), | |
| 491 | check_test_cases(T,VT,N1,Module,Verbose). | |
| 492 | ||
| 493 | check_test_case(testcase(Module,Call), Verdict,Verbose) :- | |
| 494 | set_error_context(self_check(Module,Call)), | |
| 495 | statistics(runtime,[T1,_]), | |
| 496 | (Verbose=verbose -> portray_clause(Call) ; true), | |
| 497 | safe_call(Call), | |
| 498 | flush_output, | |
| 499 | statistics(runtime,[T2,_]), | |
| 500 | Time is T2-T1, | |
| 501 | (Verbose=verbose -> format('Runtime for unit test: ~w ms~n',[Time]) ; Time>20 -> format('*~w ms*~n',[Time]) ; true), | |
| 502 | (Time>2000 -> format('Warning: long unit test: ~w ms in module ~w~n ~w~n',[Time,Module,Call]) ; true), | |
| 503 | (junit_mode(_) -> (get_all_errors_and_reset(Errors) -> V=error(Errors) | |
| 504 | ; otherwise -> V=pass) | |
| 505 | ; true), | |
| 506 | create_junit_result(Call,'Selfcheck', Module, Time, V, Verdict). | |
| 507 | ||
| 508 | ||
| 509 | perform_self_check(M) :- perform_self_check(M,normal). | |
| 510 | perform_self_check :- perform_self_check(_). | |
| 511 | perform_verbose_self_check :- perform_verbose_self_check(_). | |
| 512 | perform_verbose_self_check(M) :- perform_self_check(M,verbose). | |
| 513 | ||
| 514 | :- use_module(eventhandling,[announce_event/1]). | |
| 515 | perform_self_check(Module,Verbose) :- nl, reset_found_id, | |
| 516 | reset_error_summary, | |
| 517 | if(self_check_module(Module),true, my_print_error(illegal_module(Module))), | |
| 518 | set_current_module(Module), | |
| 519 | (Verbose=silent -> true ; format_with_colour(user_output,[blue],'~n~nPerforming unit tests for module ~w~n',[Module])), | |
| 520 | announce_event(start_unit_tests), | |
| 521 | flush_output, | |
| 522 | print('% '), | |
| 523 | retractall(starttime(_)), | |
| 524 | statistics(runtime,[Start,_]), assert(starttime(Start)), | |
| 525 | check_module(Module,TestResults,Verbose), | |
| 526 | print_junit(TestResults,Module), | |
| 527 | fail. | |
| 528 | perform_self_check(_,_) :- | |
| 529 | statistics(runtime,[End,_]), | |
| 530 | starttime(Start), Tot is End-Start, | |
| 531 | nl, print('Time: '), print(Tot), print(' ms'), | |
| 532 | nl, | |
| 533 | announce_event(stop_unit_tests), | |
| 534 | clear_error_context, | |
| 535 | print_summary, | |
| 536 | (error_manager:test_error_occurred(Source) | |
| 537 | -> format_with_colour(user_error,[red,bold],'~n! Unit tests FAILED !!!~n! Source ~w ~n',[Source]), | |
| 538 | print_error_summary, | |
| 539 | fail | |
| 540 | ; true), | |
| 541 | format_with_colour(user_output,[green],'~nUnit Tests Successful.~n',[]), | |
| 542 | flush_output. | |
| 543 | ||
| 544 | ||
| 545 | display_self_checks :- display_self_checks(_). | |
| 546 | ||
| 547 | /* self_check:display_self_checks */ | |
| 548 | display_self_checks(Module) :- | |
| 549 | self_check_module(Module), | |
| 550 | format_with_colour(user_output,[blue],'~n~nUnit Tests for Module ~w~n',[Module]), | |
| 551 | self_check(X,Module), | |
| 552 | portray_clause(X), | |
| 553 | fail. | |
| 554 | display_self_checks(_) :- nl. | |
| 555 | ||
| 556 | % ------------------------ | |
| 557 | :- meta_predicate check_deterministic(0). | |
| 558 | :- meta_predicate check_det(0). | |
| 559 | :- meta_predicate check_det2(0,-). | |
| 560 | ||
| 561 | :- dynamic det_counter/1. | |
| 562 | det_counter(0). | |
| 563 | check_deterministic(Call) :- | |
| 564 | retract(det_counter(X)), X1 is X+1, assert(det_counter(X1)), | |
| 565 | check_det2(Call,X). | |
| 566 | check_det(Call) :- check_deterministic(Call). | |
| 567 | ||
| 568 | :- volatile calling/1. | |
| 569 | :- dynamic calling/1. | |
| 570 | check_det2(Call,X) :- assert(calling(X)), | |
| 571 | call(Call), | |
| 572 | (retract(calling(X)) -> true | |
| 573 | ; nl, | |
| 574 | print('### Call has multiple solutions: '),nl, | |
| 575 | print('### '), print(Call),nl, | |
| 576 | nl | |
| 577 | ). | |
| 578 | check_det2(Call,X) :- (retract(calling(X)) -> print(fails(Call)),nl ; fail). | |
| 579 | ||
| 580 | ||
| 581 | % ------------------------ | |
| 582 | ||
| 583 | check_eq(A,B) :- (A=B -> true ; format(user_error,'! Not unifiable:~n ~w~n ~w~n',[A,B])). | |
| 584 | check_eqeq(A,B) :- (A==B -> true ; format(user_error,'! Not identical:~n ~w~n ~w~n',[A,B])). |