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-2023, 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), !. 85swi :- catch(current_prolog_flag(dialect, yap), _, fail). 86sicstus :- catch(current_prolog_flag(system_type, _), _, fail). 87 88throw_error(Error_term,Impldef) :- 89 throw(error(Error_term,context(Impldef,_))). 90 91:- set_prolog_flag(generate_debug_info, false). 92current_test_flag(optimise, Value) => 93 current_prolog_flag(optimise, Value). 94current_test_flag(occurs_check, Value) => 95 ( current_prolog_flag(plunit_occurs_check, Value0) 96 -> Value = Value0 97 ; current_prolog_flag(occurs_check, Value) 98 ). 99current_test_flag(Name, Value), atom(Name) => 100 atom_concat(plunit_, Name, Flag), 101 current_prolog_flag(Flag, Value). 102current_test_flag(Name, Value), var(Name) => 103 global_test_option(Opt, _, _Type, _Default), 104 functor(Opt, Name, 1), 105 current_test_flag(Name, Value). 106 107set_test_flag(Name, Value) :- 108 Opt =.. [Name, Value], 109 global_test_option(Opt), 110 !, 111 atom_concat(plunit_, Name, Flag), 112 set_prolog_flag(Flag, Value). 113set_test_flag(Name, _) :- 114 domain_error(test_flag, Name). 115 116current_test_flags(Flags) :- 117 findall(Flag, current_test_flag(Flag), Flags). 118 119current_test_flag(Opt) :- 120 current_test_flag(Name, Value), 121 Opt =.. [Name, Value]. 122 123% ensure expansion to avoid tracing 124goal_expansion(forall(C,A), 125 \+ (C, \+ A)). 126goal_expansion(current_module(Module,File), 127 module_property(Module, file(File))). 128 129 130 /******************************* 131 * IMPORTS * 132 *******************************/ 133 134:- initialization init_flags. 135 136init_flags :- 137 ( global_test_option(Option, _Value, _Type, Default), 138 Default \== (-), 139 Option =.. [Name,_], 140 atom_concat(plunit_, Name, Flag), 141 create_prolog_flag(Flag, Default, [keep(true)]), 142 fail 143 ; true 144 ).
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.194set_test_options(Options) :- 195 flatten([Options], List), 196 maplist(set_test_option, List). 197 198set_test_option(sto(true)) => 199 print_message(warning, plunit(sto(true))). 200set_test_option(jobs(Jobs)) => 201 must_be(positive_integer, Jobs), 202 set_test_option_flag(jobs(Jobs)). 203set_test_option(Option), 204 compound(Option), global_test_option(Option) => 205 set_test_option_flag(Option). 206set_test_option(Option) => 207 domain_error(option, Option). 208 209global_test_option(Opt) :- 210 global_test_option(Opt, Value, Type, _Default), 211 must_be(Type, Value). 212 213global_test_option(load(Load), Load, oneof([never,always,normal]), normal). 214global_test_option(output(Cond), Cond, oneof([always,on_failure]), on_failure). 215global_test_option(format(Feedback), Feedback, oneof([tty,log]), tty). 216global_test_option(silent(Silent), Silent, boolean, false). 217global_test_option(show_blocked(Blocked), Blocked, boolean, false). 218global_test_option(run(When), When, oneof([manual,make,make(all)]), make). 219global_test_option(occurs_check(Mode), Mode, oneof([false,true,error]), -). 220global_test_option(cleanup(Bool), Bool, boolean, true). 221global_test_option(jobs(Count), Count, positive_integer, 1). 222global_test_option(timeout(Number), Number, number, 3600). 223 224set_test_option_flag(Option) :- 225 Option =.. [Name, Value], 226 set_test_flag(Name, Value).
232loading_tests :- 233 current_test_flag(load, Load), 234 ( Load == always 235 -> true 236 ; Load == normal, 237 \+ current_test_flag(optimise, true) 238 ). 239 240 /******************************* 241 * MODULE * 242 *******************************/ 243 244:- dynamic 245 loading_unit/4, % Unit, Module, File, OldSource 246 current_unit/4, % Unit, Module, Context, Options 247 test_file_for/2. % ?TestFile, ?PrologFile
end_tests(UnitName).255begin_tests(Unit) :- 256 begin_tests(Unit, []). 257 258begin_tests(Unit, Options) :- 259 must_be(atom, Unit), 260 map_sto_option(Options, Options1), 261 valid_options(test_set_option, Options1), 262 make_unit_module(Unit, Name), 263 source_location(File, Line), 264 begin_tests(Unit, Name, File:Line, Options1). 265 266map_sto_option(Options0, Options) :- 267 select_option(sto(Mode), Options0, Options1), 268 !, 269 map_sto(Mode, Flag), 270 Options = [occurs_check(Flag)|Options1]. 271map_sto_option(Options, Options). 272 273map_sto(rational_trees, Flag) => Flag = false. 274map_sto(finite_trees, Flag) => Flag = true. 275map_sto(Mode, _) => domain_error(sto, Mode). 276 277 278:- if(swi). 279begin_tests(Unit, Name, File:Line, Options) :- 280 loading_tests, 281 !, 282 '$set_source_module'(Context, Context), 283 ( current_unit(Unit, Name, Context, Options) 284 -> true 285 ; retractall(current_unit(Unit, Name, _, _)), 286 assert(current_unit(Unit, Name, Context, Options)) 287 ), 288 '$set_source_module'(Old, Name), 289 '$declare_module'(Name, test, Context, File, Line, false), 290 discontiguous(Name:'unit test'/4), 291 '$set_predicate_attribute'(Name:'unit test'/4, trace, false), 292 discontiguous(Name:'unit body'/2), 293 asserta(loading_unit(Unit, Name, File, Old)). 294begin_tests(Unit, Name, File:_Line, _Options) :- 295 '$set_source_module'(Old, Old), 296 asserta(loading_unit(Unit, Name, File, Old)). 297 298:- else. 299 300% we cannot use discontiguous as a goal in SICStus Prolog. 301 302userterm_expansion((:- begin_tests(Set)), 303 [ (:- begin_tests(Set)), 304 (:- discontiguous(test/2)), 305 (:- discontiguous('unit body'/2)), 306 (:- discontiguous('unit test'/4)) 307 ]). 308 309begin_tests(Unit, Name, File:_Line, Options) :- 310 loading_tests, 311 !, 312 ( current_unit(Unit, Name, _, Options) 313 -> true 314 ; retractall(current_unit(Unit, Name, _, _)), 315 assert(current_unit(Unit, Name, -, Options)) 316 ), 317 asserta(loading_unit(Unit, Name, File, -)). 318begin_tests(Unit, Name, File:_Line, _Options) :- 319 asserta(loading_unit(Unit, Name, File, -)). 320 321:- endif.
330end_tests(Unit) :- 331 loading_unit(StartUnit, _, _, _), 332 !, 333 ( Unit == StartUnit 334 -> once(retract(loading_unit(StartUnit, _, _, Old))), 335 '$set_source_module'(_, Old) 336 ; throw_error(context_error(plunit_close(Unit, StartUnit)), _) 337 ). 338end_tests(Unit) :- 339 throw_error(context_error(plunit_close(Unit, -)), _).
344:- if(swi). 345 346unit_module(Unit, Module) :- 347 atom_concat('plunit_', Unit, Module). 348 349make_unit_module(Unit, Module) :- 350 unit_module(Unit, Module), 351 ( current_module(Module), 352 \+ current_unit(_, Module, _, _), 353 predicate_property(Module:H, _P), 354 \+ predicate_property(Module:H, imported_from(_M)) 355 -> throw_error(permission_error(create, plunit, Unit), 356 'Existing module') 357 ; true 358 ). 359 360:- else. 361 362:- dynamic 363 unit_module_store/2. 364 365unit_module(Unit, Module) :- 366 unit_module_store(Unit, Module), 367 !. 368 369make_unit_module(Unit, Module) :- 370 prolog_load_context(module, Module), 371 assert(unit_module_store(Unit, Module)). 372 373:- endif. 374 375 /******************************* 376 * EXPANSION * 377 *******************************/
test(Name, Options) :- Body into a clause for
'unit test'/4 and 'unit body'/2.384expand_test(Name, Options0, Body, 385 [ 'unit test'(Name, Line, Options, Module:'unit body'(Id, Vars)), 386 ('unit body'(Id, Vars) :- !, Body) 387 ]) :- 388 source_location(_File, Line), 389 prolog_load_context(module, Module), 390 ( prolog_load_context(variable_names, Bindings) 391 -> true 392 ; Bindings = [] 393 ), 394 atomic_list_concat([Name, '@line ', Line], Id), 395 term_variables(Options0, OptionVars0), sort(OptionVars0, OptionVars), 396 term_variables(Body, BodyVars0), sort(BodyVars0, BodyVars), 397 ord_intersection(OptionVars, BodyVars, VarList), 398 Vars =.. [vars|VarList], 399 ( is_list(Options0) % allow for single option without list 400 -> Options1 = Options0 401 ; Options1 = [Options0] 402 ), 403 maplist(expand_option(Bindings), Options1, Options2), 404 join_true_options(Options2, Options3), 405 map_sto_option(Options3, Options4), 406 valid_options(test_option, Options4), 407 valid_test_mode(Options4, Options). 408 409expand_option(_, Var, _) :- 410 var(Var), 411 !, 412 throw_error(instantiation_error,_). 413expand_option(Bindings, Cmp, true(Cond)) :- 414 cmp(Cmp), 415 !, 416 var_cmp(Bindings, Cmp, Cond). 417expand_option(_, error(X), throws(error(X, _))) :- !. 418expand_option(_, exception(X), throws(X)) :- !. % SICStus 4 compatibility 419expand_option(_, error(F,C), throws(error(F,C))) :- !. % SICStus 4 compatibility 420expand_option(_, true, true(true)) :- !. 421expand_option(_, O, O). 422 423cmp(_ == _). 424cmp(_ = _). 425cmp(_ =@= _). 426cmp(_ =:= _). 427 428var_cmp(Bindings, Expr, cmp(Name, Expr)) :- 429 arg(_, Expr, Var), 430 var(Var), 431 member(Name=V, Bindings), 432 V == Var, 433 !. 434var_cmp(_, Expr, Expr). 435 436join_true_options(Options0, Options) :- 437 partition(true_option, Options0, True, Rest), 438 True \== [], 439 !, 440 maplist(arg(1), True, Conds0), 441 flatten(Conds0, Conds), 442 Options = [true(Conds)|Rest]. 443join_true_options(Options, Options). 444 445true_option(true(_)). 446 447valid_test_mode(Options0, Options) :- 448 include(test_mode, Options0, Tests), 449 ( Tests == [] 450 -> Options = [true([true])|Options0] 451 ; Tests = [_] 452 -> Options = Options0 453 ; throw_error(plunit(incompatible_options, Tests), _) 454 ). 455 456test_mode(true(_)). 457test_mode(all(_)). 458test_mode(set(_)). 459test_mode(fail). 460test_mode(throws(_)).
465expand(end_of_file, _) :- 466 loading_unit(Unit, _, _, _), 467 !, 468 end_tests(Unit), % warn? 469 fail. 470expand((:-end_tests(_)), _) :- 471 !, 472 fail. 473expand(_Term, []) :- 474 \+ loading_tests. 475expand((test(Name) :- Body), Clauses) :- 476 !, 477 expand_test(Name, [], Body, Clauses). 478expand((test(Name, Options) :- Body), Clauses) :- 479 !, 480 expand_test(Name, Options, Body, Clauses). 481expand(test(Name), _) :- 482 !, 483 throw_error(existence_error(body, test(Name)), _). 484expand(test(Name, _Options), _) :- 485 !, 486 throw_error(existence_error(body, test(Name)), _). 487 488:- multifile 489 system:term_expansion/2. 490 491systemterm_expansion(Term, Expanded) :- 492 ( loading_unit(_, _, File, _) 493 -> source_location(ThisFile, _), 494 ( File == ThisFile 495 -> true 496 ; source_file_property(ThisFile, included_in(File, _)) 497 ), 498 expand(Term, Expanded) 499 ). 500 501 502 /******************************* 503 * OPTIONS * 504 *******************************/
513valid_options(Pred, Options) :- 514 must_be(list, Options), 515 verify_options(Options, Pred). 516 517verify_options([], _). 518verify_options([H|T], Pred) :- 519 ( call(Pred, H) 520 -> verify_options(T, Pred) 521 ; throw_error(domain_error(Pred, H), _) 522 ). 523 524valid_options(Pred, Options0, Options, Rest) :- 525 must_be(list, Options0), 526 partition(Pred, Options0, Options, Rest).
test(Name, Options).532test_option(Option) :- 533 test_set_option(Option), 534 !. 535test_option(true(_)). 536test_option(fail). 537test_option(throws(_)). 538test_option(all(_)). 539test_option(set(_)). 540test_option(nondet). 541test_option(fixme(_)). 542test_option(forall(X)) :- 543 must_be(callable, X). 544test_option(timeout(Seconds)) :- 545 must_be(number, Seconds).
begin_tests(Name,
Options).552test_set_option(blocked(X)) :- 553 must_be(ground, X). 554test_set_option(condition(X)) :- 555 must_be(callable, X). 556test_set_option(setup(X)) :- 557 must_be(callable, X). 558test_set_option(cleanup(X)) :- 559 must_be(callable, X). 560test_set_option(occurs_check(V)) :- 561 must_be(oneof([false,true,error]), V). 562test_set_option(concurrent(V)) :- 563 must_be(boolean, V), 564 print_message(informational, plunit(concurrent)). 565test_set_option(timeout(Seconds)) :- 566 must_be(number, Seconds). 567 568 /******************************* 569 * UTIL * 570 *******************************/ 571 572:- meta_predicate 573 reify_tmo(, , ), 574 reify(, ), 575 capture_output(,), 576 capture_output(,,).
580:- if(current_predicate(call_with_time_limit/2)). 581reify_tmo(Goal, Result, Options) :- 582 option(timeout(Time), Options), 583 Time > 0, 584 !, 585 reify(call_with_time_limit(Time, Goal), Result0), 586 ( Result0 = throw(time_limit_exceeded) 587 -> Result = throw(time_limit_exceeded(Time)) 588 ; Result = Result0 589 ). 590:- endif. 591reify_tmo(Goal, Result, _Options) :- 592 reify(Goal, Result).
true, false or
throw(E).599reify(Goal, Result) :- 600 ( catch(Goal, E, true) 601 -> ( var(E) 602 -> Result = true 603 ; Result = throw(E) 604 ) 605 ; Result = false 606 ). 607 608capture_output(Goal, Output) :- 609 current_test_flag(output, OutputMode), 610 capture_output(Goal, Output, [output(OutputMode)]). 611 612capture_output(Goal, Output, Options) :- 613 option(output(How), Options, always), 614 ( How == always 615 -> call(Goal) 616 ; with_output_to(string(Output), Goal, 617 [ capture([user_output, user_error]), 618 color(true) 619 ]) 620 ). 621 622 623 /******************************* 624 * RUNNING TOPLEVEL * 625 *******************************/ 626 627:- dynamic 628 output_streams/2, % Output, Error 629 test_count/1, % Count 630 passed/5, % Unit, Test, Line, Det, Time 631 failed/5, % Unit, Test, Line, Reason, Time 632 timeout/5, % Unit, Test, Line, Limit, Time 633 failed_assertion/7, % Unit, Test, Line, ALoc, STO, Reason, Goal 634 blocked/4, % Unit, Test, Line, Reason 635 fixme/5, % Unit, Test, Line, Reason, Status 636 running/5, % Unit, Test, Line, STO, Thread 637 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:
669run_tests :- 670 run_tests(all). 671 672run_tests(Set) :- 673 run_tests(Set, []). 674 675run_tests(all, Options) :- 676 !, 677 findall(Unit, current_test_unit(Unit,_), Units), 678 run_tests(Units, Options). 679run_tests(Set, Options) :- 680 valid_options(global_test_option, Options, Global, Rest), 681 current_test_flags(Old), 682 setup_call_cleanup( 683 set_test_options(Global), 684 ( flatten([Set], List), 685 maplist(runnable_tests, List, Units), 686 with_mutex(plunit, run_tests_sync(Units, Rest)) 687 ), 688 set_test_options(Old)). 689 690run_tests_sync(Units0, Options) :- 691 cleanup, 692 count_tests(Units0, Units, Count), 693 asserta(test_count(Count)), 694 save_output_state, 695 setup_call_cleanup( 696 setup_jobs(Count), 697 setup_call_cleanup( 698 setup_trap_assertions(Ref), 699 ( call_time(run_units(Units, Options), Time), 700 test_summary(_All, Summary) 701 ), 702 report_and_cleanup(Ref, Time, Options)), 703 cleanup_jobs), 704 ( option(summary(Summary), Options) 705 -> true 706 ; test_summary_passed(Summary) % fail if some test failed 707 ).
714report_and_cleanup(Ref, Time, Options) :-
715 cleanup_trap_assertions(Ref),
716 report(Time, Options),
717 cleanup_after_test.
724run_units(Units, _Options) :-
725 maplist(schedule_unit, Units),
726 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.735:- det(runnable_tests/2). 736runnable_tests(Spec, Unit:RunnableTests) :- 737 unit_from_spec(Spec, Unit, Tests, Module, UnitOptions), 738 ( option(blocked(Reason), UnitOptions) 739 -> info(plunit(blocked(unit(Unit, Reason)))), 740 RunnableTests = [] 741 ; \+ condition(Module, unit(Unit), UnitOptions) 742 -> RunnableTests = [] 743 ; var(Tests) 744 -> findall(TestID, 745 runnable_test(Unit, _Test, Module, TestID), 746 RunnableTests) 747 ; flatten([Tests], TestList), 748 findall(TestID, 749 ( member(Test, TestList), 750 runnable_test(Unit,Test,Module, TestID) 751 ), 752 RunnableTests) 753 ). 754 755runnable_test(Unit, Name, Module, @(Test,Line)) :- 756 current_test(Unit, Name, Line, _Body, TestOptions), 757 ( option(blocked(Reason), TestOptions) 758 -> Test = blocked(Name, Reason) 759 ; condition(Module, test(Unit,Name,Line), TestOptions), 760 Test = Name 761 ). 762 763unit_from_spec(Unit0:Tests0, Unit, Tests, Module, Options), atom(Unit0) => 764 Unit = Unit0, 765 Tests = Tests0, 766 ( current_unit(Unit, Module, _Supers, Options) 767 -> true 768 ; throw_error(existence_error(unit_test, Unit), _) 769 ). 770unit_from_spec(Unit0, Unit, _, Module, Options), atom(Unit0) => 771 Unit = Unit0, 772 ( current_unit(Unit, Module, _Supers, Options) 773 -> true 774 ; throw_error(existence_error(unit_test, Unit), _) 775 ).
forall(Generator, Test) counts
as a single test. During the execution, the concrete tests of the
forall are considered "sub tests".783count_tests(Units0, Units, Count) :- 784 count_tests(Units0, Units, 0, Count). 785 786count_tests([], T, C0, C) => 787 T = [], 788 C = C0. 789count_tests([_:[]|T0], T, C0, C) => 790 count_tests(T0, T, C0, C). 791count_tests([Unit:Tests|T0], T, C0, C) => 792 partition(is_blocked, Tests, Blocked, Use), 793 maplist(assert_blocked(Unit), Blocked), 794 ( Use == [] 795 -> count_tests(T0, T, C0, C) 796 ; length(Use, N), 797 C1 is C0+N, 798 T = [Unit:Use|T1], 799 count_tests(T0, T1, C1, C) 800 ). 801 802is_blocked(@(blocked(_,_),_)) => true. 803is_blocked(_) => fail. 804 805assert_blocked(Unit, @(blocked(Test, Reason), Line)) => 806 assert(blocked(Unit, Test, Line, Reason)).
813run_unit(_Unit:[]) => 814 true. 815run_unit(Unit:Tests) => 816 unit_module(Unit, Module), 817 unit_options(Unit, UnitOptions), 818 ( setup(Module, unit(Unit), UnitOptions) 819 -> begin_unit(Unit), 820 call_time(run_unit_2(Unit, Tests), Time), 821 test_summary(Unit, Summary), 822 end_unit(Unit, Summary.put(time, Time)), 823 cleanup(Module, UnitOptions) 824 ; job_info(end(unit(Unit, _{error:setup_failed}))) 825 ). 826 827begin_unit(Unit) :- 828 job_info(begin(unit(Unit))), 829 job_feedback(informational, begin(Unit)). 830 831end_unit(Unit, Summary) :- 832 job_info(end(unit(Unit, Summary))), 833 job_feedback(informational, end(Unit, Summary)). 834 835run_unit_2(Unit, Tests) :- 836 forall(member(Test, Tests), 837 run_test(Unit, Test)). 838 839 840unit_options(Unit, Options) :- 841 current_unit(Unit, _Module, _Supers, Options). 842 843 844cleanup :- 845 set_flag(plunit_test, 1), 846 retractall(output_streams(_,_)), 847 retractall(test_count(_)), 848 retractall(passed(_, _, _, _, _)), 849 retractall(failed(_, _, _, _, _)), 850 retractall(timeout(_, _, _, _, _)), 851 retractall(failed_assertion(_, _, _, _, _, _, _)), 852 retractall(blocked(_, _, _, _)), 853 retractall(fixme(_, _, _, _, _)), 854 retractall(running(_,_,_,_,_)), 855 retractall(forall_failures(_,_)). 856 857cleanup_after_test :- 858 ( current_test_flag(cleanup, true) 859 -> cleanup 860 ; true 861 ).
868run_tests_in_files(Files) :- 869 findall(Unit, unit_in_files(Files, Unit), Units), 870 ( Units == [] 871 -> true 872 ; run_tests(Units) 873 ). 874 875unit_in_files(Files, Unit) :- 876 is_list(Files), 877 !, 878 member(F, Files), 879 absolute_file_name(F, Source, 880 [ file_type(prolog), 881 access(read), 882 file_errors(fail) 883 ]), 884 unit_file(Unit, Source). 885 886 887 /******************************* 888 * HOOKING MAKE/0 * 889 *******************************/
895make_run_tests(Files) :- 896 current_test_flag(run, When), 897 ( When == make 898 -> run_tests_in_files(Files) 899 ; When == make(all) 900 -> run_tests 901 ; true 902 ). 903 904 /******************************* 905 * ASSERTION HANDLING * 906 *******************************/ 907 908:- if(swi). 909 910:- dynamic prolog:assertion_failed/2. 911 912setup_trap_assertions(Ref) :- 913 asserta((prolog:assertion_failed(Reason, Goal) :- 914 test_assertion_failed(Reason, Goal)), 915 Ref). 916 917cleanup_trap_assertions(Ref) :- 918 erase(Ref). 919 920test_assertion_failed(Reason, Goal) :- 921 thread_self(Me), 922 running(Unit, Test, Line, Progress, Me), 923 ( catch(get_prolog_backtrace(10, Stack), _, fail), 924 assertion_location(Stack, AssertLoc) 925 -> true 926 ; AssertLoc = unknown 927 ), 928 report_failed_assertion(Unit:Test, Line, AssertLoc, 929 Progress, Reason, Goal), 930 assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc, 931 Progress, Reason, Goal)). 932 933assertion_location(Stack, File:Line) :- 934 append(_, [AssertFrame,CallerFrame|_], Stack), 935 prolog_stack_frame_property(AssertFrame, 936 predicate(prolog_debug:assertion/1)), 937 !, 938 prolog_stack_frame_property(CallerFrame, location(File:Line)). 939 940report_failed_assertion(UnitTest, Line, AssertLoc, 941 Progress, Reason, Goal) :- 942 print_message( 943 error, 944 plunit(failed_assertion(UnitTest, Line, AssertLoc, 945 Progress, Reason, Goal))). 946 947:- else. 948 949setup_trap_assertions(_). 950cleanup_trap_assertions(_). 951 952:- endif. 953 954 955 /******************************* 956 * RUNNING A TEST * 957 *******************************/
963run_test(Unit, @(Test,Line)) :-
964 unit_module(Unit, Module),
965 Module:'unit test'(Test, Line, TestOptions, Body),
966 unit_options(Unit, UnitOptions),
967 run_test(Unit, Test, Line, UnitOptions, TestOptions, Body).forall(Generator, Test)973run_test(Unit, Name, Line, UnitOptions, Options, Body) :- 974 option(forall(Generator), Options), 975 !, 976 unit_module(Unit, Module), 977 term_variables(Generator, Vars), 978 start_test(Unit, @(Name,Line), Nth), 979 State = state(0), 980 call_time(forall(Module:Generator, % may become concurrent 981 ( incr_forall(State, I), 982 run_test_once6(Unit, Name, forall(Vars, Nth-I), Line, 983 UnitOptions, Options, Body) 984 )), 985 Time), 986 arg(1, State, Generated), 987 progress(Unit:Name, Nth, forall(end, Nth, Generated), Time). 988run_test(Unit, Name, Line, UnitOptions, Options, Body) :- 989 start_test(Unit, @(Name,Line), Nth), 990 run_test_once6(Unit, Name, Nth, Line, UnitOptions, Options, Body). 991 992start_test(_Unit, _TestID, Nth) :- 993 flag(plunit_test, Nth, Nth+1). 994 995incr_forall(State, I) :- 996 arg(1, State, I0), 997 I is I0+1, 998 nb_setarg(1, State, I).
timeout and occurs_check option (Global -> Unit -> Test).1005run_test_once6(Unit, Name, Progress, Line, UnitOptions, Options, Body) :- 1006 current_test_flag(timeout, DefTimeOut), 1007 current_test_flag(occurs_check, DefOccurs), 1008 inherit_option(timeout, Options, [UnitOptions], DefTimeOut, Options1), 1009 inherit_option(occurs_check, Options1, [UnitOptions], DefOccurs, Options2), 1010 run_test_once(Unit, Name, Progress, Line, Options2, Body). 1011 1012inherit_option(Name, Options0, Chain, Default, Options) :- 1013 Term =.. [Name,_Value], 1014 ( option(Term, Options0) 1015 -> Options = Options0 1016 ; member(Opts, Chain), 1017 option(Term, Opts) 1018 -> Options = [Term|Options0] 1019 ; Default == (-) 1020 -> Options = Options0 1021 ; Opt =.. [Name,Default], 1022 Options = [Opt|Options0] 1023 ).
1030run_test_once(Unit, Name, Progress, Line, Options, Body) :- 1031 option(occurs_check(Occurs), Options), 1032 !, 1033 begin_test(Unit, Name, Line, Progress), 1034 current_prolog_flag(occurs_check, Old), 1035 setup_call_cleanup( 1036 set_prolog_flag(occurs_check, Occurs), 1037 capture_output(run_test_6(Unit, Name, Line, Options, Body, Result), 1038 Output), 1039 set_prolog_flag(occurs_check, Old)), 1040 end_test(Unit, Name, Line, Progress), 1041 report_result(Result, Progress, Output, Options). 1042run_test_once(Unit, Name, Progress, Line, Options, Body) :- 1043 begin_test(Unit, Name, Line, Progress), 1044 capture_output(run_test_6(Unit, Name, Line, Options, Body, Result), 1045 Output), 1046 end_test(Unit, Name, Line, Progress), 1047 report_result(Result, Progress, Output, Options).
1051:- det(report_result/4). 1052report_result(failure(Unit, Name, Line, How, Time), 1053 Progress, Output, Options) :- 1054 !, 1055 failure(Unit, Name, Progress, Line, How, Time, Output, Options). 1056report_result(success(Unit, Name, Line, Determinism, Time), 1057 Progress, Output, Options) :- 1058 !, 1059 success(Unit, Name, Progress, Line, Determinism, Time, Output, Options). 1060report_result(setup_failed(_Unit, _Name, _Line), 1061 _Progress, _Output, _Options).
time_limit_exceeded(Limit)cmp_error(Cmp, E)wrong_answer(Cmp)wrong_error(Expect, E)wrong_answer(Expected, Bindings)1083run_test_6(Unit, Name, Line, Options, Body, Result) :- 1084 option(setup(_Setup), Options), 1085 !, 1086 ( unit_module(Unit, Module), 1087 setup(Module, test(Unit,Name,Line), Options) 1088 -> run_test_7(Unit, Name, Line, Options, Body, Result), 1089 cleanup(Module, Options) 1090 ; Result = setup_failed(Unit, Name, Line) 1091 ). 1092run_test_6(Unit, Name, Line, Options, Body, Result) :- 1093 unit_module(Unit, Module), 1094 run_test_7(Unit, Name, Line, Options, Body, Result), 1095 cleanup(Module, Options).
1104run_test_7(Unit, Name, Line, Options, Body, Result) :- 1105 option(true(Cmp), Options), % expected success 1106 !, 1107 unit_module(Unit, Module), 1108 call_time(reify_tmo(call_det(Module:Body, Det), Result0, Options), Time), 1109 ( Result0 == true 1110 -> cmp_true(Cmp, Module, CmpResult), 1111 ( CmpResult == [] 1112 -> Result = success(Unit, Name, Line, Det, Time) 1113 ; Result = failure(Unit, Name, Line, CmpResult, Time) 1114 ) 1115 ; Result0 == false 1116 -> Result = failure(Unit, Name, Line, failed, Time) 1117 ; Result0 = throw(E2) 1118 -> Result = failure(Unit, Name, Line, throw(E2), Time) 1119 ). 1120run_test_7(Unit, Name, Line, Options, Body, Result) :- 1121 option(fail, Options), % expected failure 1122 !, 1123 unit_module(Unit, Module), 1124 call_time(reify_tmo(Module:Body, Result0, Options), Time), 1125 ( Result0 == true 1126 -> Result = failure(Unit, Name, Line, succeeded, Time) 1127 ; Result0 == false 1128 -> Result = success(Unit, Name, Line, true, Time) 1129 ; Result0 = throw(E) 1130 -> Result = failure(Unit, Name, Line, throw(E), Time) 1131 ). 1132run_test_7(Unit, Name, Line, Options, Body, Result) :- 1133 option(throws(Expect), Options), % Expected error 1134 !, 1135 unit_module(Unit, Module), 1136 call_time(reify_tmo(Module:Body, Result0, Options), Time), 1137 ( Result0 == true 1138 -> Result = failure(Unit, Name, Line, no_exception, Time) 1139 ; Result0 == false 1140 -> Result = failure(Unit, Name, Line, failed, Time) 1141 ; Result0 = throw(E) 1142 -> ( match_error(Expect, E) 1143 -> Result = success(Unit, Name, Line, true, Time) 1144 ; Result = failure(Unit, Name, Line, wrong_error(Expect, E), Time) 1145 ) 1146 ). 1147run_test_7(Unit, Name, Line, Options, Body, Result) :- 1148 option(all(Answer), Options), % all(Bindings) 1149 !, 1150 nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result). 1151run_test_7(Unit, Name, Line, Options, Body, Result) :- 1152 option(set(Answer), Options), % set(Bindings) 1153 !, 1154 nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
1160nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :- 1161 unit_module(Unit, Module), 1162 result_vars(Expected, Vars), 1163 ( call_time(reify_tmo(findall(Vars, Module:Body, Bindings), 1164 Result0, Options), Time) 1165 -> ( Result0 == true 1166 -> ( nondet_compare(Expected, Bindings, Unit, Name, Line) 1167 -> Result = success(Unit, Name, Line, true, Time) 1168 ; Result = failure(Unit, Name, Line, 1169 [wrong_answer(Expected, Bindings)], Time) 1170 ) 1171 ; Result0 = throw(E) 1172 -> Result = failure(Unit, Name, Line, throw(E), Time) 1173 ) 1174 ). 1175 1176cmp_true([], _, L) => 1177 L = []. 1178cmp_true([Cmp|T], Module, L) => 1179 E = error(Formal,_), 1180 cmp_goal(Cmp, Goal), 1181 ( catch(Module:Goal, E, true) 1182 -> ( var(Formal) 1183 -> cmp_true(T, Module, L) 1184 ; L = [cmp_error(Cmp,E)|L1], 1185 cmp_true(T, Module, L1) 1186 ) 1187 ; L = [wrong_answer(Cmp)|L1], 1188 cmp_true(T, Module, L1) 1189 ). 1190 1191cmp_goal(cmp(_Var, Expr), Goal) => Goal = Expr. 1192cmp_goal(Expr, Goal) => Goal = Expr.
v(V1, ...) containing all variables at the left
side of the comparison operator on Expected.
1200result_vars(Expected, Vars) :-
1201 arg(1, Expected, CmpOp),
1202 arg(1, CmpOp, Vars).1212nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :- 1213 cmp(Cmp, _Vars, Op, Values), 1214 cmp_list(Values, Bindings, Op). 1215nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :- 1216 cmp(Cmp, _Vars, Op, Values0), 1217 sort(Bindings0, Bindings), 1218 sort(Values0, Values), 1219 cmp_list(Values, Bindings, Op). 1220 1221cmp_list([], [], _Op). 1222cmp_list([E0|ET], [V0|VT], Op) :- 1223 call(Op, E0, V0), 1224 cmp_list(ET, VT, Op).
1228cmp(Var == Value, Var, ==, Value). 1229cmp(Var =:= Value, Var, =:=, Value). 1230cmp(Var = Value, Var, =, Value). 1231:- if(swi). 1232cmp(Var =@= Value, Var, =@=, Value). 1233:- else. 1234:- if(sicstus). 1235cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@= 1236:- endif. 1237:- endif.
true if Goal left
no choicepoints and false otherwise.1245:- if((swi;sicstus)). 1246call_det(Goal, Det) :- 1247 call_cleanup(Goal,Det0=true), 1248 ( var(Det0) -> Det = false ; Det = true ). 1249:- else. 1250call_det(Goal, true) :- 1251 call(Goal). 1252:- endif.
1259match_error(Expect, Rec) :-
1260 subsumes_term(Expect, Rec).1273setup(Module, Context, Options) :- 1274 option(setup(Setup), Options), 1275 !, 1276 capture_output(reify(call_ex(Module, Setup), Result), Output), 1277 ( Result == true 1278 -> true 1279 ; print_message(error, 1280 plunit(error(setup, Context, Output, Result))), 1281 fail 1282 ). 1283setup(_,_,_).
1289condition(Module, Context, Options) :- 1290 option(condition(Cond), Options), 1291 !, 1292 capture_output(reify(call_ex(Module, Cond), Result), Output), 1293 ( Result == true 1294 -> true 1295 ; Result == false 1296 -> fail 1297 ; print_message(error, 1298 plunit(error(condition, Context, Output, Result))), 1299 fail 1300 ). 1301condition(_, _, _).
1308call_ex(Module, Goal) :-
1309 Module:(expand_goal(Goal, GoalEx),
1310 GoalEx).1317cleanup(Module, Options) :- 1318 option(cleanup(Cleanup), Options, true), 1319 ( catch(call_ex(Module, Cleanup), E, true) 1320 -> ( var(E) 1321 -> true 1322 ; print_message(warning, E) 1323 ) 1324 ; print_message(warning, goal_failed(Cleanup, '(cleanup handler)')) 1325 ). 1326 1327success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :- 1328 memberchk(fixme(Reason), Options), 1329 !, 1330 ( ( Det == true 1331 ; memberchk(nondet, Options) 1332 ) 1333 -> progress(Unit:Name, Progress, fixme(passed), Time), 1334 Ok = passed 1335 ; progress(Unit:Name, Progress, fixme(nondet), Time), 1336 Ok = nondet 1337 ), 1338 flush_output(user_error), 1339 assert(fixme(Unit, Name, Line, Reason, Ok)). 1340success(Unit, Name, Progress, Line, _, Time, Output, Options) :- 1341 failed_assertion(Unit, Name, Line, _,Progress,_,_), 1342 !, 1343 failure(Unit, Name, Progress, Line, assertion, Time, Output, Options). 1344success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :- 1345 assert(passed(Unit, Name, Line, Det, Time)), 1346 ( ( Det == true 1347 ; memberchk(nondet, Options) 1348 ) 1349 -> progress(Unit:Name, Progress, passed, Time) 1350 ; unit_file(Unit, File), 1351 print_message(warning, plunit(nondet(File, Line, Name))) 1352 ).
1359failure(Unit, Name, Progress, Line, _, Time, _Output, Options), 1360 memberchk(fixme(Reason), Options) => 1361 assert(fixme(Unit, Name, Line, Reason, failed)), 1362 progress(Unit:Name, Progress, fixme(failed), Time). 1363failure(Unit, Name, Progress, Line, time_limit_exceeded(Limit), Time, 1364 Output, Options) => 1365 assert_cyclic(timeout(Unit, Name, Line, Limit, Time)), 1366 progress(Unit:Name, Progress, timeout(Limit), Time), 1367 report_failure(Unit, Name, Progress, Line, timeout(Limit), Time, Output, Options). 1368failure(Unit, Name, Progress, Line, E, Time, Output, Options) => 1369 assert_cyclic(failed(Unit, Name, Line, E, Time)), 1370 progress(Unit:Name, Progress, failed, Time), 1371 report_failure(Unit, Name, Progress, Line, E, Time, Output, Options).
1381:- if(swi). 1382assert_cyclic(Term) :- 1383 acyclic_term(Term), 1384 !, 1385 assert(Term). 1386assert_cyclic(Term) :- 1387 Term =.. [Functor|Args], 1388 recorda(cyclic, Args, Id), 1389 functor(Term, _, Arity), 1390 length(NewArgs, Arity), 1391 Head =.. [Functor|NewArgs], 1392 assert(( :- recorded(_, Var, Id), Var = NewArgs)). 1393:- else. 1394:- if(sicstus). 1395:- endif. 1396assert_cyclic(Term) :- 1397 assert(Term). 1398:- endif. 1399 1400 1401 /******************************* 1402 * JOBS * 1403 *******************************/ 1404 1405:- if(current_prolog_flag(threads, true)). 1406 1407:- dynamic 1408 job_data/2, % Queue, Threads 1409 scheduled_unit/1. 1410 1411schedule_unit(_:[]) :- 1412 !. 1413schedule_unit(UnitAndTests) :- 1414 UnitAndTests = Unit:_Tests, 1415 job_data(Queue, _), 1416 !, 1417 assertz(scheduled_unit(Unit)), 1418 thread_send_message(Queue, unit(UnitAndTests)). 1419schedule_unit(Unit) :- 1420 run_unit(Unit).
1426setup_jobs(Count) :- 1427 ( current_test_flag(jobs, Jobs0), 1428 integer(Jobs0) 1429 -> true 1430 ; current_prolog_flag(cpu_count, Jobs0) 1431 ), 1432 Jobs is min(Count, Jobs0), 1433 Jobs > 1, 1434 !, 1435 message_queue_create(Q, [alias(plunit_jobs)]), 1436 length(TIDs, Jobs), 1437 foldl(create_plunit_job(Q), TIDs, 1, _), 1438 asserta(job_data(Q, TIDs)), 1439 job_feedback(informational, jobs(Jobs)). 1440setup_jobs(_) :- 1441 job_feedback(informational, jobs(1)). 1442 1443create_plunit_job(Q, TID, N, N1) :- 1444 N1 is N + 1, 1445 atom_concat(plunit_job_, N, Alias), 1446 thread_create(plunit_job(Q), TID, [alias(Alias)]). 1447 1448plunit_job(Queue) :- 1449 repeat, 1450 ( catch(thread_get_message(Queue, Job, 1451 [ timeout(10) 1452 ]), 1453 error(_,_), fail) 1454 -> job(Job), 1455 fail 1456 ; ! 1457 ). 1458 1459job(unit(Unit:Tests)) => 1460 run_unit(Unit:Tests). 1461job(test(Unit, Test)) => 1462 run_test(Unit, Test). 1463 1464cleanup_jobs :- 1465 retract(job_data(Queue, TIDSs)), 1466 !, 1467 message_queue_destroy(Queue), 1468 maplist(thread_join, TIDSs). 1469cleanup_jobs.
1475job_wait(Unit) :- 1476 thread_wait(\+ scheduled_unit(Unit), 1477 [ wait_preds([scheduled_unit/1]), 1478 timeout(1) 1479 ]), 1480 !. 1481job_wait(Unit) :- 1482 job_data(_Queue, TIDs), 1483 member(TID, TIDs), 1484 thread_property(TID, status(running)), 1485 !, 1486 job_wait(Unit). 1487job_wait(_). 1488 1489 1490job_info(begin(unit(Unit))) => 1491 print_message(silent, plunit(begin(Unit))). 1492job_info(end(unit(Unit, Summary))) => 1493 retractall(scheduled_unit(Unit)), 1494 print_message(silent, plunit(end(Unit, Summary))). 1495 1496:- else. % No jobs 1497 1498schedule_unit(Unit) :- 1499 run_unit(Unit). 1500 1501setup_jobs(_) :- 1502 print_message(silent, plunit(jobs(1))). 1503cleanup_jobs. 1504job_wait(_). 1505job_info(_). 1506 1507:- endif. 1508 1509 1510 1511 /******************************* 1512 * REPORTING * 1513 *******************************/
silent message:
plunit(begin(Unit:Test, File:Line, Progress))plunit(end(Unit:Test, File:Line, Progress))1526begin_test(Unit, Test, Line, Progress) :- 1527 thread_self(Me), 1528 assert(running(Unit, Test, Line, Progress, Me)), 1529 unit_file(Unit, File), 1530 test_count(Total), 1531 job_feedback(information, begin(Unit:Test, File:Line, Progress/Total)). 1532 1533end_test(Unit, Test, Line, Progress) :- 1534 thread_self(Me), 1535 retractall(running(_,_,_,_,Me)), 1536 unit_file(Unit, File), 1537 test_count(Total), 1538 job_feedback(information, end(Unit:Test, File:Line, Progress/Total)).
1544running_tests :- 1545 running_tests(Running), 1546 print_message(informational, plunit(running(Running))). 1547 1548running_tests(Running) :- 1549 test_count(Total), 1550 findall(running(Unit:Test, File:Line, Progress/Total, Thread), 1551 ( running(Unit, Test, Line, Progress, Thread), 1552 unit_file(Unit, File) 1553 ), Running).
1560current_test(Unit, Test, Line, Body, Options) :-
1561 current_unit(Unit, Module, _Supers, _UnitOptions),
1562 Module:'unit test'(Test, Line, Options, Body).1568current_test_unit(Unit, UnitOptions) :- 1569 current_unit(Unit, _Module, _Supers, UnitOptions). 1570 1571 1572count(Goal, Count) :- 1573 aggregate_all(count, Goal, Count).
1580test_summary(Unit, Summary) :- 1581 count(failed(Unit, _0Test, _0Line, _Reason, _0Time), Failed), 1582 count(timeout(Unit, _0Test, _0Line, _Limit, _0Time), Timeout), 1583 count(passed(Unit, _0Test, _0Line, _Det, _0Time), Passed), 1584 count(blocked(Unit, _0Test, _0Line, _0Reason), Blocked), 1585 count(fixme(Unit, _0Test, _0Line, _0Reason, _0How), Fixme), 1586 test_count(Total), 1587 Summary = plunit{total:Total, 1588 passed:Passed, 1589 failed:Failed, 1590 timeout:Timeout, 1591 blocked:Blocked, 1592 fixme:Fixme}. 1593 1594test_summary_passed(Summary) :- 1595 _{failed: 0} :< Summary.
1601report(Time, _Options) :- 1602 test_summary(_, Summary), 1603 print_message(silent, plunit(Summary)), 1604 _{ passed:Passed, 1605 failed:Failed, 1606 timeout:Timeout, 1607 blocked:Blocked, 1608 fixme:Fixme 1609 } :< Summary, 1610 ( Passed+Failed+Timeout+Blocked+Fixme =:= 0 1611 -> info(plunit(no_tests)) 1612 ; Failed+Timeout =:= 0 1613 -> report_blocked(Blocked), 1614 report_fixme, 1615 test_count(Total), 1616 info(plunit(all_passed(Total, Passed, Time))) 1617 ; report_blocked(Blocked), 1618 report_fixme, 1619 report_failed(Failed), 1620 report_timeout(Timeout), 1621 info(plunit(passed(Passed))), 1622 info(plunit(total_time(Time))) 1623 ). 1624 1625report_blocked(0) => 1626 true. 1627report_blocked(Blocked) => 1628 findall(blocked(Unit:Name, File:Line, Reason), 1629 ( blocked(Unit, Name, Line, Reason), 1630 unit_file(Unit, File) 1631 ), 1632 BlockedTests), 1633 info(plunit(blocked(Blocked, BlockedTests))). 1634 1635report_failed(Failed) :- 1636 print_message(error, plunit(failed(Failed))). 1637 1638report_timeout(Count) :- 1639 print_message(warning, plunit(timeout(Count))). 1640 1641report_fixme :- 1642 report_fixme(_,_,_). 1643 1644report_fixme(TuplesF, TuplesP, TuplesN) :- 1645 fixme(failed, TuplesF, Failed), 1646 fixme(passed, TuplesP, Passed), 1647 fixme(nondet, TuplesN, Nondet), 1648 print_message(informational, plunit(fixme(Failed, Passed, Nondet))). 1649 1650 1651fixme(How, Tuples, Count) :- 1652 findall(fixme(Unit, Name, Line, Reason, How), 1653 fixme(Unit, Name, Line, Reason, How), Tuples), 1654 length(Tuples, Count). 1655 1656report_failure(Unit, Name, Progress, Line, Error, 1657 Time, Output, _Options) => 1658 test_count(Total), 1659 job_feedback(error, failed(Unit:Name, Progress/Total, Line, 1660 Error, Time, Output)).
fixme for What.1668test_report(fixme) :- 1669 !, 1670 report_fixme(TuplesF, TuplesP, TuplesN), 1671 append([TuplesF, TuplesP, TuplesN], Tuples), 1672 print_message(informational, plunit(fixme(Tuples))). 1673test_report(What) :- 1674 throw_error(domain_error(report_class, What), _). 1675 1676 1677 /******************************* 1678 * INFO * 1679 *******************************/
1686unit_file(Unit, File), nonvar(Unit) => 1687 unit_file_(Unit, File), 1688 !. 1689unit_file(Unit, File) => 1690 unit_file_(Unit, File). 1691 1692unit_file_(Unit, File) :- 1693 current_unit(Unit, Module, _Context, _Options), 1694 module_property(Module, file(File)). 1695unit_file_(Unit, PlFile) :- 1696 test_file_for(TestFile, PlFile), 1697 module_property(Module, file(TestFile)), 1698 current_unit(Unit, Module, _Context, _Options). 1699 1700 1701 /******************************* 1702 * FILES * 1703 *******************************/
1710load_test_files(_Options) :- 1711 State = state(0,0), 1712 ( source_file(File), 1713 file_name_extension(Base, Old, File), 1714 Old \== plt, 1715 file_name_extension(Base, plt, TestFile), 1716 exists_file(TestFile), 1717 inc_arg(1, State), 1718 ( test_file_for(TestFile, File) 1719 -> true 1720 ; load_files(TestFile, 1721 [ if(changed), 1722 imports([]) 1723 ]), 1724 inc_arg(2, State), 1725 asserta(test_file_for(TestFile, File)) 1726 ), 1727 fail 1728 ; State = state(Total, Loaded), 1729 print_message(informational, plunit(test_files(Total, Loaded))) 1730 ). 1731 1732inc_arg(Arg, State) :- 1733 arg(Arg, State, N0), 1734 N is N0+1, 1735 nb_setarg(Arg, State, N). 1736 1737 1738 /******************************* 1739 * MESSAGES * 1740 *******************************/
print_message(Level, Term), where Level is one of silent or
informational (default).
1747info(Term) :-
1748 message_level(Level),
1749 print_message(Level, Term).forall(Gen,Test) set. Mapped
to forall(FTotal, FFailed)1766progress(UnitTest, _Progress, forall(end, Nth, FTotal), Time) => 1767 ( retract(forall_failures(Nth, FFailed)) 1768 -> true 1769 ; FFailed = 0 1770 ), 1771 test_count(Total), 1772 job_feedback(information, progress(UnitTest, forall(FTotal,FFailed), Nth/Total, Time)). 1773progress(UnitTest, Progress, Result, Time), Progress = forall(_Vars, Nth-_I) => 1774 with_mutex(plunit_forall_counter, 1775 update_forall_failures(Nth, Result)), 1776 test_count(Total), 1777 job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)). 1778progress(UnitTest, Progress, Result, Time) => 1779 test_count(Total), 1780 job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)). 1781 1782update_forall_failures(_Nth, passed) => 1783 true. 1784update_forall_failures(Nth, _) => 1785 ( retract(forall_failures(Nth, Failed0)) 1786 -> true 1787 ; Failed0 = 0 1788 ), 1789 Failed is Failed0+1, 1790 asserta(forall_failures(Nth, Failed)). 1791 1792message_level(Level) :- 1793 ( current_test_flag(silent, true) 1794 -> Level = silent 1795 ; Level = informational 1796 ). 1797 1798locationprefix(File:Line) --> 1799 !, 1800 [ url(File:Line), ':'-[], nl, ' ' ]. 1801locationprefix(test(Unit,_Test,Line)) --> 1802 !, 1803 { unit_file(Unit, File) }, 1804 locationprefix(File:Line). 1805locationprefix(unit(Unit)) --> 1806 !, 1807 [ 'PL-Unit: unit ~w: '-[Unit] ]. 1808locationprefix(FileLine) --> 1809 { throw_error(type_error(locationprefix,FileLine), _) }. 1810 1811:- discontiguous 1812 message//1. 1813:- '$hide'(message//1). 1814 1815message(error(context_error(plunit_close(Name, -)), _)) --> 1816 [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ]. 1817message(error(context_error(plunit_close(Name, Start)), _)) --> 1818 [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ]. 1819message(plunit(nondet(File, Line, Name))) --> 1820 locationprefix(File:Line), 1821 [ 'PL-Unit: Test ~w: Test succeeded with choicepoint'- [Name] ]. 1822message(error(plunit(incompatible_options, Tests), _)) --> 1823 [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ]. 1824message(plunit(sto(true))) --> 1825 [ 'Option sto(true) is ignored. See `occurs_check` option.'-[] ]. 1826message(plunit(test_files(Total, Loaded))) --> 1827 [ 'Found ~D .plt test files, loaded ~D'-[Total, Loaded] ]. 1828 1829 % Unit start/end 1830message(plunit(jobs(1))) --> 1831 !. 1832message(plunit(jobs(N))) --> 1833 [ 'Testing with ~D parallel jobs'-[N] ]. 1834message(plunit(begin(_Unit))) --> 1835 { tty_feedback }, 1836 !. 1837message(plunit(begin(Unit))) --> 1838 [ 'Start unit: ~w~n'-[Unit], flush ]. 1839message(plunit(end(_Unit, _Summary))) --> 1840 { tty_feedback }, 1841 !. 1842message(plunit(end(Unit, Summary))) --> 1843 ( {test_summary_passed(Summary)} 1844 -> [ 'End unit ~w: passed (~3f sec CPU)'-[Unit, Summary.time.cpu] ] 1845 ; [ ansi(error, 'End unit ~w: **FAILED (~3f sec CPU)', [Unit, Summary.time.cpu]) ] 1846 ). 1847message(plunit(blocked(unit(Unit, Reason)))) --> 1848 [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ]. 1849message(plunit(running([]))) --> 1850 !, 1851 [ 'PL-Unit: no tests running' ]. 1852message(plunit(running([One]))) --> 1853 !, 1854 [ 'PL-Unit: running ' ], 1855 running(One). 1856message(plunit(running(More))) --> 1857 !, 1858 [ 'PL-Unit: running tests:', nl ], 1859 running(More). 1860message(plunit(fixme([]))) --> !. 1861message(plunit(fixme(Tuples))) --> 1862 !, 1863 fixme_message(Tuples). 1864message(plunit(total_time(Time))) --> 1865 [ 'Test run completed'-[] ], 1866 test_time(Time). 1867 1868 % Blocked tests 1869message(plunit(blocked(1, Tests))) --> 1870 !, 1871 [ 'one test is blocked'-[] ], 1872 blocked_tests(Tests). 1873message(plunit(blocked(N, Tests))) --> 1874 [ '~D tests are blocked'-[N] ], 1875 blocked_tests(Tests). 1876 1877blocked_tests(Tests) --> 1878 { current_test_flag(show_blocked, true) }, 1879 !, 1880 [':'-[]], 1881 list_blocked(Tests). 1882blocked_tests(_) --> 1883 [ ' (use run_tests/2 with ', ansi(code, 'show_blocked(true)', []), 1884 ' for details)'-[] 1885 ]. 1886 1887list_blocked([]) --> !. 1888list_blocked([blocked(Unit:Test, Pos, Reason)|T]) --> 1889 [nl], 1890 locationprefix(Pos), 1891 test_name(Unit:Test, -), 1892 [ ': ~w'-[Reason] ], 1893 list_blocked(T). 1894 1895 % fail/success 1896message(plunit(no_tests)) --> 1897 !, 1898 [ 'No tests to run' ]. 1899message(plunit(all_passed(1, 1, Time))) --> 1900 !, 1901 [ 'test passed' ], 1902 test_time(Time). 1903message(plunit(all_passed(Total, Total, Time))) --> 1904 !, 1905 [ 'All ~D tests passed'-[Total] ], 1906 test_time(Time). 1907message(plunit(all_passed(Total, Count, Time))) --> 1908 !, 1909 { SubTests is Count-Total }, 1910 [ 'All ~D (+~D sub-tests) tests passed'- [Total, SubTests] ], 1911 test_time(Time). 1912 1913test_time(Time) --> 1914 { var(Time) }, !. 1915test_time(Time) --> 1916 [ ' in ~3f seconds (~3f cpu)'-[Time.wall, Time.cpu] ]. 1917 1918message(plunit(passed(Count))) --> 1919 !, 1920 [ '~D tests passed'-[Count] ]. 1921message(plunit(failed(0))) --> 1922 !, 1923 []. 1924message(plunit(failed(1))) --> 1925 !, 1926 [ '1 test failed'-[] ]. 1927message(plunit(failed(N))) --> 1928 [ '~D tests failed'-[N] ]. 1929message(plunit(timeout(0))) --> 1930 !, 1931 []. 1932message(plunit(timeout(N))) --> 1933 [ '~D tests timed out'-[N] ]. 1934message(plunit(fixme(0,0,0))) --> 1935 []. 1936message(plunit(fixme(Failed,0,0))) --> 1937 !, 1938 [ 'all ~D tests flagged FIXME failed'-[Failed] ]. 1939message(plunit(fixme(Failed,Passed,0))) --> 1940 [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ]. 1941message(plunit(fixme(Failed,Passed,Nondet))) --> 1942 { TotalPassed is Passed+Nondet }, 1943 [ 'FIXME: ~D failed; ~D passed; (~D nondet)'- 1944 [Failed, TotalPassed, Nondet] ]. 1945 1946message(plunit(begin(Unit:Test, _Location, Progress))) --> 1947 { tty_columns(SummaryWidth, _Margin), 1948 test_name_summary(Unit:Test, SummaryWidth, NameS), 1949 progress_string(Progress, ProgressS) 1950 }, 1951 ( { tty_feedback, 1952 tty_clear_to_eol(CE) 1953 } 1954 -> [ at_same_line, '\r[~w] ~w ..~w'-[ProgressS, NameS, 1955 CE], flush ] 1956 ; { jobs(_) } 1957 -> [ '[~w] ~w ..'-[ProgressS, NameS] ] 1958 ; [ '[~w] ~w ..'-[ProgressS, NameS], flush ] 1959 ). 1960message(plunit(end(_UnitTest, _Location, _Progress))) --> 1961 []. 1962message(plunit(progress(_UnitTest, Status, _Progress, _Time))) --> 1963 { Status = forall(_,_) 1964 ; Status == assertion 1965 }, 1966 !. 1967message(plunit(progress(Unit:Test, Status, Progress, Time))) --> 1968 { jobs(_), 1969 !, 1970 tty_columns(SummaryWidth, Margin), 1971 test_name_summary(Unit:Test, SummaryWidth, NameS), 1972 progress_string(Progress, ProgressS), 1973 progress_tag(Status, Tag, _Keep, Style) 1974 }, 1975 [ ansi(Style, '[~w] ~w ~`.t ~w (~3f sec)~*|', 1976 [ProgressS, NameS, Tag, Time.wall, Margin]) ]. 1977message(plunit(progress(_UnitTest, Status, _Progress, Time))) --> 1978 { tty_columns(_SummaryWidth, Margin), 1979 progress_tag(Status, Tag, _Keep, Style) 1980 }, 1981 [ at_same_line, ansi(Style, '~`.t ~w (~3f sec)~*|', 1982 [Tag, Time.wall, Margin]) ], 1983 ( { tty_feedback } 1984 -> [flush] 1985 ; [] 1986 ). 1987message(plunit(failed(Unit:Test, Progress, Line, Failure, _Time, Output))) --> 1988 { unit_file(Unit, File) }, 1989 locationprefix(File:Line), 1990 test_name(Unit:Test, Progress), 1991 [': '-[] ], 1992 failure(Failure), 1993 test_output(Output). 1994message(plunit(timeout(Unit:Test, Progress, Line, Limit, Output))) --> 1995 { unit_file(Unit, File) }, 1996 locationprefix(File:Line), 1997 test_name(Unit:Test, Progress), 1998 [': '-[] ], 1999 timeout(Limit), 2000 test_output(Output). 2001:- if(swi). 2002message(plunit(failed_assertion(Unit:Test, Line, AssertLoc, 2003 Progress, Reason, Goal))) --> 2004 { unit_file(Unit, File) }, 2005 locationprefix(File:Line), 2006 test_name(Unit:Test, Progress), 2007 [ ': assertion'-[] ], 2008 assertion_location(AssertLoc, File), 2009 assertion_reason(Reason), ['\n\t'], 2010 assertion_goal(Unit, Goal). 2011 2012assertion_location(File:Line, File) --> 2013 [ ' at line ~w'-[Line] ]. 2014assertion_location(File:Line, _) --> 2015 [ ' at ', url(File:Line) ]. 2016assertion_location(unknown, _) --> 2017 []. 2018 2019assertion_reason(fail) --> 2020 !, 2021 [ ' failed'-[] ]. 2022assertion_reason(Error) --> 2023 { message_to_string(Error, String) }, 2024 [ ' raised "~w"'-[String] ]. 2025 2026assertion_goal(Unit, Goal) --> 2027 { unit_module(Unit, Module), 2028 unqualify(Goal, Module, Plain) 2029 }, 2030 [ 'Assertion: ~p'-[Plain] ]. 2031 2032unqualify(Var, _, Var) :- 2033 var(Var), 2034 !. 2035unqualify(M:Goal, Unit, Goal) :- 2036 nonvar(M), 2037 unit_module(Unit, M), 2038 !. 2039unqualify(M:Goal, _, Goal) :- 2040 callable(Goal), 2041 predicate_property(M:Goal, imported_from(system)), 2042 !. 2043unqualify(Goal, _, Goal). 2044 2045test_output("") --> []. 2046test_output(Output) --> 2047 [ ansi(code, '~s', [Output]) ]. 2048 2049:- endif. 2050 % Setup/condition errors 2051message(plunit(error(Where, Context, _Output, throw(Exception)))) --> 2052 locationprefix(Context), 2053 { message_to_string(Exception, String) }, 2054 [ 'error in ~w: ~w'-[Where, String] ]. 2055message(plunit(error(Where, Context, _Output, false))) --> 2056 locationprefix(Context), 2057 [ 'setup failed in ~w'-[Where] ]. 2058 2059 % delayed output 2060message(plunit(test_output(_, Output))) --> 2061 [ '~s'-[Output] ]. 2062 % Interrupts (SWI) 2063:- if(swi). 2064message(interrupt(begin)) --> 2065 { thread_self(Me), 2066 running(Unit, Test, Line, Progress, Me), 2067 !, 2068 unit_file(Unit, File), 2069 restore_output_state 2070 }, 2071 [ 'Interrupted test '-[] ], 2072 running(running(Unit:Test, File:Line, Progress, Me)), 2073 [nl], 2074 '$messages':prolog_message(interrupt(begin)). 2075message(interrupt(begin)) --> 2076 '$messages':prolog_message(interrupt(begin)). 2077:- endif. 2078 2079message(concurrent) --> 2080 [ 'concurrent(true) at the level of units is currently ignored.', nl, 2081 'See set_test_options/1 with jobs(Count) for concurrent testing.' 2082 ]. 2083 2084test_name(Name, forall(Bindings, _Nth-I)) --> 2085 !, 2086 test_name(Name, -), 2087 [ ' (~d-th forall bindings = '-[I], 2088 ansi(code, '~p', [Bindings]), ')'-[] 2089 ]. 2090test_name(Name, _) --> 2091 !, 2092 [ 'test ', ansi(code, '~q', [Name]) ]. 2093 2094running(running(Unit:Test, File:Line, _Progress, Thread)) --> 2095 thread(Thread), 2096 [ '~q:~q at '-[Unit, Test], url(File:Line) ]. 2097running([H|T]) --> 2098 ['\t'], running(H), 2099 ( {T == []} 2100 -> [] 2101 ; [nl], running(T) 2102 ). 2103 2104thread(main) --> !. 2105thread(Other) --> 2106 [' [~w] '-[Other] ]. 2107 2108:- if(swi). 2109write_term(T, OPS) --> 2110 ['~W'-[T,OPS] ]. 2111:- else. 2112write_term(T, _OPS) --> 2113 ['~q'-[T]]. 2114:- endif. 2115 2116expected_got_ops_(Ex, E, OPS, Goals) --> 2117 [' Expected: '-[]], write_term(Ex, OPS), [nl], 2118 [' Got: '-[]], write_term(E, OPS), [], 2119 ( { Goals = [] } -> [] 2120 ; [nl, ' with: '-[]], write_term(Goals, OPS), [] 2121 ). 2122 2123 2124failure(List) --> 2125 { is_list(List) }, 2126 !, 2127 [ nl ], 2128 failures(List). 2129failure(Var) --> 2130 { var(Var) }, 2131 !, 2132 [ 'Unknown failure?' ]. 2133failure(succeeded(Time)) --> 2134 !, 2135 [ 'must fail but succeeded in ~2f seconds~n'-[Time] ]. 2136failure(wrong_error(Expected, Error)) --> 2137 !, 2138 { copy_term(Expected-Error, Ex-E, Goals), 2139 numbervars(Ex-E-Goals, 0, _), 2140 write_options(OPS) 2141 }, 2142 [ 'wrong error'-[], nl ], 2143 expected_got_ops_(Ex, E, OPS, Goals). 2144failure(wrong_answer(cmp(Var, Cmp))) --> 2145 { Cmp =.. [Op,Answer,Expected], 2146 !, 2147 copy_term(Expected-Answer, Ex-A, Goals), 2148 numbervars(Ex-A-Goals, 0, _), 2149 write_options(OPS) 2150 }, 2151 [ 'wrong answer for ', ansi(code, '~w', [Var]), 2152 ' (compared using ~w)'-[Op], nl ], 2153 expected_got_ops_(Ex, A, OPS, Goals). 2154failure(wrong_answer(Cmp)) --> 2155 { Cmp =.. [Op,Answer,Expected], 2156 !, 2157 copy_term(Expected-Answer, Ex-A, Goals), 2158 numbervars(Ex-A-Goals, 0, _), 2159 write_options(OPS) 2160 }, 2161 [ 'wrong answer (compared using ~w)'-[Op], nl ], 2162 expected_got_ops_(Ex, A, OPS, Goals). 2163failure(wrong_answer(CmpExpected, Bindings)) --> 2164 { ( CmpExpected = all(Cmp) 2165 -> Cmp =.. [_Op1,_,Expected], 2166 Got = Bindings, 2167 Type = all 2168 ; CmpExpected = set(Cmp), 2169 Cmp =.. [_Op2,_,Expected0], 2170 sort(Expected0, Expected), 2171 sort(Bindings, Got), 2172 Type = set 2173 ) 2174 }, 2175 [ 'wrong "~w" answer:'-[Type] ], 2176 [ nl, ' Expected: ~q'-[Expected] ], 2177 [ nl, ' Found: ~q'-[Got] ]. 2178:- if(swi). 2179failure(cmp_error(_Cmp, Error)) --> 2180 { message_to_string(Error, Message) }, 2181 [ 'Comparison error: ~w'-[Message] ]. 2182failure(throw(Error)) --> 2183 { Error = error(_,_), 2184 !, 2185 message_to_string(Error, Message) 2186 }, 2187 [ 'received error: ~w'-[Message] ]. 2188:- endif. 2189failure(Why) --> 2190 [ '~p'-[Why] ]. 2191 2192failures([]) --> 2193 !. 2194failures([H|T]) --> 2195 !, 2196 failure(H), [nl], 2197 failures(T). 2198 2199timeout(Limit) --> 2200 [ 'Timeout exceeeded (~2f sec)'-[Limit] ]. 2201 2202fixme_message([]) --> []. 2203fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) --> 2204 { unit_file(Unit, File) }, 2205 fixme_message(File:Line, Reason, How), 2206 ( {T == []} 2207 -> [] 2208 ; [nl], 2209 fixme_message(T) 2210 ). 2211 2212fixme_message(Location, Reason, failed) --> 2213 [ 'FIXME: ~w: ~w'-[Location, Reason] ]. 2214fixme_message(Location, Reason, passed) --> 2215 [ 'FIXME: ~w: passed ~w'-[Location, Reason] ]. 2216fixme_message(Location, Reason, nondet) --> 2217 [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ]. 2218 2219 2220write_options([ numbervars(true), 2221 quoted(true), 2222 portray(true), 2223 max_depth(100), 2224 attributes(portray) 2225 ]).
2232test_name_summary(Term, MaxLen, Summary) :- 2233 summary_string(Term, Text), 2234 atom_length(Text, Len), 2235 ( Len =< MaxLen 2236 -> Summary = Text 2237 ; End is MaxLen//2, 2238 Pre is MaxLen - End - 2, 2239 sub_string(Text, 0, Pre, _, PreText), 2240 sub_string(Text, _, End, 0, PostText), 2241 format(string(Summary), '~w..~w', [PreText,PostText]) 2242 ). 2243 2244summary_string(Unit:Test, String) => 2245 summary_string(Test, String1), 2246 atomics_to_string([Unit, String1], :, String). 2247summary_string(@(Name,Vars), String) => 2248 format(string(String), '~W (using ~W)', 2249 [ Name, [numbervars(true), quoted(false)], 2250 Vars, [numbervars(true), portray(true), quoted(true)] 2251 ]). 2252summary_string(Name, String) => 2253 term_string(Name, String, [numbervars(true), quoted(false)]).
2259progress_string(forall(_Vars, N-I)/Total, S) => 2260 format(string(S), '~w-~w/~w', [N,I,Total]). 2261progress_string(Progress, S) => 2262 term_string(Progress, S).
2270progress_tag(passed, Tag, Keep, Style) => 2271 Tag = passed, Keep = false, Style = comment. 2272progress_tag(fixme(passed), Tag, Keep, Style) => 2273 Tag = passed, Keep = false, Style = comment. 2274progress_tag(fixme(_), Tag, Keep, Style) => 2275 Tag = fixme, Keep = true, Style = warning. 2276progress_tag(nondet, Tag, Keep, Style) => 2277 Tag = '**NONDET', Keep = true, Style = warning. 2278progress_tag(timeout(_Limit), Tag, Keep, Style) => 2279 Tag = '**TIMEOUT', Keep = true, Style = warning. 2280progress_tag(assertion, Tag, Keep, Style) => 2281 Tag = '**FAILED', Keep = true, Style = error. 2282progress_tag(failed, Tag, Keep, Style) => 2283 Tag = '**FAILED', Keep = true, Style = error. 2284progress_tag(forall(_,0), Tag, Keep, Style) => 2285 Tag = passed, Keep = false, Style = comment. 2286progress_tag(forall(_,_), Tag, Keep, Style) => 2287 Tag = '**FAILED', Keep = true, Style = error. 2288 2289 2290 /******************************* 2291 * OUTPUT * 2292 *******************************/ 2293 2294save_output_state :- 2295 stream_property(Output, alias(user_output)), 2296 stream_property(Error, alias(user_error)), 2297 asserta(output_streams(Output, Error)). 2298 2299restore_output_state :- 2300 output_streams(Output, Error), 2301 !, 2302 set_stream(Output, alias(user_output)), 2303 set_stream(Error, alias(user_error)). 2304restore_output_state. 2305 2306 2307 2308 /******************************* 2309 * CONCURRENT STATUS * 2310 *******************************/ 2311 2312/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2313This part deals with interactive feedback when we are running multiple 2314threads. The terminal window cannot work on top of the Prolog message 2315infrastructure and (thus) we have to use more low-level means. 2316- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2317 2318:- dynamic 2319 jobs/1, % Count 2320 job_window/1, % Count 2321 job_status_line/3. % Job, Format, Args 2322 2323job_feedback(_, jobs(Jobs)) :- 2324 retractall(jobs(_)), 2325 Jobs > 1, 2326 asserta(jobs(Jobs)), 2327 tty_feedback, 2328 !, 2329 retractall(job_window(_)), 2330 asserta(job_window(Jobs)), 2331 retractall(job_status_line(_,_,_)), 2332 jobs_redraw. 2333job_feedback(_, jobs(Jobs)) :- 2334 !, 2335 retractall(job_window(_)), 2336 info(plunit(jobs(Jobs))). 2337job_feedback(_, Msg) :- 2338 job_window(_), 2339 !, 2340 with_mutex(plunit_feedback, job_feedback(Msg)). 2341job_feedback(Level, Msg) :- 2342 print_message(Level, plunit(Msg)). 2343 2344job_feedback(begin(Unit:Test, _Location, Progress)) => 2345 tty_columns(SummaryWidth, _Margin), 2346 test_name_summary(Unit:Test, SummaryWidth, NameS), 2347 progress_string(Progress, ProgressS), 2348 tty_clear_to_eol(CE), 2349 job_format(comment, '\r[~w] ~w ..~w', 2350 [ProgressS, NameS, CE]), 2351 flush_output. 2352job_feedback(end(_UnitTest, _Location, _Progress)) => 2353 true. 2354job_feedback(progress(_UnitTest, Status, _Progress, Time)) => 2355 ( hide_progress(Status) 2356 -> true 2357 ; tty_columns(_SummaryWidth, Margin), 2358 progress_tag(Status, Tag, _Keep, Style), 2359 job_finish(Style, '~`.t ~w (~3f sec)~*|', 2360 [Tag, Time.wall, Margin]) 2361 ). 2362job_feedback(failed(UnitTest, Progress, Line, Error, Time, Output)) => 2363 tty_columns(_SummaryWidth, Margin), 2364 progress_tag(failed, Tag, _Keep, Style), 2365 job_finish(Style, '~`.t ~w (~3f sec)~*|', 2366 [Tag, Time.wall, Margin]), 2367 print_test_output(Error, Output), 2368 ( ( Error = timeout(_) % Status line suffices 2369 ; Error == assertion % We will get an failed test later 2370 ) 2371 -> true 2372 ; print_message(Style, plunit(failed(UnitTest, Progress, Line, 2373 Error, Time, ""))) 2374 ), 2375 jobs_redraw. 2376job_feedback(begin(_Unit)) => true. 2377job_feedback(end(_Unit, _Summary)) => true. 2378 2379hide_progress(assertion). 2380hide_progress(forall(_,_)). 2381hide_progress(failed). 2382hide_progress(timeout(_)). 2383 2384print_test_output(_, "") => true. 2385print_test_output(assertion, Output) => 2386 print_message(debug, plunit(test_output(error, Output))). 2387print_test_output(_, Output) => 2388 print_message(debug, plunit(test_output(informational, Output))).
2394jobs_redraw :- 2395 job_window(N), 2396 !, 2397 tty_columns(_, Width), 2398 tty_header_line(Width), 2399 forall(between(1,N,Line), job_redraw_worker(Line)), 2400 tty_header_line(Width). 2401jobs_redraw. 2402 2403job_redraw_worker(Line) :- 2404 ( job_status_line(Line, Fmt, Args) 2405 -> ansi_format(comment, Fmt, Args) 2406 ; true 2407 ), 2408 nl.
2416job_format(Style, Fmt, Args) :-
2417 job_self(Job),
2418 job_format(Job, Style, Fmt, Args, true).2426job_finish(Style, Fmt, Args) :- 2427 job_self(Job), 2428 job_finish(Job, Style, Fmt, Args). 2429 2430:- det(job_finish/4). 2431job_finish(Job, Style, Fmt, Args) :- 2432 retract(job_status_line(Job, Fmt0, Args0)), 2433 !, 2434 string_concat(Fmt0, Fmt, Fmt1), 2435 append(Args0, Args, Args1), 2436 job_format(Job, Style, Fmt1, Args1, false). 2437 2438:- det(job_format/5). 2439job_format(Job, Style, Fmt, Args, Save) :- 2440 job_window(Jobs), 2441 Up is Jobs+2-Job, 2442 flush_output(user_output), 2443 tty_up_and_clear(Up), 2444 ansi_format(Style, Fmt, Args), 2445 ( Save == true 2446 -> retractall(job_status_line(Job, _, _)), 2447 asserta(job_status_line(Job, Fmt, Args)) 2448 ; true 2449 ), 2450 tty_down_and_home(Up), 2451 flush_output(user_output). 2452 2453:- det(job_self/1). 2454job_self(Job) :- 2455 job_window(N), 2456 N > 1, 2457 thread_self(Me), 2458 split_string(Me, '_', '', [_,_,S]), 2459 number_string(Job, S).
tty format, which reuses the current
output line if the test is successful.2466tty_feedback :- 2467 has_tty, 2468 current_test_flag(format, tty). 2469 2470has_tty :- 2471 stream_property(user_output, tty(true)). 2472 2473tty_columns(SummaryWidth, Margin) :- 2474 tty_width(W), 2475 Margin is W-8, 2476 SummaryWidth is max(20,Margin-34). 2477 2478tty_width(W) :- 2479 current_predicate(tty_size/2), 2480 catch(tty_size(_Rows, Cols), error(_,_), fail), 2481 Cols > 25, 2482 !, 2483 W = Cols. 2484tty_width(80). 2485 2486tty_header_line(Width) :- 2487 ansi_format(comment, '~N~`\u2015t~*|~n', [Width]). 2488 2489:- if(current_predicate(tty_get_capability/3)). 2490tty_clear_to_eol(S) :- 2491 tty_get_capability(ce, string, S), 2492 !. 2493:- endif. 2494tty_clear_to_eol('\e[K'). 2495 2496tty_up_and_clear(Lines) :- 2497 format(user_output, '\e[~dA\r\e[K', [Lines]). 2498 2499tty_down_and_home(Lines) :- 2500 format(user_output, '\e[~dB\r', [Lines]). 2501 2502:- if(swi). 2503 2504:- multifile 2505 prolog:message/3, 2506 user:message_hook/3. 2507 2508prologmessage(Term) --> 2509 message(Term). 2510 2511% user:message_hook(+Term, +Kind, +Lines) 2512 2513user:message_hook(make(done(Files)), _, _) :- 2514 make_run_tests(Files), 2515 fail. % give other hooks a chance 2516 2517:- endif. 2518 2519:- if(sicstus). 2520 2521usergenerate_message_hook(Message) --> 2522 message(Message), 2523 [nl]. % SICStus requires nl at the end
2532user:message_hook(informational, plunit(begin(Unit)), _Lines) :- 2533 format(user_error, '% PL-Unit: ~w ', [Unit]), 2534 flush_output(user_error). 2535user:message_hook(informational, plunit(end(_Unit)), _Lines) :- 2536 format(user, ' done~n', []). 2537 2538:- endif.
Unit Testing
Unit testing environment for SWI-Prolog and SICStus Prolog. For usage, please visit https://www.swi-prolog.org/pldoc/package/plunit. */