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). 85sicstus :- catch(current_prolog_flag(dialect, sicstus), _, fail). 86 87throw_error(Error_term,Impldef) :- 88 throw(error(Error_term,context(Impldef,_))). 89 90:- set_prolog_flag(generate_debug_info, false). 91current_test_flag(optimise, Value) => 92 current_prolog_flag(optimise, Value). 93current_test_flag(occurs_check, Value) => 94 ( current_prolog_flag(plunit_occurs_check, Value0) 95 -> Value = Value0 96 ; current_prolog_flag(occurs_check, Value) 97 ). 98current_test_flag(Name, Value), atom(Name) => 99 atom_concat(plunit_, Name, Flag), 100 current_prolog_flag(Flag, Value). 101current_test_flag(Name, Value), var(Name) => 102 global_test_option(Opt, _, _Type, _Default), 103 functor(Opt, Name, 1), 104 current_test_flag(Name, Value). 105 106set_test_flag(Name, Value) :- 107 Opt =.. [Name, Value], 108 global_test_option(Opt), 109 !, 110 atom_concat(plunit_, Name, Flag), 111 set_prolog_flag(Flag, Value). 112set_test_flag(Name, _) :- 113 domain_error(test_flag, Name). 114 115current_test_flags(Flags) :- 116 findall(Flag, current_test_flag(Flag), Flags). 117 118current_test_flag(Opt) :- 119 current_test_flag(Name, Value), 120 Opt =.. [Name, Value]. 121 122% ensure expansion to avoid tracing 123goal_expansion(forall(C,A), 124 \+ (C, \+ A)). 125goal_expansion(current_module(Module,File), 126 module_property(Module, file(File))). 127 128 129 /******************************* 130 * IMPORTS * 131 *******************************/ 132 133:- initialization init_flags. 134 135init_flags :- 136 ( global_test_option(Option, _Value, Type, Default), 137 Default \== (-), 138 Option =.. [Name,_], 139 atom_concat(plunit_, Name, Flag), 140 flag_type(Type, FlagType), 141 create_prolog_flag(Flag, Default, [type(FlagType), keep(true)]), 142 fail 143 ; true 144 ). 145 146flag_type(boolean, FlagType) => FlagType = boolean. 147flag_type(Type, FlagType), Type = oneof(Atoms), maplist(atom, Atoms) => 148 FlagType = Type. 149flag_type(oneof(_), FlagType) => FlagType = term. 150flag_type(positive_integer, FlagType) => FlagType = integer. 151flag_type(number, FlagType) => FlagType = float.
never, always, normal (only if not optimised)manual, make
or make(all).tty or log. tty uses terminal
control to overwrite successful tests, allowing the
user to see the currently running tests and output
from failed tests. This is the default of the output
is a tty. log prints a full log of the executed
tests and their result and is intended for non-interactive
usage.always, emit all output as it is produced, if never,
suppress all output and if on_failure, emit the output
if the test fails.occurs_check flag during
testing.true (default =false), cleanup report at the end
of run_tests/1. Used to improve cooperation with
memory debuggers such as dmalloc.203set_test_options(Options) :- 204 flatten([Options], List), 205 maplist(set_test_option, List). 206 207set_test_option(sto(true)) => 208 print_message(warning, plunit(sto(true))). 209set_test_option(jobs(Jobs)) => 210 must_be(positive_integer, Jobs), 211 set_test_option_flag(jobs(Jobs)). 212set_test_option(Option), 213 compound(Option), global_test_option(Option) => 214 set_test_option_flag(Option). 215set_test_option(Option) => 216 domain_error(option, Option). 217 218global_test_option(Opt) :- 219 global_test_option(Opt, Value, Type, _Default), 220 must_be(Type, Value). 221 222global_test_option(load(Load), Load, oneof([never,always,normal]), normal). 223global_test_option(output(Cond), Cond, oneof([always,on_failure]), on_failure). 224global_test_option(format(Feedback), Feedback, oneof([tty,log]), tty). 225global_test_option(silent(Silent), Silent, boolean, false). 226global_test_option(show_blocked(Blocked), Blocked, boolean, false). 227global_test_option(run(When), When, oneof([manual,make,make(all)]), make). 228global_test_option(occurs_check(Mode), Mode, oneof([false,true,error]), -). 229global_test_option(cleanup(Bool), Bool, boolean, true). 230global_test_option(jobs(Count), Count, positive_integer, 1). 231global_test_option(timeout(Number), Number, number, 3600). 232 233set_test_option_flag(Option) :- 234 Option =.. [Name, Value], 235 set_test_flag(Name, Value).
241loading_tests :- 242 current_test_flag(load, Load), 243 ( Load == always 244 -> true 245 ; Load == normal, 246 \+ current_test_flag(optimise, true) 247 ). 248 249 /******************************* 250 * MODULE * 251 *******************************/ 252 253:- dynamic 254 loading_unit/4, % Unit, Module, File, OldSource 255 current_unit/4, % Unit, Module, Context, Options 256 test_file_for/2. % ?TestFile, ?PrologFile
end_tests(UnitName).264begin_tests(Unit) :- 265 begin_tests(Unit, []). 266 267begin_tests(Unit, Options) :- 268 must_be(atom, Unit), 269 map_sto_option(Options, Options1), 270 valid_options(test_set_option, Options1), 271 make_unit_module(Unit, Name), 272 source_location(File, Line), 273 begin_tests(Unit, Name, File:Line, Options1). 274 275map_sto_option(Options0, Options) :- 276 select_option(sto(Mode), Options0, Options1), 277 !, 278 map_sto(Mode, Flag), 279 Options = [occurs_check(Flag)|Options1]. 280map_sto_option(Options, Options). 281 282map_sto(rational_trees, Flag) => Flag = false. 283map_sto(finite_trees, Flag) => Flag = true. 284map_sto(Mode, _) => domain_error(sto, Mode). 285 286 287:- if(swi). 288begin_tests(Unit, Name, File:Line, Options) :- 289 loading_tests, 290 !, 291 '$set_source_module'(Context, Context), 292 ( current_unit(Unit, Name, Context, Options) 293 -> true 294 ; retractall(current_unit(Unit, Name, _, _)), 295 assert(current_unit(Unit, Name, Context, Options)) 296 ), 297 '$set_source_module'(Old, Name), 298 '$declare_module'(Name, test, Context, File, Line, false), 299 discontiguous(Name:'unit test'/4), 300 '$set_predicate_attribute'(Name:'unit test'/4, trace, false), 301 discontiguous(Name:'unit body'/2), 302 asserta(loading_unit(Unit, Name, File, Old)). 303begin_tests(Unit, Name, File:_Line, _Options) :- 304 '$set_source_module'(Old, Old), 305 asserta(loading_unit(Unit, Name, File, Old)). 306 307:- else. 308 309% we cannot use discontiguous as a goal in SICStus Prolog. 310 311userterm_expansion((:- begin_tests(Set)), 312 [ (:- begin_tests(Set)), 313 (:- discontiguous(test/2)), 314 (:- discontiguous('unit body'/2)), 315 (:- discontiguous('unit test'/4)) 316 ]). 317 318begin_tests(Unit, Name, File:_Line, Options) :- 319 loading_tests, 320 !, 321 ( current_unit(Unit, Name, _, Options) 322 -> true 323 ; retractall(current_unit(Unit, Name, _, _)), 324 assert(current_unit(Unit, Name, -, Options)) 325 ), 326 asserta(loading_unit(Unit, Name, File, -)). 327begin_tests(Unit, Name, File:_Line, _Options) :- 328 asserta(loading_unit(Unit, Name, File, -)). 329 330:- endif.
339end_tests(Unit) :- 340 loading_unit(StartUnit, _, _, _), 341 !, 342 ( Unit == StartUnit 343 -> once(retract(loading_unit(StartUnit, _, _, Old))), 344 '$set_source_module'(_, Old) 345 ; throw_error(context_error(plunit_close(Unit, StartUnit)), _) 346 ). 347end_tests(Unit) :- 348 throw_error(context_error(plunit_close(Unit, -)), _).
353:- if(swi). 354 355unit_module(Unit, Module) :- 356 atom_concat('plunit_', Unit, Module). 357 358make_unit_module(Unit, Module) :- 359 unit_module(Unit, Module), 360 ( current_module(Module), 361 \+ current_unit(_, Module, _, _), 362 predicate_property(Module:H, _P), 363 \+ predicate_property(Module:H, imported_from(_M)) 364 -> throw_error(permission_error(create, plunit, Unit), 365 'Existing module') 366 ; true 367 ). 368 369:- else. 370 371:- dynamic 372 unit_module_store/2. 373 374unit_module(Unit, Module) :- 375 unit_module_store(Unit, Module), 376 !. 377 378make_unit_module(Unit, Module) :- 379 prolog_load_context(module, Module), 380 assert(unit_module_store(Unit, Module)). 381 382:- endif. 383 384 /******************************* 385 * EXPANSION * 386 *******************************/
test(Name, Options) :- Body into a clause for
'unit test'/4 and 'unit body'/2.393expand_test(Name, Options0, Body, 394 [ 'unit test'(Name, Line, Options, Module:'unit body'(Id, Vars)), 395 ('unit body'(Id, Vars) :- !, Body) 396 ]) :- 397 source_location(_File, Line), 398 prolog_load_context(module, Module), 399 ( prolog_load_context(variable_names, Bindings) 400 -> true 401 ; Bindings = [] 402 ), 403 atomic_list_concat([Name, '@line ', Line], Id), 404 term_variables(Options0, OptionVars0), sort(OptionVars0, OptionVars), 405 term_variables(Body, BodyVars0), sort(BodyVars0, BodyVars), 406 ord_intersection(OptionVars, BodyVars, VarList), 407 Vars =.. [vars|VarList], 408 ( is_list(Options0) % allow for single option without list 409 -> Options1 = Options0 410 ; Options1 = [Options0] 411 ), 412 maplist(expand_option(Bindings), Options1, Options2), 413 join_true_options(Options2, Options3), 414 map_sto_option(Options3, Options4), 415 valid_options(test_option, Options4), 416 valid_test_mode(Options4, Options). 417 418expand_option(_, Var, _) :- 419 var(Var), 420 !, 421 throw_error(instantiation_error,_). 422expand_option(Bindings, Cmp, true(Cond)) :- 423 cmp(Cmp), 424 !, 425 var_cmp(Bindings, Cmp, Cond). 426expand_option(_, error(X), throws(error(X, _))) :- !. 427expand_option(_, exception(X), throws(X)) :- !. % SICStus 4 compatibility 428expand_option(_, error(F,C), throws(error(F,C))) :- !. % SICStus 4 compatibility 429expand_option(_, true, true(true)) :- !. 430expand_option(_, O, O). 431 432cmp(_ == _). 433cmp(_ = _). 434cmp(_ =@= _). 435cmp(_ =:= _). 436 437var_cmp(Bindings, Expr, cmp(Name, Expr)) :- 438 arg(_, Expr, Var), 439 var(Var), 440 member(Name=V, Bindings), 441 V == Var, 442 !. 443var_cmp(_, Expr, Expr). 444 445join_true_options(Options0, Options) :- 446 partition(true_option, Options0, True, Rest), 447 True \== [], 448 !, 449 maplist(arg(1), True, Conds0), 450 flatten(Conds0, Conds), 451 Options = [true(Conds)|Rest]. 452join_true_options(Options, Options). 453 454true_option(true(_)). 455 456valid_test_mode(Options0, Options) :- 457 include(test_mode, Options0, Tests), 458 ( Tests == [] 459 -> Options = [true([true])|Options0] 460 ; Tests = [_] 461 -> Options = Options0 462 ; throw_error(plunit(incompatible_options, Tests), _) 463 ). 464 465test_mode(true(_)). 466test_mode(all(_)). 467test_mode(set(_)). 468test_mode(fail). 469test_mode(throws(_)).
474expand(end_of_file, _) :- 475 loading_unit(Unit, _, _, _), 476 !, 477 end_tests(Unit), % warn? 478 fail. 479expand((:-end_tests(_)), _) :- 480 !, 481 fail. 482expand(_Term, []) :- 483 \+ loading_tests. 484expand((test(Name) :- Body), Clauses) :- 485 !, 486 expand_test(Name, [], Body, Clauses). 487expand((test(Name, Options) :- Body), Clauses) :- 488 !, 489 expand_test(Name, Options, Body, Clauses). 490expand(test(Name), _) :- 491 !, 492 throw_error(existence_error(body, test(Name)), _). 493expand(test(Name, _Options), _) :- 494 !, 495 throw_error(existence_error(body, test(Name)), _). 496 497:- multifile 498 system:term_expansion/2. 499 500systemterm_expansion(Term, Expanded) :- 501 ( loading_unit(_, _, File, _) 502 -> source_location(ThisFile, _), 503 ( File == ThisFile 504 -> true 505 ; source_file_property(ThisFile, included_in(File, _)) 506 ), 507 expand(Term, Expanded) 508 ). 509 510 511 /******************************* 512 * OPTIONS * 513 *******************************/
522valid_options(Pred, Options) :- 523 must_be(list, Options), 524 verify_options(Options, Pred). 525 526verify_options([], _). 527verify_options([H|T], Pred) :- 528 ( call(Pred, H) 529 -> verify_options(T, Pred) 530 ; throw_error(domain_error(Pred, H), _) 531 ). 532 533valid_options(Pred, Options0, Options, Rest) :- 534 must_be(list, Options0), 535 partition(Pred, Options0, Options, Rest).
test(Name, Options).541test_option(Option) :- 542 test_set_option(Option), 543 !. 544test_option(true(_)). 545test_option(fail). 546test_option(throws(_)). 547test_option(all(_)). 548test_option(set(_)). 549test_option(nondet). 550test_option(fixme(_)). 551test_option(forall(X)) :- 552 must_be(callable, X). 553test_option(timeout(Seconds)) :- 554 must_be(number, Seconds).
begin_tests(Name,
Options).561test_set_option(blocked(X)) :- 562 must_be(ground, X). 563test_set_option(condition(X)) :- 564 must_be(callable, X). 565test_set_option(setup(X)) :- 566 must_be(callable, X). 567test_set_option(cleanup(X)) :- 568 must_be(callable, X). 569test_set_option(occurs_check(V)) :- 570 must_be(oneof([false,true,error]), V). 571test_set_option(concurrent(V)) :- 572 must_be(boolean, V), 573 print_message(informational, plunit(concurrent)). 574test_set_option(timeout(Seconds)) :- 575 must_be(number, Seconds). 576 577 /******************************* 578 * UTIL * 579 *******************************/ 580 581:- meta_predicate 582 reify_tmo(, , ), 583 reify(, ), 584 capture_output(,), 585 capture_output(,,), 586 got_messages(,).
590:- if(current_predicate(call_with_time_limit/2)). 591reify_tmo(Goal, Result, Options) :- 592 option(timeout(Time), Options), 593 Time > 0, 594 !, 595 reify(call_with_time_limit(Time, Goal), Result0), 596 ( Result0 = throw(time_limit_exceeded) 597 -> Result = throw(time_limit_exceeded(Time)) 598 ; Result = Result0 599 ). 600:- endif. 601reify_tmo(Goal, Result, _Options) :- 602 reify(Goal, Result).
true, false or
throw(E).
609reify(Goal, Result) :-
610 ( catch(Goal, E, true)
611 -> ( var(E)
612 -> Result = true
613 ; Result = throw(E)
614 )
615 ; Result = false
616 ).625capture_output(Goal, Output) :- 626 current_test_flag(output, OutputMode), 627 capture_output(Goal, Output, [output(OutputMode)]). 628 629capture_output(Goal, Msgs-Output, Options) :- 630 option(output(How), Options, always), 631 ( How == always 632 -> call(Goal), 633 Msgs = false % irrelavant 634 ; with_output_to(string(Output), got_messages(Goal, Msgs), 635 [ capture([user_output, user_error]), 636 color(true) 637 ]) 638 ).
642got_messages(Goal, Result) :- 643 ( current_prolog_flag(on_warning, status) 644 ; current_prolog_flag(on_error, status) 645 ), !, 646 nb_delete(plunit_got_message), 647 setup_call_cleanup( 648 asserta(( user:thread_message_hook(_Term, Kind, _Lines) :- 649 got_message(Kind), fail), Ref), 650 Goal, 651 erase(Ref)), 652 ( nb_current(plunit_got_message, true) 653 -> Result = true 654 ; Result = false 655 ). 656got_messages(Goal, false) :- 657 call(Goal). 658 659:- public got_message/1. 660got_message(warning) :- 661 current_prolog_flag(on_warning, status), !, 662 nb_setval(plunit_got_message, true). 663got_message(error) :- 664 current_prolog_flag(on_error, status), !, 665 nb_setval(plunit_got_message, true). 666 667 668 /******************************* 669 * RUNNING TOPLEVEL * 670 *******************************/ 671 672:- dynamic 673 output_streams/2, % Output, Error 674 test_count/1, % Count 675 passed/5, % Unit, Test, Line, Det, Time 676 failed/5, % Unit, Test, Line, Reason, Time 677 timeout/5, % Unit, Test, Line, Limit, Time 678 failed_assertion/7, % Unit, Test, Line, ALoc, STO, Reason, Goal 679 blocked/4, % Unit, Test, Line, Reason 680 fixme/5, % Unit, Test, Line, Reason, Status 681 running/5, % Unit, Test, Line, STO, Thread 682 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:
714run_tests :- 715 run_tests(all). 716 717run_tests(Set) :- 718 run_tests(Set, []). 719 720run_tests(all, Options) :- 721 !, 722 findall(Unit, current_test_unit(Unit,_), Units), 723 run_tests(Units, Options). 724run_tests(Set, Options) :- 725 valid_options(global_test_option, Options, Global, Rest), 726 current_test_flags(Old), 727 setup_call_cleanup( 728 set_test_options(Global), 729 ( flatten([Set], List), 730 maplist(runnable_tests, List, Units), 731 with_mutex(plunit, run_tests_sync(Units, Rest)) 732 ), 733 set_test_options(Old)). 734 735run_tests_sync(Units0, Options) :- 736 cleanup, 737 count_tests(Units0, Units, Count), 738 asserta(test_count(Count)), 739 save_output_state, 740 setup_call_cleanup( 741 setup_jobs(Count), 742 setup_call_cleanup( 743 setup_trap_assertions(Ref), 744 ( call_time(run_units(Units, Options), Time), 745 test_summary(_All, Summary) 746 ), 747 report_and_cleanup(Ref, Time, Options)), 748 cleanup_jobs), 749 ( option(summary(Summary), Options) 750 -> true 751 ; test_summary_passed(Summary) % fail if some test failed 752 ).
759report_and_cleanup(Ref, Time, Options) :-
760 cleanup_trap_assertions(Ref),
761 report(Time, Options),
762 cleanup_after_test.
769run_units(Units, _Options) :-
770 maplist(schedule_unit, Units),
771 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.780:- det(runnable_tests/2). 781runnable_tests(Spec, Unit:RunnableTests) :- 782 unit_from_spec(Spec, Unit, Tests, Module, UnitOptions), 783 ( option(blocked(Reason), UnitOptions) 784 -> info(plunit(blocked(unit(Unit, Reason)))), 785 RunnableTests = [] 786 ; \+ condition(Module, unit(Unit), UnitOptions) 787 -> RunnableTests = [] 788 ; var(Tests) 789 -> findall(TestID, 790 runnable_test(Unit, _Test, Module, TestID), 791 RunnableTests) 792 ; flatten([Tests], TestList), 793 findall(TestID, 794 ( member(Test, TestList), 795 runnable_test(Unit,Test,Module, TestID) 796 ), 797 RunnableTests) 798 ). 799 800runnable_test(Unit, Name, Module, @(Test,Line)) :- 801 current_test(Unit, Name, Line, _Body, TestOptions), 802 ( option(blocked(Reason), TestOptions) 803 -> Test = blocked(Name, Reason) 804 ; condition(Module, test(Unit,Name,Line), TestOptions), 805 Test = Name 806 ). 807 808unit_from_spec(Unit0:Tests0, Unit, Tests, Module, Options), atom(Unit0) => 809 Unit = Unit0, 810 Tests = Tests0, 811 ( current_unit(Unit, Module, _Supers, Options) 812 -> true 813 ; throw_error(existence_error(unit_test, Unit), _) 814 ). 815unit_from_spec(Unit0, Unit, _, Module, Options), atom(Unit0) => 816 Unit = Unit0, 817 ( current_unit(Unit, Module, _Supers, Options) 818 -> true 819 ; throw_error(existence_error(unit_test, Unit), _) 820 ).
forall(Generator, Test) counts
as a single test. During the execution, the concrete tests of the
forall are considered "sub tests".828count_tests(Units0, Units, Count) :- 829 count_tests(Units0, Units, 0, Count). 830 831count_tests([], T, C0, C) => 832 T = [], 833 C = C0. 834count_tests([_:[]|T0], T, C0, C) => 835 count_tests(T0, T, C0, C). 836count_tests([Unit:Tests|T0], T, C0, C) => 837 partition(is_blocked, Tests, Blocked, Use), 838 maplist(assert_blocked(Unit), Blocked), 839 ( Use == [] 840 -> count_tests(T0, T, C0, C) 841 ; length(Use, N), 842 C1 is C0+N, 843 T = [Unit:Use|T1], 844 count_tests(T0, T1, C1, C) 845 ). 846 847is_blocked(@(blocked(_,_),_)) => true. 848is_blocked(_) => fail. 849 850assert_blocked(Unit, @(blocked(Test, Reason), Line)) => 851 assert(blocked(Unit, Test, Line, Reason)).
858run_unit(_Unit:[]) => 859 true. 860run_unit(Unit:Tests) => 861 unit_module(Unit, Module), 862 unit_options(Unit, UnitOptions), 863 ( setup(Module, unit(Unit), UnitOptions) 864 -> begin_unit(Unit), 865 call_time(run_unit_2(Unit, Tests), Time), 866 test_summary(Unit, Summary), 867 end_unit(Unit, Summary.put(time, Time)), 868 cleanup(Module, UnitOptions) 869 ; job_info(end(unit(Unit, _{error:setup_failed}))) 870 ). 871 872begin_unit(Unit) :- 873 job_info(begin(unit(Unit))), 874 job_feedback(informational, begin(Unit)). 875 876end_unit(Unit, Summary) :- 877 job_info(end(unit(Unit, Summary))), 878 job_feedback(informational, end(Unit, Summary)). 879 880run_unit_2(Unit, Tests) :- 881 forall(member(Test, Tests), 882 run_test(Unit, Test)). 883 884 885unit_options(Unit, Options) :- 886 current_unit(Unit, _Module, _Supers, Options). 887 888 889cleanup :- 890 set_flag(plunit_test, 1), 891 retractall(output_streams(_,_)), 892 retractall(test_count(_)), 893 retractall(passed(_, _, _, _, _)), 894 retractall(failed(_, _, _, _, _)), 895 retractall(timeout(_, _, _, _, _)), 896 retractall(failed_assertion(_, _, _, _, _, _, _)), 897 retractall(blocked(_, _, _, _)), 898 retractall(fixme(_, _, _, _, _)), 899 retractall(running(_,_,_,_,_)), 900 retractall(forall_failures(_,_)). 901 902cleanup_after_test :- 903 ( current_test_flag(cleanup, true) 904 -> cleanup 905 ; true 906 ).
913run_tests_in_files(Files) :- 914 findall(Unit, unit_in_files(Files, Unit), Units), 915 ( Units == [] 916 -> true 917 ; run_tests(Units) 918 ). 919 920unit_in_files(Files, Unit) :- 921 is_list(Files), 922 !, 923 member(F, Files), 924 absolute_file_name(F, Source, 925 [ file_type(prolog), 926 access(read), 927 file_errors(fail) 928 ]), 929 unit_file(Unit, Source). 930 931 932 /******************************* 933 * HOOKING MAKE/0 * 934 *******************************/
940make_run_tests(Files) :- 941 current_test_flag(run, When), 942 ( When == make 943 -> run_tests_in_files(Files) 944 ; When == make(all) 945 -> run_tests 946 ; true 947 ). 948 949 /******************************* 950 * ASSERTION HANDLING * 951 *******************************/ 952 953:- if(swi). 954 955:- dynamic prolog:assertion_failed/2. 956 957setup_trap_assertions(Ref) :- 958 asserta((prolog:assertion_failed(Reason, Goal) :- 959 test_assertion_failed(Reason, Goal)), 960 Ref). 961 962cleanup_trap_assertions(Ref) :- 963 erase(Ref). 964 965test_assertion_failed(Reason, Goal) :- 966 thread_self(Me), 967 running(Unit, Test, Line, Progress, Me), 968 ( catch(get_prolog_backtrace(10, Stack), _, fail), 969 assertion_location(Stack, AssertLoc) 970 -> true 971 ; AssertLoc = unknown 972 ), 973 report_failed_assertion(Unit:Test, Line, AssertLoc, 974 Progress, Reason, Goal), 975 assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc, 976 Progress, Reason, Goal)). 977 978assertion_location(Stack, File:Line) :- 979 append(_, [AssertFrame,CallerFrame|_], Stack), 980 prolog_stack_frame_property(AssertFrame, 981 predicate(prolog_debug:assertion/1)), 982 !, 983 prolog_stack_frame_property(CallerFrame, location(File:Line)). 984 985report_failed_assertion(UnitTest, Line, AssertLoc, 986 Progress, Reason, Goal) :- 987 print_message( 988 error, 989 plunit(failed_assertion(UnitTest, Line, AssertLoc, 990 Progress, Reason, Goal))). 991 992:- else. 993 994setup_trap_assertions(_). 995cleanup_trap_assertions(_). 996 997:- endif. 998 999 1000 /******************************* 1001 * RUNNING A TEST * 1002 *******************************/
1008run_test(Unit, @(Test,Line)) :-
1009 unit_module(Unit, Module),
1010 Module:'unit test'(Test, Line, TestOptions, Body),
1011 unit_options(Unit, UnitOptions),
1012 run_test(Unit, Test, Line, UnitOptions, TestOptions, Body).forall(Generator, Test)1018run_test(Unit, Name, Line, UnitOptions, Options, Body) :- 1019 option(forall(Generator), Options), 1020 !, 1021 unit_module(Unit, Module), 1022 term_variables(Generator, Vars), 1023 start_test(Unit, @(Name,Line), Nth), 1024 State = state(0), 1025 call_time(forall(Module:Generator, % may become concurrent 1026 ( incr_forall(State, I), 1027 run_test_once6(Unit, Name, forall(Vars, Nth-I), Line, 1028 UnitOptions, Options, Body) 1029 )), 1030 Time), 1031 arg(1, State, Generated), 1032 progress(Unit:Name, Nth, forall(end, Nth, Generated), Time). 1033run_test(Unit, Name, Line, UnitOptions, Options, Body) :- 1034 start_test(Unit, @(Name,Line), Nth), 1035 run_test_once6(Unit, Name, Nth, Line, UnitOptions, Options, Body). 1036 1037start_test(_Unit, _TestID, Nth) :- 1038 flag(plunit_test, Nth, Nth+1). 1039 1040incr_forall(State, I) :- 1041 arg(1, State, I0), 1042 I is I0+1, 1043 nb_setarg(1, State, I).
timeout and occurs_check option (Global -> Unit -> Test).1050run_test_once6(Unit, Name, Progress, Line, UnitOptions, Options, Body) :- 1051 current_test_flag(timeout, DefTimeOut), 1052 current_test_flag(occurs_check, DefOccurs), 1053 inherit_option(timeout, Options, [UnitOptions], DefTimeOut, Options1), 1054 inherit_option(occurs_check, Options1, [UnitOptions], DefOccurs, Options2), 1055 run_test_once(Unit, Name, Progress, Line, Options2, Body). 1056 1057inherit_option(Name, Options0, Chain, Default, Options) :- 1058 Term =.. [Name,_Value], 1059 ( option(Term, Options0) 1060 -> Options = Options0 1061 ; member(Opts, Chain), 1062 option(Term, Opts) 1063 -> Options = [Term|Options0] 1064 ; Default == (-) 1065 -> Options = Options0 1066 ; Opt =.. [Name,Default], 1067 Options = [Opt|Options0] 1068 ).
1075run_test_once(Unit, Name, Progress, Line, Options, Body) :- 1076 option(occurs_check(Occurs), Options), 1077 !, 1078 begin_test(Unit, Name, Line, Progress), 1079 current_prolog_flag(occurs_check, Old), 1080 setup_call_cleanup( 1081 set_prolog_flag(occurs_check, Occurs), 1082 capture_output(run_test_6(Unit, Name, Line, Options, Body, Result), 1083 Output), 1084 set_prolog_flag(occurs_check, Old)), 1085 end_test(Unit, Name, Line, Progress), 1086 report_result(Result, Progress, Output, Options). 1087run_test_once(Unit, Name, Progress, Line, Options, Body) :- 1088 begin_test(Unit, Name, Line, Progress), 1089 capture_output(run_test_6(Unit, Name, Line, Options, Body, Result), 1090 Output), 1091 end_test(Unit, Name, Line, Progress), 1092 report_result(Result, Progress, Output, Options).
1096:- det(report_result/4). 1097report_result(failure(Unit, Name, Line, How, Time), 1098 Progress, Output, Options) :- 1099 !, 1100 failure(Unit, Name, Progress, Line, How, Time, Output, Options). 1101report_result(success(Unit, Name, Line, Determinism, Time), 1102 Progress, Output, Options) :- 1103 !, 1104 success(Unit, Name, Progress, Line, Determinism, Time, Output, Options). 1105report_result(setup_failed(_Unit, _Name, _Line), 1106 _Progress, _Output, _Options).
time_limit_exceeded(Limit)cmp_error(Cmp, E)wrong_answer(Cmp)wrong_error(Expect, E)wrong_answer(Expected, Bindings)1128run_test_6(Unit, Name, Line, Options, Body, Result) :- 1129 option(setup(_Setup), Options), 1130 !, 1131 ( unit_module(Unit, Module), 1132 setup(Module, test(Unit,Name,Line), Options) 1133 -> run_test_7(Unit, Name, Line, Options, Body, Result), 1134 cleanup(Module, Options) 1135 ; Result = setup_failed(Unit, Name, Line) 1136 ). 1137run_test_6(Unit, Name, Line, Options, Body, Result) :- 1138 unit_module(Unit, Module), 1139 run_test_7(Unit, Name, Line, Options, Body, Result), 1140 cleanup(Module, Options).
1149run_test_7(Unit, Name, Line, Options, Body, Result) :- 1150 option(true(Cmp), Options), % expected success 1151 !, 1152 unit_module(Unit, Module), 1153 call_time(reify_tmo(call_det(Module:Body, Det), Result0, Options), Time), 1154 ( Result0 == true 1155 -> cmp_true(Cmp, Module, CmpResult), 1156 ( CmpResult == [] 1157 -> Result = success(Unit, Name, Line, Det, Time) 1158 ; Result = failure(Unit, Name, Line, CmpResult, Time) 1159 ) 1160 ; Result0 == false 1161 -> Result = failure(Unit, Name, Line, failed, Time) 1162 ; Result0 = throw(E2) 1163 -> Result = failure(Unit, Name, Line, throw(E2), Time) 1164 ). 1165run_test_7(Unit, Name, Line, Options, Body, Result) :- 1166 option(fail, Options), % expected failure 1167 !, 1168 unit_module(Unit, Module), 1169 call_time(reify_tmo(Module:Body, Result0, Options), Time), 1170 ( Result0 == true 1171 -> Result = failure(Unit, Name, Line, succeeded, Time) 1172 ; Result0 == false 1173 -> Result = success(Unit, Name, Line, true, Time) 1174 ; Result0 = throw(E) 1175 -> Result = failure(Unit, Name, Line, throw(E), Time) 1176 ). 1177run_test_7(Unit, Name, Line, Options, Body, Result) :- 1178 option(throws(Expect), Options), % Expected error 1179 !, 1180 unit_module(Unit, Module), 1181 call_time(reify_tmo(Module:Body, Result0, Options), Time), 1182 ( Result0 == true 1183 -> Result = failure(Unit, Name, Line, no_exception, Time) 1184 ; Result0 == false 1185 -> Result = failure(Unit, Name, Line, failed, Time) 1186 ; Result0 = throw(E) 1187 -> ( match_error(Expect, E) 1188 -> Result = success(Unit, Name, Line, true, Time) 1189 ; Result = failure(Unit, Name, Line, wrong_error(Expect, E), Time) 1190 ) 1191 ). 1192run_test_7(Unit, Name, Line, Options, Body, Result) :- 1193 option(all(Answer), Options), % all(Bindings) 1194 !, 1195 nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result). 1196run_test_7(Unit, Name, Line, Options, Body, Result) :- 1197 option(set(Answer), Options), % set(Bindings) 1198 !, 1199 nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
1205nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :- 1206 unit_module(Unit, Module), 1207 result_vars(Expected, Vars), 1208 ( call_time(reify_tmo(findall(Vars, Module:Body, Bindings), 1209 Result0, Options), Time) 1210 -> ( Result0 == true 1211 -> ( nondet_compare(Expected, Bindings, Unit, Name, Line) 1212 -> Result = success(Unit, Name, Line, true, Time) 1213 ; Result = failure(Unit, Name, Line, 1214 [wrong_answer(Expected, Bindings)], Time) 1215 ) 1216 ; Result0 = throw(E) 1217 -> Result = failure(Unit, Name, Line, throw(E), Time) 1218 ) 1219 ). 1220 1221cmp_true([], _, L) => 1222 L = []. 1223cmp_true([Cmp|T], Module, L) => 1224 E = error(Formal,_), 1225 cmp_goal(Cmp, Goal), 1226 ( catch(Module:Goal, E, true) 1227 -> ( var(Formal) 1228 -> cmp_true(T, Module, L) 1229 ; L = [cmp_error(Cmp,E)|L1], 1230 cmp_true(T, Module, L1) 1231 ) 1232 ; L = [wrong_answer(Cmp)|L1], 1233 cmp_true(T, Module, L1) 1234 ). 1235 1236cmp_goal(cmp(_Var, Expr), Goal) => Goal = Expr. 1237cmp_goal(Expr, Goal) => Goal = Expr.
v(V1, ...) containing all variables at the left
side of the comparison operator on Expected.
1245result_vars(Expected, Vars) :-
1246 arg(1, Expected, CmpOp),
1247 arg(1, CmpOp, Vars).1257nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :- 1258 cmp(Cmp, _Vars, Op, Values), 1259 cmp_list(Values, Bindings, Op). 1260nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :- 1261 cmp(Cmp, _Vars, Op, Values0), 1262 sort(Bindings0, Bindings), 1263 sort(Values0, Values), 1264 cmp_list(Values, Bindings, Op). 1265 1266cmp_list([], [], _Op). 1267cmp_list([E0|ET], [V0|VT], Op) :- 1268 call(Op, E0, V0), 1269 cmp_list(ET, VT, Op).
1273cmp(Var == Value, Var, ==, Value). 1274cmp(Var =:= Value, Var, =:=, Value). 1275cmp(Var = Value, Var, =, Value). 1276:- if(swi). 1277cmp(Var =@= Value, Var, =@=, Value). 1278:- else. 1279:- if(sicstus). 1280cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@= 1281:- endif. 1282:- endif.
true if Goal left
no choicepoints and false otherwise.1290:- if((swi;sicstus)). 1291call_det(Goal, Det) :- 1292 call_cleanup(Goal,Det0=true), 1293 ( var(Det0) -> Det = false ; Det = true ). 1294:- else. 1295call_det(Goal, true) :- 1296 call(Goal). 1297:- endif.
1304match_error(Expect, Rec) :-
1305 subsumes_term(Expect, Rec).1318setup(Module, Context, Options) :- 1319 option(setup(Setup), Options), 1320 !, 1321 capture_output(reify(call_ex(Module, Setup), Result), Output), 1322 ( Result == true 1323 -> true 1324 ; print_message(error, 1325 plunit(error(setup, Context, Output, Result))), 1326 fail 1327 ). 1328setup(_,_,_).
1334condition(Module, Context, Options) :- 1335 option(condition(Cond), Options), 1336 !, 1337 capture_output(reify(call_ex(Module, Cond), Result), Output), 1338 ( Result == true 1339 -> true 1340 ; Result == false 1341 -> fail 1342 ; print_message(error, 1343 plunit(error(condition, Context, Output, Result))), 1344 fail 1345 ). 1346condition(_, _, _).
1353call_ex(Module, Goal) :-
1354 Module:(expand_goal(Goal, GoalEx),
1355 GoalEx).1362cleanup(Module, Options) :- 1363 option(cleanup(Cleanup), Options, true), 1364 ( catch(call_ex(Module, Cleanup), E, true) 1365 -> ( var(E) 1366 -> true 1367 ; print_message(warning, E) 1368 ) 1369 ; print_message(warning, goal_failed(Cleanup, '(cleanup handler)')) 1370 ). 1371 1372success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :- 1373 memberchk(fixme(Reason), Options), 1374 !, 1375 ( ( Det == true 1376 ; memberchk(nondet, Options) 1377 ) 1378 -> progress(Unit:Name, Progress, fixme(passed), Time), 1379 Ok = passed 1380 ; progress(Unit:Name, Progress, fixme(nondet), Time), 1381 Ok = nondet 1382 ), 1383 flush_output(user_error), 1384 assert(fixme(Unit, Name, Line, Reason, Ok)). 1385success(Unit, Name, Progress, Line, _, Time, Output, Options) :- 1386 failed_assertion(Unit, Name, Line, _,Progress,_,_), 1387 !, 1388 failure(Unit, Name, Progress, Line, assertion, Time, Output, Options). 1389success(Unit, Name, Progress, Line, _, Time, Output, Options) :- 1390 Output = true-_, 1391 !, 1392 failure(Unit, Name, Progress, Line, message, Time, Output, Options). 1393success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :- 1394 assert(passed(Unit, Name, Line, Det, Time)), 1395 ( ( Det == true 1396 ; memberchk(nondet, Options) 1397 ) 1398 -> progress(Unit:Name, Progress, passed, Time) 1399 ; unit_file(Unit, File), 1400 print_message(warning, plunit(nondet(File, Line, Name))) 1401 ).
1408failure(Unit, Name, Progress, Line, _, Time, _Output, Options), 1409 memberchk(fixme(Reason), Options) => 1410 assert(fixme(Unit, Name, Line, Reason, failed)), 1411 progress(Unit:Name, Progress, fixme(failed), Time). 1412failure(Unit, Name, Progress, Line, time_limit_exceeded(Limit), Time, 1413 Output, Options) => 1414 assert_cyclic(timeout(Unit, Name, Line, Limit, Time)), 1415 progress(Unit:Name, Progress, timeout(Limit), Time), 1416 report_failure(Unit, Name, Progress, Line, timeout(Limit), Time, Output, Options). 1417failure(Unit, Name, Progress, Line, E, Time, Output, Options) => 1418 assert_cyclic(failed(Unit, Name, Line, E, Time)), 1419 progress(Unit:Name, Progress, failed, Time), 1420 report_failure(Unit, Name, Progress, Line, E, Time, Output, Options).
1430:- if(swi). 1431assert_cyclic(Term) :- 1432 acyclic_term(Term), 1433 !, 1434 assert(Term). 1435assert_cyclic(Term) :- 1436 Term =.. [Functor|Args], 1437 recorda(cyclic, Args, Id), 1438 functor(Term, _, Arity), 1439 length(NewArgs, Arity), 1440 Head =.. [Functor|NewArgs], 1441 assert(( :- recorded(_, Var, Id), Var = NewArgs)). 1442:- else. 1443:- if(sicstus). 1444:- endif. 1445assert_cyclic(Term) :- 1446 assert(Term). 1447:- endif. 1448 1449 1450 /******************************* 1451 * JOBS * 1452 *******************************/ 1453 1454:- if(current_prolog_flag(threads, true)). 1455 1456:- dynamic 1457 job_data/2, % Queue, Threads 1458 scheduled_unit/1. 1459 1460schedule_unit(_:[]) :- 1461 !. 1462schedule_unit(UnitAndTests) :- 1463 UnitAndTests = Unit:_Tests, 1464 job_data(Queue, _), 1465 !, 1466 assertz(scheduled_unit(Unit)), 1467 thread_send_message(Queue, unit(UnitAndTests)). 1468schedule_unit(Unit) :- 1469 run_unit(Unit).
1475setup_jobs(Count) :- 1476 ( current_test_flag(jobs, Jobs0), 1477 integer(Jobs0) 1478 -> true 1479 ; current_prolog_flag(cpu_count, Jobs0) 1480 ), 1481 Jobs is min(Count, Jobs0), 1482 Jobs > 1, 1483 !, 1484 message_queue_create(Q, [alias(plunit_jobs)]), 1485 length(TIDs, Jobs), 1486 foldl(create_plunit_job(Q), TIDs, 1, _), 1487 asserta(job_data(Q, TIDs)), 1488 job_feedback(informational, jobs(Jobs)). 1489setup_jobs(_) :- 1490 job_feedback(informational, jobs(1)). 1491 1492create_plunit_job(Q, TID, N, N1) :- 1493 N1 is N + 1, 1494 atom_concat(plunit_job_, N, Alias), 1495 thread_create(plunit_job(Q), TID, [alias(Alias)]). 1496 1497plunit_job(Queue) :- 1498 repeat, 1499 ( catch(thread_get_message(Queue, Job, 1500 [ timeout(10) 1501 ]), 1502 error(_,_), fail) 1503 -> job(Job), 1504 fail 1505 ; ! 1506 ). 1507 1508job(unit(Unit:Tests)) => 1509 run_unit(Unit:Tests). 1510job(test(Unit, Test)) => 1511 run_test(Unit, Test). 1512 1513cleanup_jobs :- 1514 retract(job_data(Queue, TIDSs)), 1515 !, 1516 message_queue_destroy(Queue), 1517 maplist(thread_join, TIDSs). 1518cleanup_jobs.
1524job_wait(Unit) :- 1525 thread_wait(\+ scheduled_unit(Unit), 1526 [ wait_preds([scheduled_unit/1]), 1527 timeout(1) 1528 ]), 1529 !. 1530job_wait(Unit) :- 1531 job_data(_Queue, TIDs), 1532 member(TID, TIDs), 1533 thread_property(TID, status(running)), 1534 !, 1535 job_wait(Unit). 1536job_wait(_). 1537 1538 1539job_info(begin(unit(Unit))) => 1540 print_message(silent, plunit(begin(Unit))). 1541job_info(end(unit(Unit, Summary))) => 1542 retractall(scheduled_unit(Unit)), 1543 print_message(silent, plunit(end(Unit, Summary))). 1544 1545:- else. % No jobs 1546 1547schedule_unit(Unit) :- 1548 run_unit(Unit). 1549 1550setup_jobs(_) :- 1551 print_message(silent, plunit(jobs(1))). 1552cleanup_jobs. 1553job_wait(_). 1554job_info(_). 1555 1556:- endif. 1557 1558 1559 1560 /******************************* 1561 * REPORTING * 1562 *******************************/
silent message:
plunit(begin(Unit:Test, File:Line, Progress))plunit(end(Unit:Test, File:Line, Progress))1575begin_test(Unit, Test, Line, Progress) :- 1576 thread_self(Me), 1577 assert(running(Unit, Test, Line, Progress, Me)), 1578 unit_file(Unit, File), 1579 test_count(Total), 1580 job_feedback(information, begin(Unit:Test, File:Line, Progress/Total)). 1581 1582end_test(Unit, Test, Line, Progress) :- 1583 thread_self(Me), 1584 retractall(running(_,_,_,_,Me)), 1585 unit_file(Unit, File), 1586 test_count(Total), 1587 job_feedback(information, end(Unit:Test, File:Line, Progress/Total)).
1593running_tests :- 1594 running_tests(Running), 1595 print_message(informational, plunit(running(Running))). 1596 1597running_tests(Running) :- 1598 test_count(Total), 1599 findall(running(Unit:Test, File:Line, Progress/Total, Thread), 1600 ( running(Unit, Test, Line, Progress, Thread), 1601 unit_file(Unit, File) 1602 ), Running).
1609current_test(Unit, Test, Line, Body, Options) :-
1610 current_unit(Unit, Module, _Supers, _UnitOptions),
1611 Module:'unit test'(Test, Line, Options, Body).1617current_test_unit(Unit, UnitOptions) :- 1618 current_unit(Unit, _Module, _Supers, UnitOptions). 1619 1620 1621count(Goal, Count) :- 1622 aggregate_all(count, Goal, Count).
1629test_summary(Unit, Summary) :- 1630 count(failed(Unit, _0Test, _0Line, _Reason, _0Time), Failed), 1631 count(timeout(Unit, _0Test, _0Line, _Limit, _0Time), Timeout), 1632 count(passed(Unit, _0Test, _0Line, _Det, _0Time), Passed), 1633 count(blocked(Unit, _0Test, _0Line, _0Reason), Blocked), 1634 count(fixme(Unit, _0Test, _0Line, _0Reason, _0How), Fixme), 1635 test_count(Total), 1636 Summary = plunit{total:Total, 1637 passed:Passed, 1638 failed:Failed, 1639 timeout:Timeout, 1640 blocked:Blocked, 1641 fixme:Fixme}. 1642 1643test_summary_passed(Summary) :- 1644 _{failed: 0} :< Summary.
1650report(Time, _Options) :- 1651 test_summary(_, Summary), 1652 print_message(silent, plunit(Summary)), 1653 _{ passed:Passed, 1654 failed:Failed, 1655 timeout:Timeout, 1656 blocked:Blocked, 1657 fixme:Fixme 1658 } :< Summary, 1659 ( Passed+Failed+Timeout+Blocked+Fixme =:= 0 1660 -> info(plunit(no_tests)) 1661 ; Failed+Timeout =:= 0 1662 -> report_blocked(Blocked), 1663 report_fixme, 1664 test_count(Total), 1665 info(plunit(all_passed(Total, Passed, Time))) 1666 ; report_blocked(Blocked), 1667 report_fixme, 1668 report_failed(Failed), 1669 report_timeout(Timeout), 1670 info(plunit(passed(Passed))), 1671 info(plunit(total_time(Time))) 1672 ). 1673 1674report_blocked(0) => 1675 true. 1676report_blocked(Blocked) => 1677 findall(blocked(Unit:Name, File:Line, Reason), 1678 ( blocked(Unit, Name, Line, Reason), 1679 unit_file(Unit, File) 1680 ), 1681 BlockedTests), 1682 info(plunit(blocked(Blocked, BlockedTests))). 1683 1684report_failed(Failed) :- 1685 print_message(error, plunit(failed(Failed))). 1686 1687report_timeout(Count) :- 1688 print_message(warning, plunit(timeout(Count))). 1689 1690report_fixme :- 1691 report_fixme(_,_,_). 1692 1693report_fixme(TuplesF, TuplesP, TuplesN) :- 1694 fixme(failed, TuplesF, Failed), 1695 fixme(passed, TuplesP, Passed), 1696 fixme(nondet, TuplesN, Nondet), 1697 print_message(informational, plunit(fixme(Failed, Passed, Nondet))). 1698 1699 1700fixme(How, Tuples, Count) :- 1701 findall(fixme(Unit, Name, Line, Reason, How), 1702 fixme(Unit, Name, Line, Reason, How), Tuples), 1703 length(Tuples, Count). 1704 1705report_failure(Unit, Name, Progress, Line, Error, 1706 Time, Output, _Options) => 1707 test_count(Total), 1708 job_feedback(error, failed(Unit:Name, Progress/Total, Line, 1709 Error, Time, Output)).
fixme for What.1717test_report(fixme) :- 1718 !, 1719 report_fixme(TuplesF, TuplesP, TuplesN), 1720 append([TuplesF, TuplesP, TuplesN], Tuples), 1721 print_message(informational, plunit(fixme(Tuples))). 1722test_report(What) :- 1723 throw_error(domain_error(report_class, What), _). 1724 1725 1726 /******************************* 1727 * INFO * 1728 *******************************/
1735unit_file(Unit, File), nonvar(Unit) => 1736 unit_file_(Unit, File), 1737 !. 1738unit_file(Unit, File) => 1739 unit_file_(Unit, File). 1740 1741unit_file_(Unit, File) :- 1742 current_unit(Unit, Module, _Context, _Options), 1743 module_property(Module, file(File)). 1744unit_file_(Unit, PlFile) :- 1745 test_file_for(TestFile, PlFile), 1746 module_property(Module, file(TestFile)), 1747 current_unit(Unit, Module, _Context, _Options). 1748 1749 1750 /******************************* 1751 * FILES * 1752 *******************************/
1759load_test_files(_Options) :- 1760 State = state(0,0), 1761 ( source_file(File), 1762 file_name_extension(Base, Old, File), 1763 Old \== plt, 1764 file_name_extension(Base, plt, TestFile), 1765 exists_file(TestFile), 1766 inc_arg(1, State), 1767 ( test_file_for(TestFile, File) 1768 -> true 1769 ; load_files(TestFile, 1770 [ if(changed), 1771 imports([]) 1772 ]), 1773 inc_arg(2, State), 1774 asserta(test_file_for(TestFile, File)) 1775 ), 1776 fail 1777 ; State = state(Total, Loaded), 1778 print_message(informational, plunit(test_files(Total, Loaded))) 1779 ). 1780 1781inc_arg(Arg, State) :- 1782 arg(Arg, State, N0), 1783 N is N0+1, 1784 nb_setarg(Arg, State, N). 1785 1786 1787 /******************************* 1788 * MESSAGES * 1789 *******************************/
print_message(Level, Term), where Level is one of silent or
informational (default).
1796info(Term) :-
1797 message_level(Level),
1798 print_message(Level, Term).forall(Gen,Test) set. Mapped
to forall(FTotal, FFailed)1815progress(UnitTest, _Progress, forall(end, Nth, FTotal), Time) => 1816 ( retract(forall_failures(Nth, FFailed)) 1817 -> true 1818 ; FFailed = 0 1819 ), 1820 test_count(Total), 1821 job_feedback(information, progress(UnitTest, forall(FTotal,FFailed), Nth/Total, Time)). 1822progress(UnitTest, Progress, Result, Time), Progress = forall(_Vars, Nth-_I) => 1823 with_mutex(plunit_forall_counter, 1824 update_forall_failures(Nth, Result)), 1825 test_count(Total), 1826 job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)). 1827progress(UnitTest, Progress, Result, Time) => 1828 test_count(Total), 1829 job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)). 1830 1831update_forall_failures(_Nth, passed) => 1832 true. 1833update_forall_failures(Nth, _) => 1834 ( retract(forall_failures(Nth, Failed0)) 1835 -> true 1836 ; Failed0 = 0 1837 ), 1838 Failed is Failed0+1, 1839 asserta(forall_failures(Nth, Failed)). 1840 1841message_level(Level) :- 1842 ( current_test_flag(silent, true) 1843 -> Level = silent 1844 ; Level = informational 1845 ). 1846 1847locationprefix(File:Line) --> 1848 !, 1849 [ url(File:Line), ':'-[], nl, ' ' ]. 1850locationprefix(test(Unit,_Test,Line)) --> 1851 !, 1852 { unit_file(Unit, File) }, 1853 locationprefix(File:Line). 1854locationprefix(unit(Unit)) --> 1855 !, 1856 [ 'PL-Unit: unit ~w: '-[Unit] ]. 1857locationprefix(FileLine) --> 1858 { throw_error(type_error(locationprefix,FileLine), _) }. 1859 1860:- discontiguous 1861 message//1. 1862:- '$hide'(message//1). 1863 1864message(error(context_error(plunit_close(Name, -)), _)) --> 1865 [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ]. 1866message(error(context_error(plunit_close(Name, Start)), _)) --> 1867 [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ]. 1868message(plunit(nondet(File, Line, Name))) --> 1869 locationprefix(File:Line), 1870 [ 'PL-Unit: Test ~w: Test succeeded with choicepoint'- [Name] ]. 1871message(error(plunit(incompatible_options, Tests), _)) --> 1872 [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ]. 1873message(plunit(sto(true))) --> 1874 [ 'Option sto(true) is ignored. See `occurs_check` option.'-[] ]. 1875message(plunit(test_files(Total, Loaded))) --> 1876 [ 'Found ~D .plt test files, loaded ~D'-[Total, Loaded] ]. 1877 1878 % Unit start/end 1879message(plunit(jobs(1))) --> 1880 !. 1881message(plunit(jobs(N))) --> 1882 [ 'Testing with ~D parallel jobs'-[N] ]. 1883message(plunit(begin(_Unit))) --> 1884 { tty_feedback }, 1885 !. 1886message(plunit(begin(Unit))) --> 1887 [ 'Start unit: ~w~n'-[Unit], flush ]. 1888message(plunit(end(_Unit, _Summary))) --> 1889 { tty_feedback }, 1890 !. 1891message(plunit(end(Unit, Summary))) --> 1892 ( {test_summary_passed(Summary)} 1893 -> [ 'End unit ~w: passed (~3f sec CPU)'-[Unit, Summary.time.cpu] ] 1894 ; [ ansi(error, 'End unit ~w: **FAILED (~3f sec CPU)', [Unit, Summary.time.cpu]) ] 1895 ). 1896message(plunit(blocked(unit(Unit, Reason)))) --> 1897 [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ]. 1898message(plunit(running([]))) --> 1899 !, 1900 [ 'PL-Unit: no tests running' ]. 1901message(plunit(running([One]))) --> 1902 !, 1903 [ 'PL-Unit: running ' ], 1904 running(One). 1905message(plunit(running(More))) --> 1906 !, 1907 [ 'PL-Unit: running tests:', nl ], 1908 running(More). 1909message(plunit(fixme([]))) --> !. 1910message(plunit(fixme(Tuples))) --> 1911 !, 1912 fixme_message(Tuples). 1913message(plunit(total_time(Time))) --> 1914 [ 'Test run completed'-[] ], 1915 test_time(Time). 1916 1917 % Blocked tests 1918message(plunit(blocked(1, Tests))) --> 1919 !, 1920 [ 'one test is blocked'-[] ], 1921 blocked_tests(Tests). 1922message(plunit(blocked(N, Tests))) --> 1923 [ '~D tests are blocked'-[N] ], 1924 blocked_tests(Tests). 1925 1926blocked_tests(Tests) --> 1927 { current_test_flag(show_blocked, true) }, 1928 !, 1929 [':'-[]], 1930 list_blocked(Tests). 1931blocked_tests(_) --> 1932 [ ' (use run_tests/2 with ', ansi(code, 'show_blocked(true)', []), 1933 ' for details)'-[] 1934 ]. 1935 1936list_blocked([]) --> !. 1937list_blocked([blocked(Unit:Test, Pos, Reason)|T]) --> 1938 [nl], 1939 locationprefix(Pos), 1940 test_name(Unit:Test, -), 1941 [ ': ~w'-[Reason] ], 1942 list_blocked(T). 1943 1944 % fail/success 1945message(plunit(no_tests)) --> 1946 !, 1947 [ 'No tests to run' ]. 1948message(plunit(all_passed(1, 1, Time))) --> 1949 !, 1950 [ 'test passed' ], 1951 test_time(Time). 1952message(plunit(all_passed(Total, Total, Time))) --> 1953 !, 1954 [ 'All ~D tests passed'-[Total] ], 1955 test_time(Time). 1956message(plunit(all_passed(Total, Count, Time))) --> 1957 !, 1958 { SubTests is Count-Total }, 1959 [ 'All ~D (+~D sub-tests) tests passed'- [Total, SubTests] ], 1960 test_time(Time). 1961 1962test_time(Time) --> 1963 { var(Time) }, !. 1964test_time(Time) --> 1965 [ ' in ~3f seconds (~3f cpu)'-[Time.wall, Time.cpu] ]. 1966 1967message(plunit(passed(Count))) --> 1968 !, 1969 [ '~D tests passed'-[Count] ]. 1970message(plunit(failed(0))) --> 1971 !, 1972 []. 1973message(plunit(failed(1))) --> 1974 !, 1975 [ '1 test failed'-[] ]. 1976message(plunit(failed(N))) --> 1977 [ '~D tests failed'-[N] ]. 1978message(plunit(timeout(0))) --> 1979 !, 1980 []. 1981message(plunit(timeout(N))) --> 1982 [ '~D tests timed out'-[N] ]. 1983message(plunit(fixme(0,0,0))) --> 1984 []. 1985message(plunit(fixme(Failed,0,0))) --> 1986 !, 1987 [ 'all ~D tests flagged FIXME failed'-[Failed] ]. 1988message(plunit(fixme(Failed,Passed,0))) --> 1989 [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ]. 1990message(plunit(fixme(Failed,Passed,Nondet))) --> 1991 { TotalPassed is Passed+Nondet }, 1992 [ 'FIXME: ~D failed; ~D passed; (~D nondet)'- 1993 [Failed, TotalPassed, Nondet] ]. 1994 1995message(plunit(begin(Unit:Test, _Location, Progress))) --> 1996 { tty_columns(SummaryWidth, _Margin), 1997 test_name_summary(Unit:Test, SummaryWidth, NameS), 1998 progress_string(Progress, ProgressS) 1999 }, 2000 ( { tty_feedback, 2001 tty_clear_to_eol(CE) 2002 } 2003 -> [ at_same_line, '\r[~w] ~w ..~w'-[ProgressS, NameS, 2004 CE], flush ] 2005 ; { jobs(_) } 2006 -> [ '[~w] ~w ..'-[ProgressS, NameS] ] 2007 ; [ '[~w] ~w ..'-[ProgressS, NameS], flush ] 2008 ). 2009message(plunit(end(_UnitTest, _Location, _Progress))) --> 2010 []. 2011message(plunit(progress(_UnitTest, Status, _Progress, _Time))) --> 2012 { Status = forall(_,_) 2013 ; Status == assertion 2014 }, 2015 !. 2016message(plunit(progress(Unit:Test, Status, Progress, Time))) --> 2017 { jobs(_), 2018 !, 2019 tty_columns(SummaryWidth, Margin), 2020 test_name_summary(Unit:Test, SummaryWidth, NameS), 2021 progress_string(Progress, ProgressS), 2022 progress_tag(Status, Tag, _Keep, Style) 2023 }, 2024 [ ansi(Style, '[~w] ~w ~`.t ~w (~3f sec)~*|', 2025 [ProgressS, NameS, Tag, Time.wall, Margin]) ]. 2026message(plunit(progress(_UnitTest, Status, _Progress, Time))) --> 2027 { tty_columns(_SummaryWidth, Margin), 2028 progress_tag(Status, Tag, _Keep, Style) 2029 }, 2030 [ at_same_line, ansi(Style, '~`.t ~w (~3f sec)~*|', 2031 [Tag, Time.wall, Margin]) ], 2032 ( { tty_feedback } 2033 -> [flush] 2034 ; [] 2035 ). 2036message(plunit(failed(Unit:Test, Progress, Line, Failure, _Time, Output))) --> 2037 { unit_file(Unit, File) }, 2038 locationprefix(File:Line), 2039 test_name(Unit:Test, Progress), 2040 [': '-[] ], 2041 failure(Failure), 2042 test_output(Output). 2043message(plunit(timeout(Unit:Test, Progress, Line, Limit, Output))) --> 2044 { unit_file(Unit, File) }, 2045 locationprefix(File:Line), 2046 test_name(Unit:Test, Progress), 2047 [': '-[] ], 2048 timeout(Limit), 2049 test_output(Output). 2050:- if(swi). 2051message(plunit(failed_assertion(Unit:Test, Line, AssertLoc, 2052 Progress, Reason, Goal))) --> 2053 { unit_file(Unit, File) }, 2054 locationprefix(File:Line), 2055 test_name(Unit:Test, Progress), 2056 [ ': assertion'-[] ], 2057 assertion_location(AssertLoc, File), 2058 assertion_reason(Reason), ['\n\t'], 2059 assertion_goal(Unit, Goal). 2060 2061assertion_location(File:Line, File) --> 2062 [ ' at line ~w'-[Line] ]. 2063assertion_location(File:Line, _) --> 2064 [ ' at ', url(File:Line) ]. 2065assertion_location(unknown, _) --> 2066 []. 2067 2068assertion_reason(fail) --> 2069 !, 2070 [ ' failed'-[] ]. 2071assertion_reason(Error) --> 2072 { message_to_string(Error, String) }, 2073 [ ' raised "~w"'-[String] ]. 2074 2075assertion_goal(Unit, Goal) --> 2076 { unit_module(Unit, Module), 2077 unqualify(Goal, Module, Plain) 2078 }, 2079 [ 'Assertion: ~p'-[Plain] ]. 2080 2081unqualify(Var, _, Var) :- 2082 var(Var), 2083 !. 2084unqualify(M:Goal, Unit, Goal) :- 2085 nonvar(M), 2086 unit_module(Unit, M), 2087 !. 2088unqualify(M:Goal, _, Goal) :- 2089 callable(Goal), 2090 predicate_property(M:Goal, imported_from(system)), 2091 !. 2092unqualify(Goal, _, Goal). 2093 2094test_output(Msgs-String) --> 2095 { nonvar(Msgs) }, 2096 !, 2097 test_output(String). 2098test_output("") --> []. 2099test_output(Output) --> 2100 [ ansi(code, '~N~s', [Output]) ]. 2101 2102:- endif. 2103 % Setup/condition errors 2104message(plunit(error(Where, Context, _Output, throw(Exception)))) --> 2105 locationprefix(Context), 2106 { message_to_string(Exception, String) }, 2107 [ 'error in ~w: ~w'-[Where, String] ]. 2108message(plunit(error(Where, Context, _Output, false))) --> 2109 locationprefix(Context), 2110 [ 'setup failed in ~w'-[Where] ]. 2111 2112 % delayed output 2113message(plunit(test_output(_, Output))) --> 2114 [ '~s'-[Output] ]. 2115 % Interrupts (SWI) 2116:- if(swi). 2117message(interrupt(begin)) --> 2118 { thread_self(Me), 2119 running(Unit, Test, Line, Progress, Me), 2120 !, 2121 unit_file(Unit, File), 2122 restore_output_state 2123 }, 2124 [ 'Interrupted test '-[] ], 2125 running(running(Unit:Test, File:Line, Progress, Me)), 2126 [nl], 2127 '$messages':prolog_message(interrupt(begin)). 2128message(interrupt(begin)) --> 2129 '$messages':prolog_message(interrupt(begin)). 2130:- endif. 2131 2132message(concurrent) --> 2133 [ 'concurrent(true) at the level of units is currently ignored.', nl, 2134 'See set_test_options/1 with jobs(Count) for concurrent testing.' 2135 ]. 2136 2137test_name(Name, forall(Bindings, _Nth-I)) --> 2138 !, 2139 test_name(Name, -), 2140 [ ' (~d-th forall bindings = '-[I], 2141 ansi(code, '~p', [Bindings]), ')'-[] 2142 ]. 2143test_name(Name, _) --> 2144 !, 2145 [ 'test ', ansi(code, '~q', [Name]) ]. 2146 2147running(running(Unit:Test, File:Line, _Progress, Thread)) --> 2148 thread(Thread), 2149 [ '~q:~q at '-[Unit, Test], url(File:Line) ]. 2150running([H|T]) --> 2151 ['\t'], running(H), 2152 ( {T == []} 2153 -> [] 2154 ; [nl], running(T) 2155 ). 2156 2157thread(main) --> !. 2158thread(Other) --> 2159 [' [~w] '-[Other] ]. 2160 2161:- if(swi). 2162write_term(T, OPS) --> 2163 ['~W'-[T,OPS] ]. 2164:- else. 2165write_term(T, _OPS) --> 2166 ['~q'-[T]]. 2167:- endif. 2168 2169expected_got_ops_(Ex, E, OPS, Goals) --> 2170 [' Expected: '-[]], write_term(Ex, OPS), [nl], 2171 [' Got: '-[]], write_term(E, OPS), [], 2172 ( { Goals = [] } -> [] 2173 ; [nl, ' with: '-[]], write_term(Goals, OPS), [] 2174 ). 2175 2176 2177failure(List) --> 2178 { is_list(List) }, 2179 !, 2180 [ nl ], 2181 failures(List). 2182failure(Var) --> 2183 { var(Var) }, 2184 !, 2185 [ 'Unknown failure?' ]. 2186failure(succeeded(Time)) --> 2187 !, 2188 [ 'must fail but succeeded in ~2f seconds~n'-[Time] ]. 2189failure(wrong_error(Expected, Error)) --> 2190 !, 2191 { copy_term(Expected-Error, Ex-E, Goals), 2192 numbervars(Ex-E-Goals, 0, _), 2193 write_options(OPS) 2194 }, 2195 [ 'wrong error'-[], nl ], 2196 expected_got_ops_(Ex, E, OPS, Goals). 2197failure(wrong_answer(cmp(Var, Cmp))) --> 2198 { Cmp =.. [Op,Answer,Expected], 2199 !, 2200 copy_term(Expected-Answer, Ex-A, Goals), 2201 numbervars(Ex-A-Goals, 0, _), 2202 write_options(OPS) 2203 }, 2204 [ 'wrong answer for ', ansi(code, '~w', [Var]), 2205 ' (compared using ~w)'-[Op], nl ], 2206 expected_got_ops_(Ex, A, OPS, Goals). 2207failure(wrong_answer(Cmp)) --> 2208 { Cmp =.. [Op,Answer,Expected], 2209 !, 2210 copy_term(Expected-Answer, Ex-A, Goals), 2211 numbervars(Ex-A-Goals, 0, _), 2212 write_options(OPS) 2213 }, 2214 [ 'wrong answer (compared using ~w)'-[Op], nl ], 2215 expected_got_ops_(Ex, A, OPS, Goals). 2216failure(wrong_answer(CmpExpected, Bindings)) --> 2217 { ( CmpExpected = all(Cmp) 2218 -> Cmp =.. [_Op1,_,Expected], 2219 Got = Bindings, 2220 Type = all 2221 ; CmpExpected = set(Cmp), 2222 Cmp =.. [_Op2,_,Expected0], 2223 sort(Expected0, Expected), 2224 sort(Bindings, Got), 2225 Type = set 2226 ) 2227 }, 2228 [ 'wrong "~w" answer:'-[Type] ], 2229 [ nl, ' Expected: ~q'-[Expected] ], 2230 [ nl, ' Found: ~q'-[Got] ]. 2231:- if(swi). 2232failure(cmp_error(_Cmp, Error)) --> 2233 { message_to_string(Error, Message) }, 2234 [ 'Comparison error: ~w'-[Message] ]. 2235failure(throw(Error)) --> 2236 { Error = error(_,_), 2237 !, 2238 message_to_string(Error, Message) 2239 }, 2240 [ 'received error: ~w'-[Message] ]. 2241:- endif. 2242failure(message) --> 2243 !, 2244 [ 'Generated unexpected warning or error'-[] ]. 2245failure(Why) --> 2246 [ '~p'-[Why] ]. 2247 2248failures([]) --> 2249 !. 2250failures([H|T]) --> 2251 !, 2252 failure(H), [nl], 2253 failures(T). 2254 2255timeout(Limit) --> 2256 [ 'Timeout exceeeded (~2f sec)'-[Limit] ]. 2257 2258fixme_message([]) --> []. 2259fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) --> 2260 { unit_file(Unit, File) }, 2261 fixme_message(File:Line, Reason, How), 2262 ( {T == []} 2263 -> [] 2264 ; [nl], 2265 fixme_message(T) 2266 ). 2267 2268fixme_message(Location, Reason, failed) --> 2269 [ 'FIXME: ~w: ~w'-[Location, Reason] ]. 2270fixme_message(Location, Reason, passed) --> 2271 [ 'FIXME: ~w: passed ~w'-[Location, Reason] ]. 2272fixme_message(Location, Reason, nondet) --> 2273 [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ]. 2274 2275 2276write_options([ numbervars(true), 2277 quoted(true), 2278 portray(true), 2279 max_depth(100), 2280 attributes(portray) 2281 ]).
2288test_name_summary(Term, MaxLen, Summary) :- 2289 summary_string(Term, Text), 2290 atom_length(Text, Len), 2291 ( Len =< MaxLen 2292 -> Summary = Text 2293 ; End is MaxLen//2, 2294 Pre is MaxLen - End - 2, 2295 sub_string(Text, 0, Pre, _, PreText), 2296 sub_string(Text, _, End, 0, PostText), 2297 format(string(Summary), '~w..~w', [PreText,PostText]) 2298 ). 2299 2300summary_string(Unit:Test, String) => 2301 summary_string(Test, String1), 2302 atomics_to_string([Unit, String1], :, String). 2303summary_string(@(Name,Vars), String) => 2304 format(string(String), '~W (using ~W)', 2305 [ Name, [numbervars(true), quoted(false)], 2306 Vars, [numbervars(true), portray(true), quoted(true)] 2307 ]). 2308summary_string(Name, String) => 2309 term_string(Name, String, [numbervars(true), quoted(false)]).
2315progress_string(forall(_Vars, N-I)/Total, S) => 2316 format(string(S), '~w-~w/~w', [N,I,Total]). 2317progress_string(Progress, S) => 2318 term_string(Progress, S).
2326progress_tag(passed, Tag, Keep, Style) => 2327 Tag = passed, Keep = false, Style = comment. 2328progress_tag(fixme(passed), Tag, Keep, Style) => 2329 Tag = passed, Keep = false, Style = comment. 2330progress_tag(fixme(_), Tag, Keep, Style) => 2331 Tag = fixme, Keep = true, Style = warning. 2332progress_tag(nondet, Tag, Keep, Style) => 2333 Tag = '**NONDET', Keep = true, Style = warning. 2334progress_tag(timeout(_Limit), Tag, Keep, Style) => 2335 Tag = '**TIMEOUT', Keep = true, Style = warning. 2336progress_tag(assertion, Tag, Keep, Style) => 2337 Tag = '**FAILED', Keep = true, Style = error. 2338progress_tag(failed, Tag, Keep, Style) => 2339 Tag = '**FAILED', Keep = true, Style = error. 2340progress_tag(forall(_,0), Tag, Keep, Style) => 2341 Tag = passed, Keep = false, Style = comment. 2342progress_tag(forall(_,_), Tag, Keep, Style) => 2343 Tag = '**FAILED', Keep = true, Style = error. 2344 2345 2346 /******************************* 2347 * OUTPUT * 2348 *******************************/ 2349 2350save_output_state :- 2351 stream_property(Output, alias(user_output)), 2352 stream_property(Error, alias(user_error)), 2353 asserta(output_streams(Output, Error)). 2354 2355restore_output_state :- 2356 output_streams(Output, Error), 2357 !, 2358 set_stream(Output, alias(user_output)), 2359 set_stream(Error, alias(user_error)). 2360restore_output_state. 2361 2362 2363 2364 /******************************* 2365 * CONCURRENT STATUS * 2366 *******************************/ 2367 2368/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2369This part deals with interactive feedback when we are running multiple 2370threads. The terminal window cannot work on top of the Prolog message 2371infrastructure and (thus) we have to use more low-level means. 2372- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2373 2374:- dynamic 2375 jobs/1, % Count 2376 job_window/1, % Count 2377 job_status_line/3. % Job, Format, Args 2378 2379job_feedback(_, jobs(Jobs)) :- 2380 retractall(jobs(_)), 2381 Jobs > 1, 2382 asserta(jobs(Jobs)), 2383 tty_feedback, 2384 !, 2385 retractall(job_window(_)), 2386 asserta(job_window(Jobs)), 2387 retractall(job_status_line(_,_,_)), 2388 jobs_redraw. 2389job_feedback(_, jobs(Jobs)) :- 2390 !, 2391 retractall(job_window(_)), 2392 info(plunit(jobs(Jobs))). 2393job_feedback(_, Msg) :- 2394 job_window(_), 2395 !, 2396 with_mutex(plunit_feedback, job_feedback(Msg)). 2397job_feedback(Level, Msg) :- 2398 print_message(Level, plunit(Msg)). 2399 2400job_feedback(begin(Unit:Test, _Location, Progress)) => 2401 tty_columns(SummaryWidth, _Margin), 2402 test_name_summary(Unit:Test, SummaryWidth, NameS), 2403 progress_string(Progress, ProgressS), 2404 tty_clear_to_eol(CE), 2405 job_format(comment, '\r[~w] ~w ..~w', 2406 [ProgressS, NameS, CE]), 2407 flush_output. 2408job_feedback(end(_UnitTest, _Location, _Progress)) => 2409 true. 2410job_feedback(progress(_UnitTest, Status, _Progress, Time)) => 2411 ( hide_progress(Status) 2412 -> true 2413 ; tty_columns(_SummaryWidth, Margin), 2414 progress_tag(Status, Tag, _Keep, Style), 2415 job_finish(Style, '~`.t ~w (~3f sec)~*|', 2416 [Tag, Time.wall, Margin]) 2417 ). 2418job_feedback(failed(UnitTest, Progress, Line, Error, Time, Output)) => 2419 tty_columns(_SummaryWidth, Margin), 2420 progress_tag(failed, Tag, _Keep, Style), 2421 job_finish(Style, '~`.t ~w (~3f sec)~*|', 2422 [Tag, Time.wall, Margin]), 2423 print_test_output(Error, Output), 2424 ( ( Error = timeout(_) % Status line suffices 2425 ; Error == assertion % We will get an failed test later 2426 ) 2427 -> true 2428 ; print_message(Style, plunit(failed(UnitTest, Progress, Line, 2429 Error, Time, ""))) 2430 ), 2431 jobs_redraw. 2432job_feedback(begin(_Unit)) => true. 2433job_feedback(end(_Unit, _Summary)) => true. 2434 2435hide_progress(assertion). 2436hide_progress(forall(_,_)). 2437hide_progress(failed). 2438hide_progress(timeout(_)). 2439 2440print_test_output(Error, _Msgs-Output) => 2441 print_test_output(Error, Output). 2442print_test_output(_, "") => true. 2443print_test_output(assertion, Output) => 2444 print_message(debug, plunit(test_output(error, Output))). 2445print_test_output(message, Output) => 2446 print_message(debug, plunit(test_output(error, Output))). 2447print_test_output(_, Output) => 2448 print_message(debug, plunit(test_output(informational, Output))).
2454jobs_redraw :- 2455 job_window(N), 2456 !, 2457 tty_columns(_, Width), 2458 tty_header_line(Width), 2459 forall(between(1,N,Line), job_redraw_worker(Line)), 2460 tty_header_line(Width). 2461jobs_redraw. 2462 2463job_redraw_worker(Line) :- 2464 ( job_status_line(Line, Fmt, Args) 2465 -> ansi_format(comment, Fmt, Args) 2466 ; true 2467 ), 2468 nl.
2476job_format(Style, Fmt, Args) :-
2477 job_self(Job),
2478 job_format(Job, Style, Fmt, Args, true).2486job_finish(Style, Fmt, Args) :- 2487 job_self(Job), 2488 job_finish(Job, Style, Fmt, Args). 2489 2490:- det(job_finish/4). 2491job_finish(Job, Style, Fmt, Args) :- 2492 retract(job_status_line(Job, Fmt0, Args0)), 2493 !, 2494 string_concat(Fmt0, Fmt, Fmt1), 2495 append(Args0, Args, Args1), 2496 job_format(Job, Style, Fmt1, Args1, false). 2497 2498:- det(job_format/5). 2499job_format(Job, Style, Fmt, Args, Save) :- 2500 job_window(Jobs), 2501 Up is Jobs+2-Job, 2502 flush_output(user_output), 2503 tty_up_and_clear(Up), 2504 ansi_format(Style, Fmt, Args), 2505 ( Save == true 2506 -> retractall(job_status_line(Job, _, _)), 2507 asserta(job_status_line(Job, Fmt, Args)) 2508 ; true 2509 ), 2510 tty_down_and_home(Up), 2511 flush_output(user_output). 2512 2513:- det(job_self/1). 2514job_self(Job) :- 2515 job_window(N), 2516 N > 1, 2517 thread_self(Me), 2518 split_string(Me, '_', '', [_,_,S]), 2519 number_string(Job, S).
tty format, which reuses the current
output line if the test is successful.2526tty_feedback :- 2527 has_tty, 2528 current_test_flag(format, tty). 2529 2530has_tty :- 2531 stream_property(user_output, tty(true)). 2532 2533tty_columns(SummaryWidth, Margin) :- 2534 tty_width(W), 2535 Margin is W-8, 2536 SummaryWidth is max(20,Margin-34). 2537 2538tty_width(W) :- 2539 current_predicate(tty_size/2), 2540 catch(tty_size(_Rows, Cols), error(_,_), fail), 2541 Cols > 25, 2542 !, 2543 W = Cols. 2544tty_width(80). 2545 2546tty_header_line(Width) :- 2547 ansi_format(comment, '~N~`\u2015t~*|~n', [Width]). 2548 2549:- if(current_predicate(tty_get_capability/3)). 2550tty_clear_to_eol(S) :- 2551 getenv('TERM', _), 2552 catch(tty_get_capability(ce, string, S), 2553 error(_,_), 2554 fail), 2555 !. 2556:- endif. 2557tty_clear_to_eol('\e[K'). 2558 2559tty_up_and_clear(Lines) :- 2560 format(user_output, '\e[~dA\r\e[K', [Lines]). 2561 2562tty_down_and_home(Lines) :- 2563 format(user_output, '\e[~dB\r', [Lines]). 2564 2565:- if(swi). 2566 2567:- multifile 2568 prolog:message/3, 2569 user:message_hook/3. 2570 2571prologmessage(Term) --> 2572 message(Term). 2573 2574% user:message_hook(+Term, +Kind, +Lines) 2575 2576user:message_hook(make(done(Files)), _, _) :- 2577 make_run_tests(Files), 2578 fail. % give other hooks a chance 2579 2580:- endif. 2581 2582:- if(sicstus). 2583 2584usergenerate_message_hook(Message) --> 2585 message(Message), 2586 [nl]. % SICStus requires nl at the end
2595user:message_hook(informational, plunit(begin(Unit)), _Lines) :- 2596 format(user_error, '% PL-Unit: ~w ', [Unit]), 2597 flush_output(user_error). 2598user:message_hook(informational, plunit(end(_Unit)), _Lines) :- 2599 format(user, ' done~n', []). 2600 2601:- endif.
Unit Testing
Unit testing environment for SWI-Prolog and SICStus Prolog. For usage, please visit https://www.swi-prolog.org/pldoc/package/plunit. */