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-2025, University of Amsterdam 7 VU University Amsterdam 8 CWI, Amsterdam 9 SWI-Prolog Solutions b.v. 10 All rights reserved. 11 12 Redistribution and use in source and binary forms, with or without 13 modification, are permitted provided that the following conditions 14 are met: 15 16 1. Redistributions of source code must retain the above copyright 17 notice, this list of conditions and the following disclaimer. 18 19 2. Redistributions in binary form must reproduce the above copyright 20 notice, this list of conditions and the following disclaimer in 21 the documentation and/or other materials provided with the 22 distribution. 23 24 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 25 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 26 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 27 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 28 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 29 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 30 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 31 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 32 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 33 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 34 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 35 POSSIBILITY OF SUCH DAMAGE. 36*/ 37 38:- module(plunit, 39 [ set_test_options/1, % +Options 40 begin_tests/1, % +Name 41 begin_tests/2, % +Name, +Options 42 end_tests/1, % +Name 43 run_tests/0, % Run all tests 44 run_tests/1, % +Tests 45 run_tests/2, % +Tests, +Options 46 load_test_files/1, % +Options 47 running_tests/0, % Prints currently running test 48 current_test/5, % ?Unit,?Test,?Line,?Body,?Options 49 current_test_unit/2, % ?Unit,?Options 50 test_report/1 % +What 51 ]).
59:- autoload(library(statistics), [call_time/2]). 60:- autoload(library(apply), 61 [maplist/3, include/3, maplist/2, foldl/4, partition/4]). 62:- autoload(library(lists), [member/2, append/2, flatten/2, append/3]). 63:- autoload(library(option), [ option/3, option/2, select_option/3 ]). 64:- autoload(library(ordsets), [ord_intersection/3]). 65:- autoload(library(error), [must_be/2, domain_error/2]). 66:- autoload(library(aggregate), [aggregate_all/3]). 67:- autoload(library(streams), [with_output_to/3]). 68:- autoload(library(ansi_term), [ansi_format/3]). 69:- if(exists_source(library(time))). 70:- autoload(library(time), [call_with_time_limit/2]). 71:- endif. 72 73:- public 74 unit_module/2. 75 76:- meta_predicate 77 valid_options(, ), 78 count(, ). 79 80 /******************************* 81 * CONDITIONAL COMPILATION * 82 *******************************/ 83 84swi :- catch(current_prolog_flag(dialect, swi), _, fail). 85sicstus :- catch(current_prolog_flag(dialect, sicstus), _, fail). 86 87throw_error(Error_term,Impldef) :- 88 throw(error(Error_term,context(Impldef,_))). 89 90:- set_prolog_flag(generate_debug_info, false). 91current_test_flag(optimise, Value) => 92 current_prolog_flag(optimise, Value). 93current_test_flag(occurs_check, Value) => 94 ( current_prolog_flag(plunit_occurs_check, Value0) 95 -> Value = Value0 96 ; current_prolog_flag(occurs_check, Value) 97 ). 98current_test_flag(Name, Value), atom(Name) => 99 atom_concat(plunit_, Name, Flag), 100 current_prolog_flag(Flag, Value). 101current_test_flag(Name, Value), var(Name) => 102 global_test_option(Opt, _, _Type, _Default), 103 functor(Opt, Name, 1), 104 current_test_flag(Name, Value). 105 106set_test_flag(Name, Value) :- 107 Opt =.. [Name, Value], 108 global_test_option(Opt), 109 !, 110 atom_concat(plunit_, Name, Flag), 111 set_prolog_flag(Flag, Value). 112set_test_flag(Name, _) :- 113 domain_error(test_flag, Name). 114 115current_test_flags(Flags) :- 116 findall(Flag, current_test_flag(Flag), Flags). 117 118current_test_flag(Opt) :- 119 current_test_flag(Name, Value), 120 Opt =.. [Name, Value]. 121 122% ensure expansion to avoid tracing 123goal_expansion(forall(C,A), 124 \+ (C, \+ A)). 125goal_expansion(current_module(Module,File), 126 module_property(Module, file(File))). 127 128 129 /******************************* 130 * IMPORTS * 131 *******************************/ 132 133:- initialization init_flags. 134 135init_flags :- 136 ( global_test_option(Option, _Value, Type, Default), 137 Default \== (-), 138 Option =.. [Name,_], 139 atom_concat(plunit_, Name, Flag), 140 flag_type(Type, FlagType), 141 create_prolog_flag(Flag, Default, [type(FlagType), keep(true)]), 142 fail 143 ; true 144 ). 145 146flag_type(boolean, FlagType) => FlagType = boolean. 147flag_type(Type, FlagType), Type = oneof(Atoms), maplist(atom, Atoms) => 148 FlagType = Type. 149flag_type(oneof(_), FlagType) => FlagType = term. 150flag_type(positive_integer, FlagType) => FlagType = integer. 151flag_type(number, FlagType) => FlagType = float.
never, always, normal (only if not optimised)manual, make
or make(all).tty or log. tty uses terminal
control to overwrite successful tests, allowing the
user to see the currently running tests and output
from failed tests. This is the default of the output
is a tty. log prints a full log of the executed
tests and their result and is intended for non-interactive
usage.always, emit all output as it is produced, if never,
suppress all output and if on_failure, emit the output
if the test fails.occurs_check flag during
testing.true (default =false), cleanup report at the end
of run_tests/1. Used to improve cooperation with
memory debuggers such as dmalloc.203set_test_options(Options) :- 204 flatten([Options], List), 205 maplist(set_test_option, List). 206 207set_test_option(sto(true)) => 208 print_message(warning, plunit(sto(true))). 209set_test_option(jobs(Jobs)) => 210 must_be(positive_integer, Jobs), 211 set_test_option_flag(jobs(Jobs)). 212set_test_option(Option), 213 compound(Option), global_test_option(Option) => 214 set_test_option_flag(Option). 215set_test_option(Option) => 216 domain_error(option, Option). 217 218global_test_option(Opt) :- 219 global_test_option(Opt, Value, Type, _Default), 220 must_be(Type, Value). 221 222global_test_option(load(Load), Load, oneof([never,always,normal]), normal). 223global_test_option(output(Cond), Cond, oneof([always,on_failure]), on_failure). 224global_test_option(format(Feedback), Feedback, oneof([tty,log]), tty). 225global_test_option(silent(Silent), Silent, boolean, false). 226global_test_option(show_blocked(Blocked), Blocked, boolean, false). 227global_test_option(run(When), When, oneof([manual,make,make(all)]), make). 228global_test_option(occurs_check(Mode), Mode, oneof([false,true,error]), -). 229global_test_option(cleanup(Bool), Bool, boolean, true). 230global_test_option(jobs(Count), Count, positive_integer, 1). 231global_test_option(timeout(Number), Number, number, 3600). 232 233set_test_option_flag(Option) :- 234 Option =.. [Name, Value], 235 set_test_flag(Name, Value).
241loading_tests :- 242 current_test_flag(load, Load), 243 ( Load == always 244 -> true 245 ; Load == normal, 246 \+ current_test_flag(optimise, true) 247 ). 248 249 /******************************* 250 * MODULE * 251 *******************************/ 252 253:- thread_local 254 loading_unit/4. % Unit, Module, File, OldSource 255:- dynamic 256 current_unit/4, % Unit, Module, Context, Options 257 test_file_for/2. % ?TestFile, ?PrologFile
end_tests(UnitName).265begin_tests(Unit) :- 266 begin_tests(Unit, []). 267 268begin_tests(Unit, Options) :- 269 must_be(atom, Unit), 270 map_sto_option(Options, Options1), 271 valid_options(test_set_option, Options1), 272 make_unit_module(Unit, Name), 273 source_location(File, Line), 274 begin_tests(Unit, Name, File:Line, Options1). 275 276map_sto_option(Options0, Options) :- 277 select_option(sto(Mode), Options0, Options1), 278 !, 279 map_sto(Mode, Flag), 280 Options = [occurs_check(Flag)|Options1]. 281map_sto_option(Options, Options). 282 283map_sto(rational_trees, Flag) => Flag = false. 284map_sto(finite_trees, Flag) => Flag = true. 285map_sto(Mode, _) => domain_error(sto, Mode). 286 287 288:- if(swi). 289begin_tests(Unit, Name, File:Line, Options) :- 290 loading_tests, 291 !, 292 '$set_source_module'(Context, Context), 293 ( current_unit(Unit, Name, Context, Options) 294 -> true 295 ; retractall(current_unit(Unit, Name, _, _)), 296 assert(current_unit(Unit, Name, Context, Options)) 297 ), 298 '$set_source_module'(Old, Name), 299 '$declare_module'(Name, test, Context, File, Line, false), 300 discontiguous(Name:'unit test'/4), 301 '$set_predicate_attribute'(Name:'unit test'/4, trace, false), 302 discontiguous(Name:'unit body'/2), 303 asserta(loading_unit(Unit, Name, File, Old)). 304begin_tests(Unit, Name, File:_Line, _Options) :- 305 '$set_source_module'(Old, Old), 306 asserta(loading_unit(Unit, Name, File, Old)). 307 308:- else. 309 310% we cannot use discontiguous as a goal in SICStus Prolog. 311 312userterm_expansion((:- begin_tests(Set)), 313 [ (:- begin_tests(Set)), 314 (:- discontiguous(test/2)), 315 (:- discontiguous('unit body'/2)), 316 (:- discontiguous('unit test'/4)) 317 ]). 318 319begin_tests(Unit, Name, File:_Line, Options) :- 320 loading_tests, 321 !, 322 ( current_unit(Unit, Name, _, Options) 323 -> true 324 ; retractall(current_unit(Unit, Name, _, _)), 325 assert(current_unit(Unit, Name, -, Options)) 326 ), 327 asserta(loading_unit(Unit, Name, File, -)). 328begin_tests(Unit, Name, File:_Line, _Options) :- 329 asserta(loading_unit(Unit, Name, File, -)). 330 331:- endif.
340end_tests(Unit) :- 341 loading_unit(StartUnit, _, _, _), 342 !, 343 ( Unit == StartUnit 344 -> once(retract(loading_unit(StartUnit, _, _, Old))), 345 '$set_source_module'(_, Old) 346 ; throw_error(context_error(plunit_close(Unit, StartUnit)), _) 347 ). 348end_tests(Unit) :- 349 throw_error(context_error(plunit_close(Unit, -)), _).
354:- if(swi). 355 356unit_module(Unit, Module) :- 357 atom_concat('plunit_', Unit, Module). 358 359make_unit_module(Unit, Module) :- 360 unit_module(Unit, Module), 361 ( current_module(Module), 362 \+ current_unit(_, Module, _, _), 363 predicate_property(Module:H, _P), 364 \+ predicate_property(Module:H, imported_from(_M)) 365 -> throw_error(permission_error(create, plunit, Unit), 366 'Existing module') 367 ; true 368 ). 369 370:- else. 371 372:- dynamic 373 unit_module_store/2. 374 375unit_module(Unit, Module) :- 376 unit_module_store(Unit, Module), 377 !. 378 379make_unit_module(Unit, Module) :- 380 prolog_load_context(module, Module), 381 assert(unit_module_store(Unit, Module)). 382 383:- endif. 384 385 /******************************* 386 * EXPANSION * 387 *******************************/
test(Name, Options) :- Body into a clause for
'unit test'/4 and 'unit body'/2.394expand_test(Name, Options0, Body, 395 [ 'unit test'(Name, Line, Options, Module:'unit body'(Id, Vars)), 396 ('unit body'(Id, Vars) :- !, Body) 397 ]) :- 398 source_location(_File, Line), 399 prolog_load_context(module, Module), 400 ( prolog_load_context(variable_names, Bindings) 401 -> true 402 ; Bindings = [] 403 ), 404 atomic_list_concat([Name, '@line ', Line], Id), 405 term_variables(Options0, OptionVars0), sort(OptionVars0, OptionVars), 406 term_variables(Body, BodyVars0), sort(BodyVars0, BodyVars), 407 ord_intersection(OptionVars, BodyVars, VarList), 408 Vars =.. [vars|VarList], 409 ( is_list(Options0) % allow for single option without list 410 -> Options1 = Options0 411 ; Options1 = [Options0] 412 ), 413 maplist(expand_option(Bindings), Options1, Options2), 414 join_true_options(Options2, Options3), 415 map_sto_option(Options3, Options4), 416 valid_options(test_option, Options4), 417 valid_test_mode(Options4, Options). 418 419expand_option(_, Var, _) :- 420 var(Var), 421 !, 422 throw_error(instantiation_error,_). 423expand_option(Bindings, Cmp, true(Cond)) :- 424 cmp(Cmp), 425 !, 426 var_cmp(Bindings, Cmp, Cond). 427expand_option(_, error(X), throws(error(X, _))) :- !. 428expand_option(_, exception(X), throws(X)) :- !. % SICStus 4 compatibility 429expand_option(_, error(F,C), throws(error(F,C))) :- !. % SICStus 4 compatibility 430expand_option(_, true, true(true)) :- !. 431expand_option(_, O, O). 432 433cmp(_ == _). 434cmp(_ = _). 435cmp(_ =@= _). 436cmp(_ =:= _). 437 438var_cmp(Bindings, Expr, cmp(Name, Expr)) :- 439 arg(_, Expr, Var), 440 var(Var), 441 member(Name=V, Bindings), 442 V == Var, 443 !. 444var_cmp(_, Expr, Expr). 445 446join_true_options(Options0, Options) :- 447 partition(true_option, Options0, True, Rest), 448 True \== [], 449 !, 450 maplist(arg(1), True, Conds0), 451 flatten(Conds0, Conds), 452 Options = [true(Conds)|Rest]. 453join_true_options(Options, Options). 454 455true_option(true(_)). 456 457valid_test_mode(Options0, Options) :- 458 include(test_mode, Options0, Tests), 459 ( Tests == [] 460 -> Options = [true([true])|Options0] 461 ; Tests = [_] 462 -> Options = Options0 463 ; throw_error(plunit(incompatible_options, Tests), _) 464 ). 465 466test_mode(true(_)). 467test_mode(all(_)). 468test_mode(set(_)). 469test_mode(fail). 470test_mode(throws(_)).
475expand(end_of_file, _) :- 476 loading_unit(Unit, _, _, _), 477 !, 478 end_tests(Unit), % warn? 479 fail. 480expand((:-end_tests(_)), _) :- 481 !, 482 fail. 483expand(_Term, []) :- 484 \+ loading_tests. 485expand((test(Name) :- Body), Clauses) :- 486 !, 487 expand_test(Name, [], Body, Clauses). 488expand((test(Name, Options) :- Body), Clauses) :- 489 !, 490 expand_test(Name, Options, Body, Clauses). 491expand(test(Name), _) :- 492 !, 493 throw_error(existence_error(body, test(Name)), _). 494expand(test(Name, _Options), _) :- 495 !, 496 throw_error(existence_error(body, test(Name)), _). 497 498:- multifile 499 system:term_expansion/2. 500 501systemterm_expansion(Term, Expanded) :- 502 ( loading_unit(_, _, File, _) 503 -> source_location(ThisFile, _), 504 ( File == ThisFile 505 -> true 506 ; source_file_property(ThisFile, included_in(File, _)) 507 ), 508 expand(Term, Expanded) 509 ). 510 511 512 /******************************* 513 * OPTIONS * 514 *******************************/
523valid_options(Pred, Options) :- 524 must_be(list, Options), 525 verify_options(Options, Pred). 526 527verify_options([], _). 528verify_options([H|T], Pred) :- 529 ( call(Pred, H) 530 -> verify_options(T, Pred) 531 ; throw_error(domain_error(Pred, H), _) 532 ). 533 534valid_options(Pred, Options0, Options, Rest) :- 535 must_be(list, Options0), 536 partition(Pred, Options0, Options, Rest).
test(Name, Options).542test_option(Option) :- 543 test_set_option(Option), 544 !. 545test_option(true(_)). 546test_option(fail). 547test_option(throws(_)). 548test_option(all(_)). 549test_option(set(_)). 550test_option(nondet). 551test_option(fixme(_)). 552test_option(forall(X)) :- 553 must_be(callable, X). 554test_option(timeout(Seconds)) :- 555 must_be(number, Seconds).
begin_tests(Name,
Options).562test_set_option(blocked(X)) :- 563 must_be(ground, X). 564test_set_option(condition(X)) :- 565 must_be(callable, X). 566test_set_option(setup(X)) :- 567 must_be(callable, X). 568test_set_option(cleanup(X)) :- 569 must_be(callable, X). 570test_set_option(occurs_check(V)) :- 571 must_be(oneof([false,true,error]), V). 572test_set_option(concurrent(V)) :- 573 must_be(boolean, V), 574 print_message(informational, plunit(concurrent)). 575test_set_option(timeout(Seconds)) :- 576 must_be(number, Seconds). 577 578 /******************************* 579 * UTIL * 580 *******************************/ 581 582:- meta_predicate 583 reify_tmo(, , ), 584 reify(, ), 585 capture_output(,), 586 capture_output(,,), 587 got_messages(,).
591:- if(current_predicate(call_with_time_limit/2)). 592reify_tmo(Goal, Result, Options) :- 593 option(timeout(Time), Options), 594 Time > 0, 595 !, 596 reify(call_with_time_limit(Time, Goal), Result0), 597 ( Result0 = throw(time_limit_exceeded) 598 -> Result = throw(time_limit_exceeded(Time)) 599 ; Result = Result0 600 ). 601:- endif. 602reify_tmo(Goal, Result, _Options) :- 603 reify(Goal, Result).
true, false or
throw(E).
610reify(Goal, Result) :-
611 ( catch(Goal, E, true)
612 -> ( var(E)
613 -> Result = true
614 ; Result = throw(E)
615 )
616 ; Result = false
617 ).626capture_output(Goal, Output) :- 627 current_test_flag(output, OutputMode), 628 capture_output(Goal, Output, [output(OutputMode)]). 629 630capture_output(Goal, Msgs-Output, Options) :- 631 option(output(How), Options, always), 632 ( How == always 633 -> call(Goal), 634 Msgs = false % irrelavant 635 ; with_output_to(string(Output), got_messages(Goal, Msgs), 636 [ capture([user_output, user_error]), 637 color(true) 638 ]) 639 ).
643got_messages(Goal, Result) :- 644 ( current_prolog_flag(on_warning, status) 645 ; current_prolog_flag(on_error, status) 646 ), !, 647 nb_delete(plunit_got_message), 648 setup_call_cleanup( 649 asserta(( user:thread_message_hook(_Term, Kind, _Lines) :- 650 got_message(Kind), fail), Ref), 651 Goal, 652 erase(Ref)), 653 ( nb_current(plunit_got_message, true) 654 -> Result = true 655 ; Result = false 656 ). 657got_messages(Goal, false) :- 658 call(Goal). 659 660:- public got_message/1. 661got_message(warning) :- 662 current_prolog_flag(on_warning, status), !, 663 nb_setval(plunit_got_message, true). 664got_message(error) :- 665 current_prolog_flag(on_error, status), !, 666 nb_setval(plunit_got_message, true). 667 668 669 /******************************* 670 * RUNNING TOPLEVEL * 671 *******************************/ 672 673:- dynamic 674 output_streams/2, % Output, Error 675 test_count/1, % Count 676 passed/5, % Unit, Test, Line, Det, Time 677 failed/5, % Unit, Test, Line, Reason, Time 678 timeout/5, % Unit, Test, Line, Limit, Time 679 failed_assertion/7, % Unit, Test, Line, ALoc, STO, Reason, Goal 680 blocked/4, % Unit, Test, Line, Reason 681 fixme/5, % Unit, Test, Line, Reason, Status 682 running/5, % Unit, Test, Line, STO, Thread 683 forall_failures/2. % Nth, Failures
The predicate run_tests/2 is synchronized. Concurrent testing may be achieved using the relevant options. See set_test_options/1. Options are passed to set_test_options/1. In addition the following options are processed:
715run_tests :- 716 run_tests(all). 717 718run_tests(Set) :- 719 run_tests(Set, []). 720 721run_tests(all, Options) :- 722 !, 723 findall(Unit, current_test_unit(Unit,_), Units), 724 run_tests(Units, Options). 725run_tests(Set, Options) :- 726 valid_options(global_test_option, Options, Global, Rest), 727 current_test_flags(Old), 728 setup_call_cleanup( 729 set_test_options(Global), 730 ( flatten([Set], List), 731 maplist(runnable_tests, List, Units), 732 with_mutex(plunit, run_tests_sync(Units, Rest)) 733 ), 734 set_test_options(Old)). 735 736run_tests_sync(Units0, Options) :- 737 cleanup, 738 count_tests(Units0, Units, Count), 739 asserta(test_count(Count)), 740 save_output_state, 741 setup_call_cleanup( 742 setup_trap_assertions(Ref), 743 call_time(setup_jobs_and_run_units(Count, Units, Summary, Options), 744 Time), 745 report_and_cleanup(Ref, Time, Options)), 746 ( option(summary(Summary), Options) 747 -> true 748 ; test_summary_passed(Summary) % fail if some test failed 749 ). 750 751setup_jobs_and_run_units(Count, Units, Summary, Options) :- 752 setup_call_cleanup( 753 setup_jobs(Count), 754 ( run_units(Units, Options), 755 test_summary(_All, Summary) 756 ), 757 cleanup_jobs).
764report_and_cleanup(Ref, Time, Options) :-
765 cleanup_trap_assertions(Ref),
766 report(Time, Options),
767 cleanup_after_test.
774run_units(Units, _Options) :-
775 maplist(schedule_unit, Units),
776 job_wait(_).Unit:Tests lists, where
blocked tests or tests whose condition fails are already removed.
Each test in Tests is a term @(Test,Line), which serves as a
unique identifier of the test.785:- det(runnable_tests/2). 786runnable_tests(Spec, Unit:RunnableTests) :- 787 unit_from_spec(Spec, Unit, Tests, Module, UnitOptions), 788 ( option(blocked(Reason), UnitOptions) 789 -> info(plunit(blocked(unit(Unit, Reason)))), 790 RunnableTests = [] 791 ; \+ condition(Module, unit(Unit), UnitOptions) 792 -> RunnableTests = [] 793 ; var(Tests) 794 -> findall(TestID, 795 runnable_test(Unit, _Test, Module, TestID), 796 RunnableTests) 797 ; flatten([Tests], TestList), 798 findall(TestID, 799 ( member(Test, TestList), 800 runnable_test(Unit,Test,Module, TestID) 801 ), 802 RunnableTests) 803 ). 804 805runnable_test(Unit, Name, Module, @(Test,Line)) :- 806 current_test(Unit, Name, Line, _Body, TestOptions), 807 ( option(blocked(Reason), TestOptions) 808 -> Test = blocked(Name, Reason) 809 ; condition(Module, test(Unit,Name,Line), TestOptions), 810 Test = Name 811 ). 812 813unit_from_spec(Unit0:Tests0, Unit, Tests, Module, Options), atom(Unit0) => 814 Unit = Unit0, 815 Tests = Tests0, 816 ( current_unit(Unit, Module, _Supers, Options) 817 -> true 818 ; throw_error(existence_error(unit_test, Unit), _) 819 ). 820unit_from_spec(Unit0, Unit, _, Module, Options), atom(Unit0) => 821 Unit = Unit0, 822 ( current_unit(Unit, Module, _Supers, Options) 823 -> true 824 ; throw_error(existence_error(unit_test, Unit), _) 825 ).
forall(Generator, Test) counts
as a single test. During the execution, the concrete tests of the
forall are considered "sub tests".833count_tests(Units0, Units, Count) :- 834 count_tests(Units0, Units, 0, Count). 835 836count_tests([], T, C0, C) => 837 T = [], 838 C = C0. 839count_tests([_:[]|T0], T, C0, C) => 840 count_tests(T0, T, C0, C). 841count_tests([Unit:Tests|T0], T, C0, C) => 842 partition(is_blocked, Tests, Blocked, Use), 843 maplist(assert_blocked(Unit), Blocked), 844 ( Use == [] 845 -> count_tests(T0, T, C0, C) 846 ; length(Use, N), 847 C1 is C0+N, 848 T = [Unit:Use|T1], 849 count_tests(T0, T1, C1, C) 850 ). 851 852is_blocked(@(blocked(_,_),_)) => true. 853is_blocked(_) => fail. 854 855assert_blocked(Unit, @(blocked(Test, Reason), Line)) => 856 assert(blocked(Unit, Test, Line, Reason)).
863run_unit(_Unit:[]) => 864 true. 865run_unit(Unit:Tests) => 866 unit_module(Unit, Module), 867 unit_options(Unit, UnitOptions), 868 ( setup(Module, unit(Unit), UnitOptions) 869 -> begin_unit(Unit), 870 call_time(run_unit_2(Unit, Tests), Time), 871 test_summary(Unit, Summary), 872 end_unit(Unit, Summary.put(time, Time)), 873 cleanup(Module, UnitOptions) 874 ; job_info(end(unit(Unit, _{error:setup_failed}))) 875 ). 876 877begin_unit(Unit) :- 878 job_info(begin(unit(Unit))), 879 job_feedback(informational, begin(Unit)). 880 881end_unit(Unit, Summary) :- 882 job_info(end(unit(Unit, Summary))), 883 job_feedback(informational, end(Unit, Summary)). 884 885run_unit_2(Unit, Tests) :- 886 forall(member(Test, Tests), 887 run_test(Unit, Test)). 888 889 890unit_options(Unit, Options) :- 891 current_unit(Unit, _Module, _Supers, Options). 892 893 894cleanup :- 895 set_flag(plunit_test, 1), 896 retractall(output_streams(_,_)), 897 retractall(test_count(_)), 898 retractall(passed(_, _, _, _, _)), 899 retractall(failed(_, _, _, _, _)), 900 retractall(timeout(_, _, _, _, _)), 901 retractall(failed_assertion(_, _, _, _, _, _, _)), 902 retractall(blocked(_, _, _, _)), 903 retractall(fixme(_, _, _, _, _)), 904 retractall(running(_,_,_,_,_)), 905 retractall(forall_failures(_,_)). 906 907cleanup_after_test :- 908 ( current_test_flag(cleanup, true) 909 -> cleanup 910 ; true 911 ).
918run_tests_in_files(Files) :- 919 findall(Unit, unit_in_files(Files, Unit), Units), 920 ( Units == [] 921 -> true 922 ; run_tests(Units) 923 ). 924 925unit_in_files(Files, Unit) :- 926 is_list(Files), 927 !, 928 member(F, Files), 929 absolute_file_name(F, Source, 930 [ file_type(prolog), 931 access(read), 932 file_errors(fail) 933 ]), 934 unit_file(Unit, Source). 935 936 937 /******************************* 938 * HOOKING MAKE/0 * 939 *******************************/
945make_run_tests(Files) :- 946 current_test_flag(run, When), 947 ( When == make 948 -> run_tests_in_files(Files) 949 ; When == make(all) 950 -> run_tests 951 ; true 952 ). 953 954 /******************************* 955 * ASSERTION HANDLING * 956 *******************************/ 957 958:- if(swi). 959 960:- dynamic prolog:assertion_failed/2. 961 962setup_trap_assertions(Ref) :- 963 asserta((prolog:assertion_failed(Reason, Goal) :- 964 test_assertion_failed(Reason, Goal)), 965 Ref). 966 967cleanup_trap_assertions(Ref) :- 968 erase(Ref). 969 970test_assertion_failed(Reason, Goal) :- 971 thread_self(Me), 972 running(Unit, Test, Line, Progress, Me), 973 ( catch(get_prolog_backtrace(10, Stack), _, fail), 974 assertion_location(Stack, AssertLoc) 975 -> true 976 ; AssertLoc = unknown 977 ), 978 report_failed_assertion(Unit:Test, Line, AssertLoc, 979 Progress, Reason, Goal), 980 assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc, 981 Progress, Reason, Goal)). 982 983assertion_location(Stack, File:Line) :- 984 append(_, [AssertFrame,CallerFrame|_], Stack), 985 prolog_stack_frame_property(AssertFrame, 986 predicate(prolog_debug:assertion/1)), 987 !, 988 prolog_stack_frame_property(CallerFrame, location(File:Line)). 989 990report_failed_assertion(UnitTest, Line, AssertLoc, 991 Progress, Reason, Goal) :- 992 print_message( 993 error, 994 plunit(failed_assertion(UnitTest, Line, AssertLoc, 995 Progress, Reason, Goal))). 996 997:- else. 998 999setup_trap_assertions(_). 1000cleanup_trap_assertions(_). 1001 1002:- endif. 1003 1004 1005 /******************************* 1006 * RUNNING A TEST * 1007 *******************************/
1013run_test(Unit, @(Test,Line)) :-
1014 unit_module(Unit, Module),
1015 Module:'unit test'(Test, Line, TestOptions, Body),
1016 unit_options(Unit, UnitOptions),
1017 run_test(Unit, Test, Line, UnitOptions, TestOptions, Body).forall(Generator, Test)1023run_test(Unit, Name, Line, UnitOptions, Options, Body) :- 1024 option(forall(Generator), Options), 1025 !, 1026 unit_module(Unit, Module), 1027 start_test(Unit, @(Name,Line), Nth), 1028 State = state(0), 1029 call_time(forall(Module:Generator, % may become concurrent 1030 ( incr_forall(State, I), 1031 run_test_once6(Unit, Name, 1032 forall(Generator, Nth-I), Line, 1033 UnitOptions, Options, Body) 1034 )), 1035 Time), 1036 arg(1, State, Generated), 1037 progress(Unit:Name, Nth, forall(end, Nth, Generated), Time). 1038run_test(Unit, Name, Line, UnitOptions, Options, Body) :- 1039 start_test(Unit, @(Name,Line), Nth), 1040 run_test_once6(Unit, Name, Nth, Line, UnitOptions, Options, Body). 1041 1042start_test(_Unit, _TestID, Nth) :- 1043 flag(plunit_test, Nth, Nth+1). 1044 1045incr_forall(State, I) :- 1046 arg(1, State, I0), 1047 I is I0+1, 1048 nb_setarg(1, State, I).
timeout and occurs_check option (Global -> Unit -> Test).1055run_test_once6(Unit, Name, Progress, Line, UnitOptions, Options, Body) :- 1056 current_test_flag(timeout, DefTimeOut), 1057 current_test_flag(occurs_check, DefOccurs), 1058 inherit_option(timeout, Options, [UnitOptions], DefTimeOut, Options1), 1059 inherit_option(occurs_check, Options1, [UnitOptions], DefOccurs, Options2), 1060 run_test_once(Unit, Name, Progress, Line, Options2, Body). 1061 1062inherit_option(Name, Options0, Chain, Default, Options) :- 1063 Term =.. [Name,_Value], 1064 ( option(Term, Options0) 1065 -> Options = Options0 1066 ; member(Opts, Chain), 1067 option(Term, Opts) 1068 -> Options = [Term|Options0] 1069 ; Default == (-) 1070 -> Options = Options0 1071 ; Opt =.. [Name,Default], 1072 Options = [Opt|Options0] 1073 ).
1080run_test_once(Unit, Name, Progress, Line, Options, Body) :- 1081 option(occurs_check(Occurs), Options), 1082 !, 1083 begin_test(Unit, Name, Line, Progress), 1084 current_prolog_flag(occurs_check, Old), 1085 setup_call_cleanup( 1086 set_prolog_flag(occurs_check, Occurs), 1087 capture_output(run_test_6(Unit, Name, Line, Options, Body, Result), 1088 Output), 1089 set_prolog_flag(occurs_check, Old)), 1090 end_test(Unit, Name, Line, Progress), 1091 report_result(Result, Progress, Output, Options). 1092run_test_once(Unit, Name, Progress, Line, Options, Body) :- 1093 begin_test(Unit, Name, Line, Progress), 1094 capture_output(run_test_6(Unit, Name, Line, Options, Body, Result), 1095 Output), 1096 end_test(Unit, Name, Line, Progress), 1097 report_result(Result, Progress, Output, Options).
1101:- det(report_result/4). 1102report_result(failure(Unit, Name, Line, How, Time), 1103 Progress, Output, Options) => 1104 failure(Unit, Name, Progress, Line, How, Time, Output, Options). 1105report_result(success(Unit, Name, Line, Determinism, Time), 1106 Progress, Output, Options) => 1107 success(Unit, Name, Progress, Line, Determinism, Time, Output, Options). 1108report_result(setup_failed(Unit, Name, Line, Time, Output, Result), 1109 Progress, _Output, Options) => 1110 failure(Unit, Name, Progress, Line, 1111 setup_failed(Result), Time, Output, Options).
time_limit_exceeded(Limit)cmp_error(Cmp, E)wrong_answer(Cmp)wrong_error(Expect, E)wrong_answer(Expected, Bindings)1133run_test_6(Unit, Name, Line, Options, Body, Result) :- 1134 option(setup(Setup), Options), 1135 !, 1136 unit_module(Unit, Module), 1137 capture_output(call_time(reify(call_ex(Module, Setup), SetupResult), 1138 Time), 1139 Output), 1140 ( SetupResult == true 1141 -> run_test_7(Unit, Name, Line, Options, Body, Result), 1142 cleanup(Module, Options) 1143 ; Result = setup_failed(Unit, Name, Line, Time, Output, SetupResult) 1144 ). 1145run_test_6(Unit, Name, Line, Options, Body, Result) :- 1146 unit_module(Unit, Module), 1147 run_test_7(Unit, Name, Line, Options, Body, Result), 1148 cleanup(Module, Options).
1157run_test_7(Unit, Name, Line, Options, Body, Result) :- 1158 option(true(Cmp), Options), % expected success 1159 !, 1160 unit_module(Unit, Module), 1161 call_time(reify_tmo(call_det(Module:Body, Det), Result0, Options), Time), 1162 ( Result0 == true 1163 -> cmp_true(Cmp, Module, CmpResult), 1164 ( CmpResult == [] 1165 -> Result = success(Unit, Name, Line, Det, Time) 1166 ; Result = failure(Unit, Name, Line, CmpResult, Time) 1167 ) 1168 ; Result0 == false 1169 -> Result = failure(Unit, Name, Line, failed, Time) 1170 ; Result0 = throw(E2) 1171 -> Result = failure(Unit, Name, Line, throw(E2), Time) 1172 ). 1173run_test_7(Unit, Name, Line, Options, Body, Result) :- 1174 option(fail, Options), % expected failure 1175 !, 1176 unit_module(Unit, Module), 1177 call_time(reify_tmo(Module:Body, Result0, Options), Time), 1178 ( Result0 == true 1179 -> Result = failure(Unit, Name, Line, succeeded, Time) 1180 ; Result0 == false 1181 -> Result = success(Unit, Name, Line, true, Time) 1182 ; Result0 = throw(E) 1183 -> Result = failure(Unit, Name, Line, throw(E), Time) 1184 ). 1185run_test_7(Unit, Name, Line, Options, Body, Result) :- 1186 option(throws(Expect), Options), % Expected error 1187 !, 1188 unit_module(Unit, Module), 1189 call_time(reify_tmo(Module:Body, Result0, Options), Time), 1190 ( Result0 == true 1191 -> Result = failure(Unit, Name, Line, no_exception, Time) 1192 ; Result0 == false 1193 -> Result = failure(Unit, Name, Line, failed, Time) 1194 ; Result0 = throw(E) 1195 -> ( match_error(Expect, E) 1196 -> Result = success(Unit, Name, Line, true, Time) 1197 ; Result = failure(Unit, Name, Line, wrong_error(Expect, E), Time) 1198 ) 1199 ). 1200run_test_7(Unit, Name, Line, Options, Body, Result) :- 1201 option(all(Answer), Options), % all(Bindings) 1202 !, 1203 nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result). 1204run_test_7(Unit, Name, Line, Options, Body, Result) :- 1205 option(set(Answer), Options), % set(Bindings) 1206 !, 1207 nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
1213nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :- 1214 unit_module(Unit, Module), 1215 result_vars(Expected, Vars), 1216 ( call_time(reify_tmo(findall(Vars, Module:Body, Bindings), 1217 Result0, Options), Time) 1218 -> ( Result0 == true 1219 -> ( nondet_compare(Expected, Bindings, Unit, Name, Line) 1220 -> Result = success(Unit, Name, Line, true, Time) 1221 ; Result = failure(Unit, Name, Line, 1222 [wrong_answer(Expected, Bindings)], Time) 1223 ) 1224 ; Result0 = throw(E) 1225 -> Result = failure(Unit, Name, Line, throw(E), Time) 1226 ) 1227 ). 1228 1229cmp_true([], _, L) => 1230 L = []. 1231cmp_true([Cmp|T], Module, L) => 1232 E = error(Formal,_), 1233 cmp_goal(Cmp, Goal), 1234 ( catch(Module:Goal, E, true) 1235 -> ( var(Formal) 1236 -> cmp_true(T, Module, L) 1237 ; L = [cmp_error(Cmp,E)|L1], 1238 cmp_true(T, Module, L1) 1239 ) 1240 ; L = [wrong_answer(Cmp)|L1], 1241 cmp_true(T, Module, L1) 1242 ). 1243 1244cmp_goal(cmp(_Var, Expr), Goal) => Goal = Expr. 1245cmp_goal(Expr, Goal) => Goal = Expr.
v(V1, ...) containing all variables at the left
side of the comparison operator on Expected.
1253result_vars(Expected, Vars) :-
1254 arg(1, Expected, CmpOp),
1255 arg(1, CmpOp, Vars).1265nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :- 1266 cmp(Cmp, _Vars, Op, Values), 1267 cmp_list(Values, Bindings, Op). 1268nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :- 1269 cmp(Cmp, _Vars, Op, Values0), 1270 sort(Bindings0, Bindings), 1271 sort(Values0, Values), 1272 cmp_list(Values, Bindings, Op). 1273 1274cmp_list([], [], _Op). 1275cmp_list([E0|ET], [V0|VT], Op) :- 1276 call(Op, E0, V0), 1277 cmp_list(ET, VT, Op).
1281cmp(Var == Value, Var, ==, Value). 1282cmp(Var =:= Value, Var, =:=, Value). 1283cmp(Var = Value, Var, =, Value). 1284:- if(swi). 1285cmp(Var =@= Value, Var, =@=, Value). 1286:- else. 1287:- if(sicstus). 1288cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@= 1289:- endif. 1290:- endif.
true if Goal left
no choicepoints and false otherwise.1298:- if((swi;sicstus)). 1299call_det(Goal, Det) :- 1300 call_cleanup(Goal,Det0=true), 1301 ( var(Det0) -> Det = false ; Det = true ). 1302:- else. 1303call_det(Goal, true) :- 1304 call(Goal). 1305:- endif.
1312match_error(Expect, Rec) :-
1313 subsumes_term(Expect, Rec).1326setup(Module, Context, Options) :- 1327 option(setup(Setup), Options), 1328 !, 1329 capture_output(reify(call_ex(Module, Setup), Result), Output), 1330 ( Result == true 1331 -> true 1332 ; print_message(error, 1333 plunit(error(setup, Context, Output, Result))), 1334 fail 1335 ). 1336setup(_,_,_).
1342condition(Module, Context, Options) :- 1343 option(condition(Cond), Options), 1344 !, 1345 capture_output(reify(call_ex(Module, Cond), Result), Output), 1346 ( Result == true 1347 -> true 1348 ; Result == false 1349 -> fail 1350 ; print_message(error, 1351 plunit(error(condition, Context, Output, Result))), 1352 fail 1353 ). 1354condition(_, _, _).
1361call_ex(Module, Goal) :-
1362 Module:(expand_goal(Goal, GoalEx),
1363 GoalEx).1370cleanup(Module, Options) :- 1371 option(cleanup(Cleanup), Options, true), 1372 ( catch(call_ex(Module, Cleanup), E, true) 1373 -> ( var(E) 1374 -> true 1375 ; print_message(warning, E) 1376 ) 1377 ; print_message(warning, goal_failed(Cleanup, '(cleanup handler)')) 1378 ). 1379 1380success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :- 1381 memberchk(fixme(Reason), Options), 1382 !, 1383 ( ( Det == true 1384 ; memberchk(nondet, Options) 1385 ) 1386 -> progress(Unit:Name, Progress, fixme(passed), Time), 1387 Ok = passed 1388 ; progress(Unit:Name, Progress, fixme(nondet), Time), 1389 Ok = nondet 1390 ), 1391 flush_output(user_error), 1392 assert(fixme(Unit, Name, Line, Reason, Ok)). 1393success(Unit, Name, Progress, Line, _, Time, Output, Options) :- 1394 failed_assertion(Unit, Name, Line, _,Progress,_,_), 1395 !, 1396 failure(Unit, Name, Progress, Line, assertion, Time, Output, Options). 1397success(Unit, Name, Progress, Line, _, Time, Output, Options) :- 1398 Output = true-_, 1399 !, 1400 failure(Unit, Name, Progress, Line, message, Time, Output, Options). 1401success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :- 1402 assert(passed(Unit, Name, Line, Det, Time)), 1403 ( ( Det == true 1404 ; memberchk(nondet, Options) 1405 ) 1406 -> progress(Unit:Name, Progress, passed, Time) 1407 ; unit_file(Unit, File), 1408 print_message(warning, plunit(nondet(File:Line, Unit:Name, Progress))) 1409 ).
1416failure(Unit, Name, Progress, Line, _, Time, _Output, Options), 1417 memberchk(fixme(Reason), Options) => 1418 assert(fixme(Unit, Name, Line, Reason, failed)), 1419 progress(Unit:Name, Progress, fixme(failed), Time). 1420failure(Unit, Name, Progress, Line, time_limit_exceeded(Limit), Time, 1421 Output, Options) => 1422 assert_cyclic(timeout(Unit, Name, Line, Limit, Time)), 1423 progress(Unit:Name, Progress, timeout(Limit), Time), 1424 report_failure(Unit, Name, Progress, Line, timeout(Limit), Time, Output, Options). 1425failure(Unit, Name, Progress, Line, E, Time, Output, Options) => 1426 assert_cyclic(failed(Unit, Name, Line, E, Time)), 1427 progress(Unit:Name, Progress, failed, Time), 1428 report_failure(Unit, Name, Progress, Line, E, Time, Output, Options).
1438:- if(swi). 1439assert_cyclic(Term) :- 1440 acyclic_term(Term), 1441 !, 1442 assert(Term). 1443assert_cyclic(Term) :- 1444 Term =.. [Functor|Args], 1445 recorda(cyclic, Args, Id), 1446 functor(Term, _, Arity), 1447 length(NewArgs, Arity), 1448 Head =.. [Functor|NewArgs], 1449 assert(( :- recorded(_, Var, Id), Var = NewArgs)). 1450:- else. 1451:- if(sicstus). 1452:- endif. 1453assert_cyclic(Term) :- 1454 assert(Term). 1455:- endif. 1456 1457 1458 /******************************* 1459 * JOBS * 1460 *******************************/ 1461 1462:- if(current_prolog_flag(threads, true)). 1463 1464:- dynamic 1465 job_data/2, % Queue, Threads 1466 scheduled_unit/1. 1467 1468schedule_unit(_:[]) :- 1469 !. 1470schedule_unit(UnitAndTests) :- 1471 UnitAndTests = Unit:_Tests, 1472 job_data(Queue, _), 1473 !, 1474 assertz(scheduled_unit(Unit)), 1475 thread_send_message(Queue, unit(UnitAndTests)). 1476schedule_unit(Unit) :- 1477 run_unit(Unit).
1483setup_jobs(Count) :- 1484 ( current_test_flag(jobs, Jobs0), 1485 integer(Jobs0) 1486 -> true 1487 ; current_prolog_flag(cpu_count, Jobs0) 1488 ), 1489 Jobs is min(Count, Jobs0), 1490 Jobs > 1, 1491 !, 1492 message_queue_create(Q, [alias(plunit_jobs)]), 1493 length(TIDs, Jobs), 1494 foldl(create_plunit_job(Q), TIDs, 1, _), 1495 asserta(job_data(Q, TIDs)), 1496 job_feedback(informational, jobs(Jobs)). 1497setup_jobs(_) :- 1498 job_feedback(informational, jobs(1)). 1499 1500create_plunit_job(Q, TID, N, N1) :- 1501 N1 is N + 1, 1502 atom_concat(plunit_job_, N, Alias), 1503 thread_create(plunit_job(Q), TID, [alias(Alias)]). 1504 1505plunit_job(Queue) :- 1506 repeat, 1507 ( catch(thread_get_message(Queue, Job, 1508 [ timeout(10) 1509 ]), 1510 error(_,_), fail) 1511 -> job(Job), 1512 fail 1513 ; ! 1514 ). 1515 1516job(unit(Unit:Tests)) => 1517 run_unit(Unit:Tests). 1518job(test(Unit, Test)) => 1519 run_test(Unit, Test). 1520 1521cleanup_jobs :- 1522 retract(job_data(Queue, TIDSs)), 1523 !, 1524 message_queue_destroy(Queue), 1525 maplist(thread_join, TIDSs). 1526cleanup_jobs.
1532job_wait(Unit) :- 1533 thread_wait(\+ scheduled_unit(Unit), 1534 [ wait_preds([scheduled_unit/1]), 1535 timeout(1) 1536 ]), 1537 !. 1538job_wait(Unit) :- 1539 job_data(_Queue, TIDs), 1540 member(TID, TIDs), 1541 thread_property(TID, status(running)), 1542 !, 1543 job_wait(Unit). 1544job_wait(_). 1545 1546 1547job_info(begin(unit(Unit))) => 1548 print_message(silent, plunit(begin(Unit))). 1549job_info(end(unit(Unit, Summary))) => 1550 retractall(scheduled_unit(Unit)), 1551 print_message(silent, plunit(end(Unit, Summary))). 1552 1553:- else. % No jobs 1554 1555schedule_unit(Unit) :- 1556 run_unit(Unit). 1557 1558setup_jobs(_) :- 1559 print_message(silent, plunit(jobs(1))). 1560cleanup_jobs. 1561job_wait(_). 1562job_info(_). 1563 1564:- endif. 1565 1566 1567 1568 /******************************* 1569 * REPORTING * 1570 *******************************/
silent message:
plunit(begin(Unit:Test, File:Line, Progress))plunit(end(Unit:Test, File:Line, Progress))1583begin_test(Unit, Test, Line, Progress) :- 1584 thread_self(Me), 1585 assert(running(Unit, Test, Line, Progress, Me)), 1586 unit_file(Unit, File), 1587 test_count(Total), 1588 job_feedback(information, begin(Unit:Test, File:Line, Progress/Total)). 1589 1590end_test(Unit, Test, Line, Progress) :- 1591 thread_self(Me), 1592 retractall(running(_,_,_,_,Me)), 1593 unit_file(Unit, File), 1594 test_count(Total), 1595 job_feedback(information, end(Unit:Test, File:Line, Progress/Total)).
1601running_tests :- 1602 running_tests(Running), 1603 print_message(informational, plunit(running(Running))). 1604 1605running_tests(Running) :- 1606 test_count(Total), 1607 findall(running(Unit:Test, File:Line, Progress/Total, Thread), 1608 ( running(Unit, Test, Line, Progress, Thread), 1609 unit_file(Unit, File) 1610 ), Running).
1617current_test(Unit, Test, Line, Body, Options) :-
1618 current_unit(Unit, Module, _Supers, _UnitOptions),
1619 Module:'unit test'(Test, Line, Options, Body).1625current_test_unit(Unit, UnitOptions) :- 1626 current_unit(Unit, _Module, _Supers, UnitOptions). 1627 1628 1629count(Goal, Count) :- 1630 aggregate_all(count, Goal, Count).
1637test_summary(Unit, Summary) :- 1638 count(failed(Unit, _0Test, _0Line, _Reason, _0Time), Failed), 1639 count(timeout(Unit, _0Test, _0Line, _Limit, _0Time), Timeout), 1640 count(passed(Unit, _0Test, _0Line, _Det, _0Time), Passed), 1641 count(blocked(Unit, _0Test, _0Line, _0Reason), Blocked), 1642 count(fixme(Unit, _0Test, _0Line, _0Reason, _0How), Fixme), 1643 test_count(Total), 1644 Summary = plunit{total:Total, 1645 passed:Passed, 1646 failed:Failed, 1647 timeout:Timeout, 1648 blocked:Blocked, 1649 fixme:Fixme}. 1650 1651test_summary_passed(Summary) :- 1652 _{failed: 0} :< Summary.
1658report(Time, _Options) :- 1659 test_summary(_, Summary), 1660 print_message(silent, plunit(Summary)), 1661 _{ passed:Passed, 1662 failed:Failed, 1663 timeout:Timeout, 1664 blocked:Blocked, 1665 fixme:Fixme 1666 } :< Summary, 1667 ( Passed+Failed+Timeout+Blocked+Fixme =:= 0 1668 -> info(plunit(no_tests)) 1669 ; Failed+Timeout =:= 0 1670 -> report_blocked(Blocked), 1671 report_fixme, 1672 test_count(Total), 1673 info(plunit(all_passed(Total, Passed, Time))) 1674 ; report_blocked(Blocked), 1675 report_fixme, 1676 report_failed(Failed), 1677 report_timeout(Timeout), 1678 info(plunit(passed(Passed))), 1679 info(plunit(total_time(Time))) 1680 ). 1681 1682report_blocked(0) => 1683 true. 1684report_blocked(Blocked) => 1685 findall(blocked(Unit:Name, File:Line, Reason), 1686 ( blocked(Unit, Name, Line, Reason), 1687 unit_file(Unit, File) 1688 ), 1689 BlockedTests), 1690 info(plunit(blocked(Blocked, BlockedTests))). 1691 1692report_failed(Failed) :- 1693 print_message(error, plunit(failed(Failed))). 1694 1695report_timeout(Count) :- 1696 print_message(warning, plunit(timeout(Count))). 1697 1698report_fixme :- 1699 report_fixme(_,_,_). 1700 1701report_fixme(TuplesF, TuplesP, TuplesN) :- 1702 fixme(failed, TuplesF, Failed), 1703 fixme(passed, TuplesP, Passed), 1704 fixme(nondet, TuplesN, Nondet), 1705 print_message(informational, plunit(fixme(Failed, Passed, Nondet))). 1706 1707 1708fixme(How, Tuples, Count) :- 1709 findall(fixme(Unit, Name, Line, Reason, How), 1710 fixme(Unit, Name, Line, Reason, How), Tuples), 1711 length(Tuples, Count). 1712 1713report_failure(Unit, Name, Progress, Line, Error, 1714 Time, Output, _Options) => 1715 test_count(Total), 1716 job_feedback(error, failed(Unit:Name, Progress/Total, Line, 1717 Error, Time, Output)).
fixme for What.1725test_report(fixme) :- 1726 !, 1727 report_fixme(TuplesF, TuplesP, TuplesN), 1728 append([TuplesF, TuplesP, TuplesN], Tuples), 1729 print_message(informational, plunit(fixme(Tuples))). 1730test_report(What) :- 1731 throw_error(domain_error(report_class, What), _). 1732 1733 1734 /******************************* 1735 * INFO * 1736 *******************************/
1743unit_file(Unit, File), nonvar(Unit) => 1744 unit_file_(Unit, File), 1745 !. 1746unit_file(Unit, File) => 1747 unit_file_(Unit, File). 1748 1749unit_file_(Unit, File) :- 1750 current_unit(Unit, Module, _Context, _Options), 1751 module_property(Module, file(File)). 1752unit_file_(Unit, PlFile) :- 1753 test_file_for(TestFile, PlFile), 1754 module_property(Module, file(TestFile)), 1755 current_unit(Unit, Module, _Context, _Options). 1756 1757 1758 /******************************* 1759 * FILES * 1760 *******************************/
1767load_test_files(_Options) :- 1768 State = state(0,0), 1769 ( source_file(File), 1770 file_name_extension(Base, Old, File), 1771 Old \== plt, 1772 file_name_extension(Base, plt, TestFile), 1773 exists_file(TestFile), 1774 inc_arg(1, State), 1775 ( test_file_for(TestFile, File) 1776 -> true 1777 ; load_files(TestFile, 1778 [ if(changed), 1779 imports([]) 1780 ]), 1781 inc_arg(2, State), 1782 asserta(test_file_for(TestFile, File)) 1783 ), 1784 fail 1785 ; State = state(Total, Loaded), 1786 print_message(informational, plunit(test_files(Total, Loaded))) 1787 ). 1788 1789inc_arg(Arg, State) :- 1790 arg(Arg, State, N0), 1791 N is N0+1, 1792 nb_setarg(Arg, State, N). 1793 1794 1795 /******************************* 1796 * MESSAGES * 1797 *******************************/
print_message(Level, Term), where Level is one of silent or
informational (default).
1804info(Term) :-
1805 message_level(Level),
1806 print_message(Level, Term).forall(Gen,Test) set. Mapped
to forall(FTotal, FFailed)1823progress(UnitTest, _Progress, forall(end, Nth, FTotal), Time) => 1824 ( retract(forall_failures(Nth, FFailed)) 1825 -> true 1826 ; FFailed = 0 1827 ), 1828 test_count(Total), 1829 job_feedback(information, progress(UnitTest, forall(FTotal,FFailed), Nth/Total, Time)). 1830progress(UnitTest, Progress, Result, Time), Progress = forall(_Gen, Nth-_I) => 1831 with_mutex(plunit_forall_counter, 1832 update_forall_failures(Nth, Result)), 1833 test_count(Total), 1834 job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)). 1835progress(UnitTest, Progress, Result, Time) => 1836 test_count(Total), 1837 job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)). 1838 1839update_forall_failures(_Nth, passed) => 1840 true. 1841update_forall_failures(Nth, _) => 1842 ( retract(forall_failures(Nth, Failed0)) 1843 -> true 1844 ; Failed0 = 0 1845 ), 1846 Failed is Failed0+1, 1847 asserta(forall_failures(Nth, Failed)). 1848 1849message_level(Level) :- 1850 ( current_test_flag(silent, true) 1851 -> Level = silent 1852 ; Level = informational 1853 ). 1854 1855locationprefix(File:Line) --> 1856 !, 1857 [ url(File:Line), ':'-[], nl, ' ' ]. 1858locationprefix(test(Unit,_Test,Line)) --> 1859 !, 1860 { unit_file(Unit, File) }, 1861 locationprefix(File:Line). 1862locationprefix(unit(Unit)) --> 1863 !, 1864 [ 'PL-Unit: unit ~w: '-[Unit] ]. 1865locationprefix(FileLine) --> 1866 { throw_error(type_error(locationprefix,FileLine), _) }. 1867 1868:- discontiguous 1869 message//1. 1870:- '$hide'(message//1). 1871 1872message(error(context_error(plunit_close(Name, -)), _)) --> 1873 [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ]. 1874message(error(context_error(plunit_close(Name, Start)), _)) --> 1875 [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ]. 1876message(plunit(nondet(Pos, Test, Progress))) --> 1877 locationprefix(Pos), 1878 test_name(Test, Progress), 1879 [ ': Test succeeded with choicepoint'-[] ]. 1880message(error(plunit(incompatible_options, Tests), _)) --> 1881 [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ]. 1882message(plunit(sto(true))) --> 1883 [ 'Option sto(true) is ignored. See `occurs_check` option.'-[] ]. 1884message(plunit(test_files(Total, Loaded))) --> 1885 [ 'Found ~D .plt test files, loaded ~D'-[Total, Loaded] ]. 1886 1887 % Unit start/end 1888message(plunit(jobs(1))) --> 1889 !. 1890message(plunit(jobs(N))) --> 1891 [ 'Testing with ~D parallel jobs'-[N] ]. 1892message(plunit(begin(_Unit))) --> 1893 { tty_feedback }, 1894 !. 1895message(plunit(begin(Unit))) --> 1896 [ 'Start unit: ~w~n'-[Unit], flush ]. 1897message(plunit(end(_Unit, _Summary))) --> 1898 { tty_feedback }, 1899 !. 1900message(plunit(end(Unit, Summary))) --> 1901 ( {test_summary_passed(Summary)} 1902 -> [ 'End unit ~w: passed (~3f sec CPU)'-[Unit, Summary.time.cpu] ] 1903 ; [ ansi(error, 'End unit ~w: **FAILED (~3f sec CPU)', [Unit, Summary.time.cpu]) ] 1904 ). 1905message(plunit(blocked(unit(Unit, Reason)))) --> 1906 [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ]. 1907message(plunit(running([]))) --> 1908 !, 1909 [ 'PL-Unit: no tests running' ]. 1910message(plunit(running([One]))) --> 1911 !, 1912 [ 'PL-Unit: running ' ], 1913 running(One). 1914message(plunit(running(More))) --> 1915 !, 1916 [ 'PL-Unit: running tests:', nl ], 1917 running(More). 1918message(plunit(fixme([]))) --> !. 1919message(plunit(fixme(Tuples))) --> 1920 !, 1921 fixme_message(Tuples). 1922message(plunit(total_time(Time))) --> 1923 [ 'Test run completed'-[] ], 1924 test_time(Time). 1925 1926 % Blocked tests 1927message(plunit(blocked(1, Tests))) --> 1928 !, 1929 [ 'one test is blocked'-[] ], 1930 blocked_tests(Tests). 1931message(plunit(blocked(N, Tests))) --> 1932 [ '~D tests are blocked'-[N] ], 1933 blocked_tests(Tests). 1934 1935blocked_tests(Tests) --> 1936 { current_test_flag(show_blocked, true) }, 1937 !, 1938 [':'-[]], 1939 list_blocked(Tests). 1940blocked_tests(_) --> 1941 [ ' (use run_tests/2 with ', ansi(code, 'show_blocked(true)', []), 1942 ' for details)'-[] 1943 ]. 1944 1945list_blocked([]) --> !. 1946list_blocked([blocked(Unit:Test, Pos, Reason)|T]) --> 1947 [nl], 1948 locationprefix(Pos), 1949 test_name(Unit:Test, -), 1950 [ ': ~w'-[Reason] ], 1951 list_blocked(T). 1952 1953 % fail/success 1954message(plunit(no_tests)) --> 1955 !, 1956 [ 'No tests to run' ]. 1957message(plunit(all_passed(1, 1, Time))) --> 1958 !, 1959 [ 'test passed' ], 1960 test_time(Time). 1961message(plunit(all_passed(Total, Total, Time))) --> 1962 !, 1963 [ 'All ~D tests passed'-[Total] ], 1964 test_time(Time). 1965message(plunit(all_passed(Total, Count, Time))) --> 1966 !, 1967 { SubTests is Count-Total }, 1968 [ 'All ~D (+~D sub-tests) tests passed'- [Total, SubTests] ], 1969 test_time(Time). 1970 1971test_time(Time) --> 1972 { var(Time) }, !. 1973test_time(Time) --> 1974 [ ' in ~3f seconds (~3f cpu)'-[Time.wall, Time.cpu] ]. 1975 1976message(plunit(passed(Count))) --> 1977 !, 1978 [ '~D tests passed'-[Count] ]. 1979message(plunit(failed(0))) --> 1980 !, 1981 []. 1982message(plunit(failed(1))) --> 1983 !, 1984 [ '1 test failed'-[] ]. 1985message(plunit(failed(N))) --> 1986 [ '~D tests failed'-[N] ]. 1987message(plunit(timeout(0))) --> 1988 !, 1989 []. 1990message(plunit(timeout(N))) --> 1991 [ '~D tests timed out'-[N] ]. 1992message(plunit(fixme(0,0,0))) --> 1993 []. 1994message(plunit(fixme(Failed,0,0))) --> 1995 !, 1996 [ 'all ~D tests flagged FIXME failed'-[Failed] ]. 1997message(plunit(fixme(Failed,Passed,0))) --> 1998 [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ]. 1999message(plunit(fixme(Failed,Passed,Nondet))) --> 2000 { TotalPassed is Passed+Nondet }, 2001 [ 'FIXME: ~D failed; ~D passed; (~D nondet)'- 2002 [Failed, TotalPassed, Nondet] ]. 2003 2004message(plunit(begin(Unit:Test, _Location, Progress))) --> 2005 { tty_columns(SummaryWidth, _Margin), 2006 test_name_summary(Unit:Test, SummaryWidth, NameS), 2007 progress_string(Progress, ProgressS) 2008 }, 2009 ( { tty_feedback, 2010 tty_clear_to_eol(CE) 2011 } 2012 -> [ at_same_line, '\r[~w] ~w ..~w'-[ProgressS, NameS, 2013 CE], flush ] 2014 ; { jobs(_) } 2015 -> [ '[~w] ~w ..'-[ProgressS, NameS] ] 2016 ; [ '[~w] ~w ..'-[ProgressS, NameS], flush ] 2017 ). 2018message(plunit(end(_UnitTest, _Location, _Progress))) --> 2019 []. 2020message(plunit(progress(_UnitTest, Status, _Progress, _Time))) --> 2021 { Status = forall(_Gen,_NthI) 2022 ; Status == assertion 2023 }, 2024 !. 2025message(plunit(progress(Unit:Test, Status, Progress, Time))) --> 2026 { jobs(_), 2027 !, 2028 tty_columns(SummaryWidth, Margin), 2029 test_name_summary(Unit:Test, SummaryWidth, NameS), 2030 progress_string(Progress, ProgressS), 2031 progress_tag(Status, Tag, _Keep, Style) 2032 }, 2033 [ ansi(Style, '[~w] ~w ~`.t ~w (~3f sec)~*|', 2034 [ProgressS, NameS, Tag, Time.wall, Margin]) ]. 2035message(plunit(progress(_UnitTest, Status, _Progress, Time))) --> 2036 { tty_columns(_SummaryWidth, Margin), 2037 progress_tag(Status, Tag, _Keep, Style) 2038 }, 2039 [ at_same_line, ansi(Style, '~`.t ~w (~3f sec)~*|', 2040 [Tag, Time.wall, Margin]) ], 2041 ( { tty_feedback } 2042 -> [flush] 2043 ; [] 2044 ). 2045message(plunit(failed(Unit:Test, Progress, Line, Failure, _Time, Output))) --> 2046 { unit_file(Unit, File) }, 2047 locationprefix(File:Line), 2048 test_name(Unit:Test, Progress), 2049 [': '-[] ], 2050 failure(Failure), 2051 test_output(Output). 2052message(plunit(timeout(Unit:Test, Progress, Line, Limit, Output))) --> 2053 { unit_file(Unit, File) }, 2054 locationprefix(File:Line), 2055 test_name(Unit:Test, Progress), 2056 [': '-[] ], 2057 timeout(Limit), 2058 test_output(Output). 2059:- if(swi). 2060message(plunit(failed_assertion(Unit:Test, Line, AssertLoc, 2061 Progress, Reason, Goal))) --> 2062 { unit_file(Unit, File) }, 2063 locationprefix(File:Line), 2064 test_name(Unit:Test, Progress), 2065 [ ': assertion'-[] ], 2066 assertion_location(AssertLoc, File), 2067 assertion_reason(Reason), ['\n\t'], 2068 assertion_goal(Unit, Goal). 2069 2070assertion_location(File:Line, File) --> 2071 [ ' at line ~w'-[Line] ]. 2072assertion_location(File:Line, _) --> 2073 [ ' at ', url(File:Line) ]. 2074assertion_location(unknown, _) --> 2075 []. 2076 2077assertion_reason(fail) --> 2078 !, 2079 [ ' failed'-[] ]. 2080assertion_reason(Error) --> 2081 { message_to_string(Error, String) }, 2082 [ ' raised "~w"'-[String] ]. 2083 2084assertion_goal(Unit, Goal) --> 2085 { unit_module(Unit, Module), 2086 unqualify(Goal, Module, Plain) 2087 }, 2088 [ 'Assertion: ~p'-[Plain] ]. 2089 2090unqualify(Var, _, Var) :- 2091 var(Var), 2092 !. 2093unqualify(M:Goal, Unit, Goal) :- 2094 nonvar(M), 2095 unit_module(Unit, M), 2096 !. 2097unqualify(M:Goal, _, Goal) :- 2098 callable(Goal), 2099 predicate_property(M:Goal, imported_from(system)), 2100 !. 2101unqualify(Goal, _, Goal). 2102 2103test_output(Msgs-String) --> 2104 { nonvar(Msgs) }, 2105 !, 2106 test_output(String). 2107test_output("") --> []. 2108test_output(Output) --> 2109 [ ansi(code, '~N~s', [Output]) ]. 2110 2111:- endif. 2112 % Setup/condition errors 2113message(plunit(error(Where, Context, _Output, throw(Exception)))) --> 2114 locationprefix(Context), 2115 { message_to_string(Exception, String) }, 2116 [ 'error in ~w: ~w'-[Where, String] ]. 2117message(plunit(error(Where, Context, _Output, false))) --> 2118 locationprefix(Context), 2119 [ 'setup failed in ~w'-[Where] ]. 2120 2121 % delayed output 2122message(plunit(test_output(_, Output))) --> 2123 [ '~s'-[Output] ]. 2124 % Interrupts (SWI) 2125:- if(swi). 2126message(interrupt(begin)) --> 2127 { thread_self(Me), 2128 running(Unit, Test, Line, Progress, Me), 2129 !, 2130 unit_file(Unit, File), 2131 restore_output_state 2132 }, 2133 [ 'Interrupted test '-[] ], 2134 running(running(Unit:Test, File:Line, Progress, Me)), 2135 [nl], 2136 '$messages':prolog_message(interrupt(begin)). 2137message(interrupt(begin)) --> 2138 '$messages':prolog_message(interrupt(begin)). 2139:- endif. 2140 2141message(concurrent) --> 2142 [ 'concurrent(true) at the level of units is currently ignored.', nl, 2143 'See set_test_options/1 with jobs(Count) for concurrent testing.' 2144 ]. 2145 2146test_name(Name, forall(Generator, _Nth-I)/_Total) --> 2147 !, 2148 test_name(Name, -), 2149 [ ' (~d-th forall generator = '-[I], 2150 ansi(code, '~p', [Generator]), ')'-[] 2151 ]. 2152test_name(Name, _) --> 2153 !, 2154 [ 'test ', ansi(code, '~q', [Name]) ]. 2155 2156running(running(Unit:Test, File:Line, _Progress, Thread)) --> 2157 thread(Thread), 2158 [ '~q:~q at '-[Unit, Test], url(File:Line) ]. 2159running([H|T]) --> 2160 ['\t'], running(H), 2161 ( {T == []} 2162 -> [] 2163 ; [nl], running(T) 2164 ). 2165 2166thread(main) --> !. 2167thread(Other) --> 2168 [' [~w] '-[Other] ]. 2169 2170:- if(swi). 2171write_term(T, OPS) --> 2172 ['~W'-[T,OPS] ]. 2173:- else. 2174write_term(T, _OPS) --> 2175 ['~q'-[T]]. 2176:- endif. 2177 2178expected_got_ops_(Ex, E, OPS, Goals) --> 2179 [' Expected: '-[]], write_term(Ex, OPS), [nl], 2180 [' Got: '-[]], write_term(E, OPS), [], 2181 ( { Goals = [] } -> [] 2182 ; [nl, ' with: '-[]], write_term(Goals, OPS), [] 2183 ). 2184 2185 2186failure(List) --> 2187 { is_list(List) }, 2188 !, 2189 [ nl ], 2190 failures(List). 2191failure(Var) --> 2192 { var(Var) }, 2193 !, 2194 [ 'Unknown failure?' ]. 2195failure(succeeded(Time)) --> 2196 !, 2197 [ 'must fail but succeeded in ~2f seconds~n'-[Time] ]. 2198failure(wrong_error(Expected, Error)) --> 2199 !, 2200 { copy_term(Expected-Error, Ex-E, Goals), 2201 numbervars(Ex-E-Goals, 0, _), 2202 write_options(OPS) 2203 }, 2204 [ 'wrong error'-[], nl ], 2205 expected_got_ops_(Ex, E, OPS, Goals). 2206failure(wrong_answer(cmp(Var, Cmp))) --> 2207 { Cmp =.. [Op,Answer,Expected], 2208 !, 2209 copy_term(Expected-Answer, Ex-A, Goals), 2210 numbervars(Ex-A-Goals, 0, _), 2211 write_options(OPS) 2212 }, 2213 [ 'wrong answer for ', ansi(code, '~w', [Var]), 2214 ' (compared using ~w)'-[Op], nl ], 2215 expected_got_ops_(Ex, A, OPS, Goals). 2216failure(wrong_answer(Cmp)) --> 2217 { Cmp =.. [Op,Answer,Expected], 2218 !, 2219 copy_term(Expected-Answer, Ex-A, Goals), 2220 numbervars(Ex-A-Goals, 0, _), 2221 write_options(OPS) 2222 }, 2223 [ 'wrong answer (compared using ~w)'-[Op], nl ], 2224 expected_got_ops_(Ex, A, OPS, Goals). 2225failure(wrong_answer(CmpExpected, Bindings)) --> 2226 { ( CmpExpected = all(Cmp) 2227 -> Cmp =.. [_Op1,_,Expected], 2228 Got = Bindings, 2229 Type = all 2230 ; CmpExpected = set(Cmp), 2231 Cmp =.. [_Op2,_,Expected0], 2232 sort(Expected0, Expected), 2233 sort(Bindings, Got), 2234 Type = set 2235 ) 2236 }, 2237 [ 'wrong "~w" answer:'-[Type] ], 2238 [ nl, ' Expected: ~q'-[Expected] ], 2239 [ nl, ' Found: ~q'-[Got] ]. 2240:- if(swi). 2241failure(cmp_error(_Cmp, Error)) --> 2242 { message_to_string(Error, Message) }, 2243 [ 'Comparison error: ~w'-[Message] ]. 2244failure(throw(Error)) --> 2245 { Error = error(_,_), 2246 !, 2247 message_to_string(Error, Message) 2248 }, 2249 [ 'received error: ~w'-[Message] ]. 2250:- endif. 2251failure(message) --> 2252 !, 2253 [ 'Generated unexpected warning or error'-[] ]. 2254failure(setup_failed(throw(Error))) --> 2255 { Error = error(_,_), 2256 !, 2257 message_to_string(Error, Message) 2258 }, 2259 [ 'test setup goal raised error: ~w'-[Message] ]. 2260failure(setup_failed(_)) --> 2261 !, 2262 [ 'test setup goal failed' ]. 2263failure(Why) --> 2264 [ '~p'-[Why] ]. 2265 2266failures([]) --> 2267 !. 2268failures([H|T]) --> 2269 !, 2270 failure(H), [nl], 2271 failures(T). 2272 2273timeout(Limit) --> 2274 [ 'Timeout exceeeded (~2f sec)'-[Limit] ]. 2275 2276fixme_message([]) --> []. 2277fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) --> 2278 { unit_file(Unit, File) }, 2279 fixme_message(File:Line, Reason, How), 2280 ( {T == []} 2281 -> [] 2282 ; [nl], 2283 fixme_message(T) 2284 ). 2285 2286fixme_message(Location, Reason, failed) --> 2287 [ 'FIXME: ~w: ~w'-[Location, Reason] ]. 2288fixme_message(Location, Reason, passed) --> 2289 [ 'FIXME: ~w: passed ~w'-[Location, Reason] ]. 2290fixme_message(Location, Reason, nondet) --> 2291 [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ]. 2292 2293 2294write_options([ numbervars(true), 2295 quoted(true), 2296 portray(true), 2297 max_depth(100), 2298 attributes(portray) 2299 ]).
2306test_name_summary(Term, MaxLen, Summary) :- 2307 summary_string(Term, Text), 2308 atom_length(Text, Len), 2309 ( Len =< MaxLen 2310 -> Summary = Text 2311 ; End is MaxLen//2, 2312 Pre is MaxLen - End - 2, 2313 sub_string(Text, 0, Pre, _, PreText), 2314 sub_string(Text, _, End, 0, PostText), 2315 format(string(Summary), '~w..~w', [PreText,PostText]) 2316 ). 2317 2318summary_string(Unit:Test, String) => 2319 summary_string(Test, String1), 2320 atomics_to_string([Unit, String1], :, String). 2321summary_string(@(Name,Vars), String) => 2322 format(string(String), '~W (using ~W)', 2323 [ Name, [numbervars(true), quoted(false)], 2324 Vars, [numbervars(true), portray(true), quoted(true)] 2325 ]). 2326summary_string(Name, String) => 2327 term_string(Name, String, [numbervars(true), quoted(false)]).
2333progress_string(forall(_Vars, N-I)/Total, S) => 2334 format(string(S), '~w-~w/~w', [N,I,Total]). 2335progress_string(Progress, S) => 2336 term_string(Progress, S).
2344progress_tag(passed, Tag, Keep, Style) => 2345 Tag = passed, Keep = false, Style = comment. 2346progress_tag(fixme(passed), Tag, Keep, Style) => 2347 Tag = passed, Keep = false, Style = comment. 2348progress_tag(fixme(_), Tag, Keep, Style) => 2349 Tag = fixme, Keep = true, Style = warning. 2350progress_tag(nondet, Tag, Keep, Style) => 2351 Tag = '**NONDET', Keep = true, Style = warning. 2352progress_tag(timeout(_Limit), Tag, Keep, Style) => 2353 Tag = '**TIMEOUT', Keep = true, Style = warning. 2354progress_tag(assertion, Tag, Keep, Style) => 2355 Tag = '**FAILED', Keep = true, Style = error. 2356progress_tag(failed, Tag, Keep, Style) => 2357 Tag = '**FAILED', Keep = true, Style = error. 2358progress_tag(forall(_,0), Tag, Keep, Style) => 2359 Tag = passed, Keep = false, Style = comment. 2360progress_tag(forall(_,_), Tag, Keep, Style) => 2361 Tag = '**FAILED', Keep = true, Style = error. 2362 2363 2364 /******************************* 2365 * OUTPUT * 2366 *******************************/ 2367 2368save_output_state :- 2369 stream_property(Output, alias(user_output)), 2370 stream_property(Error, alias(user_error)), 2371 asserta(output_streams(Output, Error)). 2372 2373restore_output_state :- 2374 output_streams(Output, Error), 2375 !, 2376 set_stream(Output, alias(user_output)), 2377 set_stream(Error, alias(user_error)). 2378restore_output_state. 2379 2380 2381 2382 /******************************* 2383 * CONCURRENT STATUS * 2384 *******************************/ 2385 2386/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2387This part deals with interactive feedback when we are running multiple 2388threads. The terminal window cannot work on top of the Prolog message 2389infrastructure and (thus) we have to use more low-level means. 2390- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2391 2392:- dynamic 2393 jobs/1, % Count 2394 job_window/1, % Count 2395 job_status_line/3. % Job, Format, Args 2396 2397job_feedback(_, jobs(Jobs)) :- 2398 retractall(jobs(_)), 2399 Jobs > 1, 2400 asserta(jobs(Jobs)), 2401 tty_feedback, 2402 !, 2403 retractall(job_window(_)), 2404 asserta(job_window(Jobs)), 2405 retractall(job_status_line(_,_,_)), 2406 jobs_redraw. 2407job_feedback(_, jobs(Jobs)) :- 2408 !, 2409 retractall(job_window(_)), 2410 info(plunit(jobs(Jobs))). 2411job_feedback(_, Msg) :- 2412 job_window(_), 2413 !, 2414 with_mutex(plunit_feedback, job_feedback(Msg)). 2415job_feedback(Level, Msg) :- 2416 print_message(Level, plunit(Msg)). 2417 2418job_feedback(begin(Unit:Test, _Location, Progress)) => 2419 tty_columns(SummaryWidth, _Margin), 2420 test_name_summary(Unit:Test, SummaryWidth, NameS), 2421 progress_string(Progress, ProgressS), 2422 tty_clear_to_eol(CE), 2423 job_format(comment, '\r[~w] ~w ..~w', 2424 [ProgressS, NameS, CE]), 2425 flush_output. 2426job_feedback(end(_UnitTest, _Location, _Progress)) => 2427 true. 2428job_feedback(progress(_UnitTest, Status, _Progress, Time)) => 2429 ( hide_progress(Status) 2430 -> true 2431 ; tty_columns(_SummaryWidth, Margin), 2432 progress_tag(Status, Tag, _Keep, Style), 2433 job_finish(Style, '~`.t ~w (~3f sec)~*|', 2434 [Tag, Time.wall, Margin]) 2435 ). 2436job_feedback(failed(UnitTest, Progress, Line, Error, Time, Output)) => 2437 tty_columns(_SummaryWidth, Margin), 2438 progress_tag(failed, Tag, _Keep, Style), 2439 job_finish(Style, '~`.t ~w (~3f sec)~*|', 2440 [Tag, Time.wall, Margin]), 2441 print_test_output(Error, Output), 2442 ( ( Error = timeout(_) % Status line suffices 2443 ; Error == assertion % We will get an failed test later 2444 ) 2445 -> true 2446 ; print_message(Style, plunit(failed(UnitTest, Progress, Line, 2447 Error, Time, ""))) 2448 ), 2449 jobs_redraw. 2450job_feedback(begin(_Unit)) => true. 2451job_feedback(end(_Unit, _Summary)) => true. 2452 2453hide_progress(assertion). 2454hide_progress(forall(_,_)). 2455hide_progress(failed). 2456hide_progress(timeout(_)). 2457 2458print_test_output(Error, _Msgs-Output) => 2459 print_test_output(Error, Output). 2460print_test_output(_, "") => true. 2461print_test_output(assertion, Output) => 2462 print_message(debug, plunit(test_output(error, Output))). 2463print_test_output(message, Output) => 2464 print_message(debug, plunit(test_output(error, Output))). 2465print_test_output(_, Output) => 2466 print_message(debug, plunit(test_output(informational, Output))).
2472jobs_redraw :- 2473 job_window(N), 2474 !, 2475 tty_columns(_, Width), 2476 tty_header_line(Width), 2477 forall(between(1,N,Line), job_redraw_worker(Line)), 2478 tty_header_line(Width). 2479jobs_redraw. 2480 2481job_redraw_worker(Line) :- 2482 ( job_status_line(Line, Fmt, Args) 2483 -> ansi_format(comment, Fmt, Args) 2484 ; true 2485 ), 2486 nl.
2494job_format(Style, Fmt, Args) :-
2495 job_self(Job),
2496 job_format(Job, Style, Fmt, Args, true).2504job_finish(Style, Fmt, Args) :- 2505 job_self(Job), 2506 job_finish(Job, Style, Fmt, Args). 2507 2508:- det(job_finish/4). 2509job_finish(Job, Style, Fmt, Args) :- 2510 retract(job_status_line(Job, Fmt0, Args0)), 2511 !, 2512 string_concat(Fmt0, Fmt, Fmt1), 2513 append(Args0, Args, Args1), 2514 job_format(Job, Style, Fmt1, Args1, false). 2515 2516:- det(job_format/5). 2517job_format(Job, Style, Fmt, Args, Save) :- 2518 job_window(Jobs), 2519 Up is Jobs+2-Job, 2520 flush_output(user_output), 2521 tty_up_and_clear(Up), 2522 ansi_format(Style, Fmt, Args), 2523 ( Save == true 2524 -> retractall(job_status_line(Job, _, _)), 2525 asserta(job_status_line(Job, Fmt, Args)) 2526 ; true 2527 ), 2528 tty_down_and_home(Up), 2529 flush_output(user_output). 2530 2531:- det(job_self/1). 2532job_self(Job) :- 2533 job_window(N), 2534 N > 1, 2535 thread_self(Me), 2536 split_string(Me, '_', '', [_,_,S]), 2537 number_string(Job, S).
tty format, which reuses the current
output line if the test is successful.2544tty_feedback :- 2545 has_tty, 2546 current_test_flag(format, tty). 2547 2548has_tty :- 2549 stream_property(user_output, tty(true)). 2550 2551tty_columns(SummaryWidth, Margin) :- 2552 tty_width(W), 2553 Margin is W-8, 2554 SummaryWidth is max(20,Margin-34). 2555 2556tty_width(W) :- 2557 current_predicate(tty_size/2), 2558 catch(tty_size(_Rows, Cols), error(_,_), fail), 2559 Cols > 25, 2560 !, 2561 W = Cols. 2562tty_width(80). 2563 2564tty_header_line(Width) :- 2565 ansi_format(comment, '~N~`\u2015t~*|~n', [Width]). 2566 2567:- if(current_predicate(tty_get_capability/3)). 2568tty_clear_to_eol(S) :- 2569 getenv('TERM', _), 2570 catch(tty_get_capability(ce, string, S), 2571 error(_,_), 2572 fail), 2573 !. 2574:- endif. 2575tty_clear_to_eol('\e[K'). 2576 2577tty_up_and_clear(Lines) :- 2578 format(user_output, '\e[~dA\r\e[K', [Lines]). 2579 2580tty_down_and_home(Lines) :- 2581 format(user_output, '\e[~dB\r', [Lines]). 2582 2583:- if(swi). 2584 2585:- multifile 2586 prolog:message/3, 2587 prolog:message_action/2. 2588 2589prologmessage(Term) --> 2590 message(Term). 2591 2592% prolog:message_action(+Term, +Kind) 2593 2594prolog:message_action(make(done(Files)), _) :- 2595 make_run_tests(Files). 2596 2597:- endif. 2598 2599:- if(sicstus). 2600 2601usergenerate_message_hook(Message) --> 2602 message(Message), 2603 [nl]. % SICStus requires nl at the end
2612user:message_hook(informational, plunit(begin(Unit)), _Lines) :- 2613 format(user_error, '% PL-Unit: ~w ', [Unit]), 2614 flush_output(user_error). 2615user:message_hook(informational, plunit(end(_Unit)), _Lines) :- 2616 format(user, ' done~n', []). 2617 2618:- endif. 2619 2620 /******************************* 2621 * SUPPRESS AUTOLOAD WARNINGS * 2622 *******************************/ 2623 2624'$nowarn_autoload'(set_test_options/1, _). 2625'$nowarn_autoload'(run_tests/0, _). 2626'$nowarn_autoload'(run_tests/1, _). 2627'$nowarn_autoload'(run_tests/2, _). 2628'$nowarn_autoload'(running_tests/0, _). 2629'$nowarn_autoload'(current_test/5, _). 2630'$nowarn_autoload'(current_test_unit/2, _). 2631'$nowarn_autoload'(test_report/1, _)
Unit Testing
Unit testing environment for SWI-Prolog and SICStus Prolog. For usage, please visit https://www.swi-prolog.org/pldoc/package/plunit. */