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