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-2024, 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_trap_assertions(Ref), 742 call_time(setup_jobs_and_run_units(Count, Units, Summary, Options), 743 Time), 744 report_and_cleanup(Ref, Time, Options)), 745 ( option(summary(Summary), Options) 746 -> true 747 ; test_summary_passed(Summary) % fail if some test failed 748 ). 749 750setup_jobs_and_run_units(Count, Units, Summary, Options) :- 751 setup_call_cleanup( 752 setup_jobs(Count), 753 ( run_units(Units, Options), 754 test_summary(_All, Summary) 755 ), 756 cleanup_jobs).
763report_and_cleanup(Ref, Time, Options) :-
764 cleanup_trap_assertions(Ref),
765 report(Time, Options),
766 cleanup_after_test.
773run_units(Units, _Options) :-
774 maplist(schedule_unit, Units),
775 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.784:- det(runnable_tests/2). 785runnable_tests(Spec, Unit:RunnableTests) :- 786 unit_from_spec(Spec, Unit, Tests, Module, UnitOptions), 787 ( option(blocked(Reason), UnitOptions) 788 -> info(plunit(blocked(unit(Unit, Reason)))), 789 RunnableTests = [] 790 ; \+ condition(Module, unit(Unit), UnitOptions) 791 -> RunnableTests = [] 792 ; var(Tests) 793 -> findall(TestID, 794 runnable_test(Unit, _Test, Module, TestID), 795 RunnableTests) 796 ; flatten([Tests], TestList), 797 findall(TestID, 798 ( member(Test, TestList), 799 runnable_test(Unit,Test,Module, TestID) 800 ), 801 RunnableTests) 802 ). 803 804runnable_test(Unit, Name, Module, @(Test,Line)) :- 805 current_test(Unit, Name, Line, _Body, TestOptions), 806 ( option(blocked(Reason), TestOptions) 807 -> Test = blocked(Name, Reason) 808 ; condition(Module, test(Unit,Name,Line), TestOptions), 809 Test = Name 810 ). 811 812unit_from_spec(Unit0:Tests0, Unit, Tests, Module, Options), atom(Unit0) => 813 Unit = Unit0, 814 Tests = Tests0, 815 ( current_unit(Unit, Module, _Supers, Options) 816 -> true 817 ; throw_error(existence_error(unit_test, Unit), _) 818 ). 819unit_from_spec(Unit0, Unit, _, Module, Options), atom(Unit0) => 820 Unit = Unit0, 821 ( current_unit(Unit, Module, _Supers, Options) 822 -> true 823 ; throw_error(existence_error(unit_test, Unit), _) 824 ).
forall(Generator, Test)
counts
as a single test. During the execution, the concrete tests of the
forall are considered "sub tests".832count_tests(Units0, Units, Count) :- 833 count_tests(Units0, Units, 0, Count). 834 835count_tests([], T, C0, C) => 836 T = [], 837 C = C0. 838count_tests([_:[]|T0], T, C0, C) => 839 count_tests(T0, T, C0, C). 840count_tests([Unit:Tests|T0], T, C0, C) => 841 partition(is_blocked, Tests, Blocked, Use), 842 maplist(assert_blocked(Unit), Blocked), 843 ( Use == [] 844 -> count_tests(T0, T, C0, C) 845 ; length(Use, N), 846 C1 is C0+N, 847 T = [Unit:Use|T1], 848 count_tests(T0, T1, C1, C) 849 ). 850 851is_blocked(@(blocked(_,_),_)) => true. 852is_blocked(_) => fail. 853 854assert_blocked(Unit, @(blocked(Test, Reason), Line)) => 855 assert(blocked(Unit, Test, Line, Reason)).
862run_unit(_Unit:[]) => 863 true. 864run_unit(Unit:Tests) => 865 unit_module(Unit, Module), 866 unit_options(Unit, UnitOptions), 867 ( setup(Module, unit(Unit), UnitOptions) 868 -> begin_unit(Unit), 869 call_time(run_unit_2(Unit, Tests), Time), 870 test_summary(Unit, Summary), 871 end_unit(Unit, Summary.put(time, Time)), 872 cleanup(Module, UnitOptions) 873 ; job_info(end(unit(Unit, _{error:setup_failed}))) 874 ). 875 876begin_unit(Unit) :- 877 job_info(begin(unit(Unit))), 878 job_feedback(informational, begin(Unit)). 879 880end_unit(Unit, Summary) :- 881 job_info(end(unit(Unit, Summary))), 882 job_feedback(informational, end(Unit, Summary)). 883 884run_unit_2(Unit, Tests) :- 885 forall(member(Test, Tests), 886 run_test(Unit, Test)). 887 888 889unit_options(Unit, Options) :- 890 current_unit(Unit, _Module, _Supers, Options). 891 892 893cleanup :- 894 set_flag(plunit_test, 1), 895 retractall(output_streams(_,_)), 896 retractall(test_count(_)), 897 retractall(passed(_, _, _, _, _)), 898 retractall(failed(_, _, _, _, _)), 899 retractall(timeout(_, _, _, _, _)), 900 retractall(failed_assertion(_, _, _, _, _, _, _)), 901 retractall(blocked(_, _, _, _)), 902 retractall(fixme(_, _, _, _, _)), 903 retractall(running(_,_,_,_,_)), 904 retractall(forall_failures(_,_)). 905 906cleanup_after_test :- 907 ( current_test_flag(cleanup, true) 908 -> cleanup 909 ; true 910 ).
917run_tests_in_files(Files) :- 918 findall(Unit, unit_in_files(Files, Unit), Units), 919 ( Units == [] 920 -> true 921 ; run_tests(Units) 922 ). 923 924unit_in_files(Files, Unit) :- 925 is_list(Files), 926 !, 927 member(F, Files), 928 absolute_file_name(F, Source, 929 [ file_type(prolog), 930 access(read), 931 file_errors(fail) 932 ]), 933 unit_file(Unit, Source). 934 935 936 /******************************* 937 * HOOKING MAKE/0 * 938 *******************************/
944make_run_tests(Files) :- 945 current_test_flag(run, When), 946 ( When == make 947 -> run_tests_in_files(Files) 948 ; When == make(all) 949 -> run_tests 950 ; true 951 ). 952 953 /******************************* 954 * ASSERTION HANDLING * 955 *******************************/ 956 957:- if(swi). 958 959:- dynamic prolog:assertion_failed/2. 960 961setup_trap_assertions(Ref) :- 962 asserta((prolog:assertion_failed(Reason, Goal) :- 963 test_assertion_failed(Reason, Goal)), 964 Ref). 965 966cleanup_trap_assertions(Ref) :- 967 erase(Ref). 968 969test_assertion_failed(Reason, Goal) :- 970 thread_self(Me), 971 running(Unit, Test, Line, Progress, Me), 972 ( catch(get_prolog_backtrace(10, Stack), _, fail), 973 assertion_location(Stack, AssertLoc) 974 -> true 975 ; AssertLoc = unknown 976 ), 977 report_failed_assertion(Unit:Test, Line, AssertLoc, 978 Progress, Reason, Goal), 979 assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc, 980 Progress, Reason, Goal)). 981 982assertion_location(Stack, File:Line) :- 983 append(_, [AssertFrame,CallerFrame|_], Stack), 984 prolog_stack_frame_property(AssertFrame, 985 predicate(prolog_debug:assertion/1)), 986 !, 987 prolog_stack_frame_property(CallerFrame, location(File:Line)). 988 989report_failed_assertion(UnitTest, Line, AssertLoc, 990 Progress, Reason, Goal) :- 991 print_message( 992 error, 993 plunit(failed_assertion(UnitTest, Line, AssertLoc, 994 Progress, Reason, Goal))). 995 996:- else. 997 998setup_trap_assertions(_). 999cleanup_trap_assertions(_). 1000 1001:- endif. 1002 1003 1004 /******************************* 1005 * RUNNING A TEST * 1006 *******************************/
1012run_test(Unit, @(Test,Line)) :-
1013 unit_module(Unit, Module),
1014 Module:'unit test'(Test, Line, TestOptions, Body),
1015 unit_options(Unit, UnitOptions),
1016 run_test(Unit, Test, Line, UnitOptions, TestOptions, Body).
forall(Generator, Test)
1022run_test(Unit, Name, Line, UnitOptions, Options, Body) :- 1023 option(forall(Generator), Options), 1024 !, 1025 unit_module(Unit, Module), 1026 term_variables(Generator, Vars), 1027 start_test(Unit, @(Name,Line), Nth), 1028 State = state(0), 1029 call_time(forall(Module:Generator, % may become concurrent 1030 ( incr_forall(State, I), 1031 run_test_once6(Unit, Name, forall(Vars, Nth-I), Line, 1032 UnitOptions, Options, Body) 1033 )), 1034 Time), 1035 arg(1, State, Generated), 1036 progress(Unit:Name, Nth, forall(end, Nth, Generated), Time). 1037run_test(Unit, Name, Line, UnitOptions, Options, Body) :- 1038 start_test(Unit, @(Name,Line), Nth), 1039 run_test_once6(Unit, Name, Nth, Line, UnitOptions, Options, Body). 1040 1041start_test(_Unit, _TestID, Nth) :- 1042 flag(plunit_test, Nth, Nth+1). 1043 1044incr_forall(State, I) :- 1045 arg(1, State, I0), 1046 I is I0+1, 1047 nb_setarg(1, State, I).
timeout
and occurs_check
option (Global -> Unit -> Test).1054run_test_once6(Unit, Name, Progress, Line, UnitOptions, Options, Body) :- 1055 current_test_flag(timeout, DefTimeOut), 1056 current_test_flag(occurs_check, DefOccurs), 1057 inherit_option(timeout, Options, [UnitOptions], DefTimeOut, Options1), 1058 inherit_option(occurs_check, Options1, [UnitOptions], DefOccurs, Options2), 1059 run_test_once(Unit, Name, Progress, Line, Options2, Body). 1060 1061inherit_option(Name, Options0, Chain, Default, Options) :- 1062 Term =.. [Name,_Value], 1063 ( option(Term, Options0) 1064 -> Options = Options0 1065 ; member(Opts, Chain), 1066 option(Term, Opts) 1067 -> Options = [Term|Options0] 1068 ; Default == (-) 1069 -> Options = Options0 1070 ; Opt =.. [Name,Default], 1071 Options = [Opt|Options0] 1072 ).
1079run_test_once(Unit, Name, Progress, Line, Options, Body) :- 1080 option(occurs_check(Occurs), Options), 1081 !, 1082 begin_test(Unit, Name, Line, Progress), 1083 current_prolog_flag(occurs_check, Old), 1084 setup_call_cleanup( 1085 set_prolog_flag(occurs_check, Occurs), 1086 capture_output(run_test_6(Unit, Name, Line, Options, Body, Result), 1087 Output), 1088 set_prolog_flag(occurs_check, Old)), 1089 end_test(Unit, Name, Line, Progress), 1090 report_result(Result, Progress, Output, Options). 1091run_test_once(Unit, Name, Progress, Line, Options, Body) :- 1092 begin_test(Unit, Name, Line, Progress), 1093 capture_output(run_test_6(Unit, Name, Line, Options, Body, Result), 1094 Output), 1095 end_test(Unit, Name, Line, Progress), 1096 report_result(Result, Progress, Output, Options).
1100:- det(report_result/4). 1101report_result(failure(Unit, Name, Line, How, Time), 1102 Progress, Output, Options) => 1103 failure(Unit, Name, Progress, Line, How, Time, Output, Options). 1104report_result(success(Unit, Name, Line, Determinism, Time), 1105 Progress, Output, Options) => 1106 success(Unit, Name, Progress, Line, Determinism, Time, Output, Options). 1107report_result(setup_failed(Unit, Name, Line, Time, Output, Result), 1108 Progress, _Output, Options) => 1109 failure(Unit, Name, Progress, Line, 1110 setup_failed(Result), Time, Output, Options).
time_limit_exceeded(Limit)
cmp_error(Cmp, E)
wrong_answer(Cmp)
wrong_error(Expect, E)
wrong_answer(Expected, Bindings)
1132run_test_6(Unit, Name, Line, Options, Body, Result) :- 1133 option(setup(Setup), Options), 1134 !, 1135 unit_module(Unit, Module), 1136 capture_output(call_time(reify(call_ex(Module, Setup), SetupResult), 1137 Time), 1138 Output), 1139 ( SetupResult == true 1140 -> run_test_7(Unit, Name, Line, Options, Body, Result), 1141 cleanup(Module, Options) 1142 ; Result = setup_failed(Unit, Name, Line, Time, Output, SetupResult) 1143 ). 1144run_test_6(Unit, Name, Line, Options, Body, Result) :- 1145 unit_module(Unit, Module), 1146 run_test_7(Unit, Name, Line, Options, Body, Result), 1147 cleanup(Module, Options).
1156run_test_7(Unit, Name, Line, Options, Body, Result) :- 1157 option(true(Cmp), Options), % expected success 1158 !, 1159 unit_module(Unit, Module), 1160 call_time(reify_tmo(call_det(Module:Body, Det), Result0, Options), Time), 1161 ( Result0 == true 1162 -> cmp_true(Cmp, Module, CmpResult), 1163 ( CmpResult == [] 1164 -> Result = success(Unit, Name, Line, Det, Time) 1165 ; Result = failure(Unit, Name, Line, CmpResult, Time) 1166 ) 1167 ; Result0 == false 1168 -> Result = failure(Unit, Name, Line, failed, Time) 1169 ; Result0 = throw(E2) 1170 -> Result = failure(Unit, Name, Line, throw(E2), Time) 1171 ). 1172run_test_7(Unit, Name, Line, Options, Body, Result) :- 1173 option(fail, Options), % expected failure 1174 !, 1175 unit_module(Unit, Module), 1176 call_time(reify_tmo(Module:Body, Result0, Options), Time), 1177 ( Result0 == true 1178 -> Result = failure(Unit, Name, Line, succeeded, Time) 1179 ; Result0 == false 1180 -> Result = success(Unit, Name, Line, true, Time) 1181 ; Result0 = throw(E) 1182 -> Result = failure(Unit, Name, Line, throw(E), Time) 1183 ). 1184run_test_7(Unit, Name, Line, Options, Body, Result) :- 1185 option(throws(Expect), Options), % Expected error 1186 !, 1187 unit_module(Unit, Module), 1188 call_time(reify_tmo(Module:Body, Result0, Options), Time), 1189 ( Result0 == true 1190 -> Result = failure(Unit, Name, Line, no_exception, Time) 1191 ; Result0 == false 1192 -> Result = failure(Unit, Name, Line, failed, Time) 1193 ; Result0 = throw(E) 1194 -> ( match_error(Expect, E) 1195 -> Result = success(Unit, Name, Line, true, Time) 1196 ; Result = failure(Unit, Name, Line, wrong_error(Expect, E), Time) 1197 ) 1198 ). 1199run_test_7(Unit, Name, Line, Options, Body, Result) :- 1200 option(all(Answer), Options), % all(Bindings) 1201 !, 1202 nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result). 1203run_test_7(Unit, Name, Line, Options, Body, Result) :- 1204 option(set(Answer), Options), % set(Bindings) 1205 !, 1206 nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
1212nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :- 1213 unit_module(Unit, Module), 1214 result_vars(Expected, Vars), 1215 ( call_time(reify_tmo(findall(Vars, Module:Body, Bindings), 1216 Result0, Options), Time) 1217 -> ( Result0 == true 1218 -> ( nondet_compare(Expected, Bindings, Unit, Name, Line) 1219 -> Result = success(Unit, Name, Line, true, Time) 1220 ; Result = failure(Unit, Name, Line, 1221 [wrong_answer(Expected, Bindings)], Time) 1222 ) 1223 ; Result0 = throw(E) 1224 -> Result = failure(Unit, Name, Line, throw(E), Time) 1225 ) 1226 ). 1227 1228cmp_true([], _, L) => 1229 L = []. 1230cmp_true([Cmp|T], Module, L) => 1231 E = error(Formal,_), 1232 cmp_goal(Cmp, Goal), 1233 ( catch(Module:Goal, E, true) 1234 -> ( var(Formal) 1235 -> cmp_true(T, Module, L) 1236 ; L = [cmp_error(Cmp,E)|L1], 1237 cmp_true(T, Module, L1) 1238 ) 1239 ; L = [wrong_answer(Cmp)|L1], 1240 cmp_true(T, Module, L1) 1241 ). 1242 1243cmp_goal(cmp(_Var, Expr), Goal) => Goal = Expr. 1244cmp_goal(Expr, Goal) => Goal = Expr.
v(V1, ...)
containing all variables at the left
side of the comparison operator on Expected.
1252result_vars(Expected, Vars) :-
1253 arg(1, Expected, CmpOp),
1254 arg(1, CmpOp, Vars).
1264nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :- 1265 cmp(Cmp, _Vars, Op, Values), 1266 cmp_list(Values, Bindings, Op). 1267nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :- 1268 cmp(Cmp, _Vars, Op, Values0), 1269 sort(Bindings0, Bindings), 1270 sort(Values0, Values), 1271 cmp_list(Values, Bindings, Op). 1272 1273cmp_list([], [], _Op). 1274cmp_list([E0|ET], [V0|VT], Op) :- 1275 call(Op, E0, V0), 1276 cmp_list(ET, VT, Op).
1280cmp(Var == Value, Var, ==, Value). 1281cmp(Var =:= Value, Var, =:=, Value). 1282cmp(Var = Value, Var, =, Value). 1283:- if(swi). 1284cmp(Var =@= Value, Var, =@=, Value). 1285:- else. 1286:- if(sicstus). 1287cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@= 1288:- endif. 1289:- endif.
true
if Goal left
no choicepoints and false
otherwise.1297:- if((swi;sicstus)). 1298call_det(Goal, Det) :- 1299 call_cleanup(Goal,Det0=true), 1300 ( var(Det0) -> Det = false ; Det = true ). 1301:- else. 1302call_det(Goal, true) :- 1303 call(Goal). 1304:- endif.
1311match_error(Expect, Rec) :-
1312 subsumes_term(Expect, Rec).
1325setup(Module, Context, Options) :- 1326 option(setup(Setup), Options), 1327 !, 1328 capture_output(reify(call_ex(Module, Setup), Result), Output), 1329 ( Result == true 1330 -> true 1331 ; print_message(error, 1332 plunit(error(setup, Context, Output, Result))), 1333 fail 1334 ). 1335setup(_,_,_).
1341condition(Module, Context, Options) :- 1342 option(condition(Cond), Options), 1343 !, 1344 capture_output(reify(call_ex(Module, Cond), Result), Output), 1345 ( Result == true 1346 -> true 1347 ; Result == false 1348 -> fail 1349 ; print_message(error, 1350 plunit(error(condition, Context, Output, Result))), 1351 fail 1352 ). 1353condition(_, _, _).
1360call_ex(Module, Goal) :-
1361 Module:(expand_goal(Goal, GoalEx),
1362 GoalEx).
1369cleanup(Module, Options) :- 1370 option(cleanup(Cleanup), Options, true), 1371 ( catch(call_ex(Module, Cleanup), E, true) 1372 -> ( var(E) 1373 -> true 1374 ; print_message(warning, E) 1375 ) 1376 ; print_message(warning, goal_failed(Cleanup, '(cleanup handler)')) 1377 ). 1378 1379success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :- 1380 memberchk(fixme(Reason), Options), 1381 !, 1382 ( ( Det == true 1383 ; memberchk(nondet, Options) 1384 ) 1385 -> progress(Unit:Name, Progress, fixme(passed), Time), 1386 Ok = passed 1387 ; progress(Unit:Name, Progress, fixme(nondet), Time), 1388 Ok = nondet 1389 ), 1390 flush_output(user_error), 1391 assert(fixme(Unit, Name, Line, Reason, Ok)). 1392success(Unit, Name, Progress, Line, _, Time, Output, Options) :- 1393 failed_assertion(Unit, Name, Line, _,Progress,_,_), 1394 !, 1395 failure(Unit, Name, Progress, Line, assertion, Time, Output, Options). 1396success(Unit, Name, Progress, Line, _, Time, Output, Options) :- 1397 Output = true-_, 1398 !, 1399 failure(Unit, Name, Progress, Line, message, Time, Output, Options). 1400success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :- 1401 assert(passed(Unit, Name, Line, Det, Time)), 1402 ( ( Det == true 1403 ; memberchk(nondet, Options) 1404 ) 1405 -> progress(Unit:Name, Progress, passed, Time) 1406 ; unit_file(Unit, File), 1407 print_message(warning, plunit(nondet(File, Line, Name))) 1408 ).
1415failure(Unit, Name, Progress, Line, _, Time, _Output, Options), 1416 memberchk(fixme(Reason), Options) => 1417 assert(fixme(Unit, Name, Line, Reason, failed)), 1418 progress(Unit:Name, Progress, fixme(failed), Time). 1419failure(Unit, Name, Progress, Line, time_limit_exceeded(Limit), Time, 1420 Output, Options) => 1421 assert_cyclic(timeout(Unit, Name, Line, Limit, Time)), 1422 progress(Unit:Name, Progress, timeout(Limit), Time), 1423 report_failure(Unit, Name, Progress, Line, timeout(Limit), Time, Output, Options). 1424failure(Unit, Name, Progress, Line, E, Time, Output, Options) => 1425 assert_cyclic(failed(Unit, Name, Line, E, Time)), 1426 progress(Unit:Name, Progress, failed, Time), 1427 report_failure(Unit, Name, Progress, Line, E, Time, Output, Options).
1437:- if(swi). 1438assert_cyclic(Term) :- 1439 acyclic_term(Term), 1440 !, 1441 assert(Term). 1442assert_cyclic(Term) :- 1443 Term =.. [Functor|Args], 1444 recorda(cyclic, Args, Id), 1445 functor(Term, _, Arity), 1446 length(NewArgs, Arity), 1447 Head =.. [Functor|NewArgs], 1448 assert(( :- recorded(_, Var, Id), Var = NewArgs)). 1449:- else. 1450:- if(sicstus). 1451:- endif. 1452assert_cyclic(Term) :- 1453 assert(Term). 1454:- endif. 1455 1456 1457 /******************************* 1458 * JOBS * 1459 *******************************/ 1460 1461:- if(current_prolog_flag(threads, true)). 1462 1463:- dynamic 1464 job_data/2, % Queue, Threads 1465 scheduled_unit/1. 1466 1467schedule_unit(_:[]) :- 1468 !. 1469schedule_unit(UnitAndTests) :- 1470 UnitAndTests = Unit:_Tests, 1471 job_data(Queue, _), 1472 !, 1473 assertz(scheduled_unit(Unit)), 1474 thread_send_message(Queue, unit(UnitAndTests)). 1475schedule_unit(Unit) :- 1476 run_unit(Unit).
1482setup_jobs(Count) :- 1483 ( current_test_flag(jobs, Jobs0), 1484 integer(Jobs0) 1485 -> true 1486 ; current_prolog_flag(cpu_count, Jobs0) 1487 ), 1488 Jobs is min(Count, Jobs0), 1489 Jobs > 1, 1490 !, 1491 message_queue_create(Q, [alias(plunit_jobs)]), 1492 length(TIDs, Jobs), 1493 foldl(create_plunit_job(Q), TIDs, 1, _), 1494 asserta(job_data(Q, TIDs)), 1495 job_feedback(informational, jobs(Jobs)). 1496setup_jobs(_) :- 1497 job_feedback(informational, jobs(1)). 1498 1499create_plunit_job(Q, TID, N, N1) :- 1500 N1 is N + 1, 1501 atom_concat(plunit_job_, N, Alias), 1502 thread_create(plunit_job(Q), TID, [alias(Alias)]). 1503 1504plunit_job(Queue) :- 1505 repeat, 1506 ( catch(thread_get_message(Queue, Job, 1507 [ timeout(10) 1508 ]), 1509 error(_,_), fail) 1510 -> job(Job), 1511 fail 1512 ; ! 1513 ). 1514 1515job(unit(Unit:Tests)) => 1516 run_unit(Unit:Tests). 1517job(test(Unit, Test)) => 1518 run_test(Unit, Test). 1519 1520cleanup_jobs :- 1521 retract(job_data(Queue, TIDSs)), 1522 !, 1523 message_queue_destroy(Queue), 1524 maplist(thread_join, TIDSs). 1525cleanup_jobs.
1531job_wait(Unit) :- 1532 thread_wait(\+ scheduled_unit(Unit), 1533 [ wait_preds([scheduled_unit/1]), 1534 timeout(1) 1535 ]), 1536 !. 1537job_wait(Unit) :- 1538 job_data(_Queue, TIDs), 1539 member(TID, TIDs), 1540 thread_property(TID, status(running)), 1541 !, 1542 job_wait(Unit). 1543job_wait(_). 1544 1545 1546job_info(begin(unit(Unit))) => 1547 print_message(silent, plunit(begin(Unit))). 1548job_info(end(unit(Unit, Summary))) => 1549 retractall(scheduled_unit(Unit)), 1550 print_message(silent, plunit(end(Unit, Summary))). 1551 1552:- else. % No jobs 1553 1554schedule_unit(Unit) :- 1555 run_unit(Unit). 1556 1557setup_jobs(_) :- 1558 print_message(silent, plunit(jobs(1))). 1559cleanup_jobs. 1560job_wait(_). 1561job_info(_). 1562 1563:- endif. 1564 1565 1566 1567 /******************************* 1568 * REPORTING * 1569 *******************************/
silent
message:
plunit(begin(Unit:Test, File:Line, Progress))
plunit(end(Unit:Test, File:Line, Progress))
1582begin_test(Unit, Test, Line, Progress) :- 1583 thread_self(Me), 1584 assert(running(Unit, Test, Line, Progress, Me)), 1585 unit_file(Unit, File), 1586 test_count(Total), 1587 job_feedback(information, begin(Unit:Test, File:Line, Progress/Total)). 1588 1589end_test(Unit, Test, Line, Progress) :- 1590 thread_self(Me), 1591 retractall(running(_,_,_,_,Me)), 1592 unit_file(Unit, File), 1593 test_count(Total), 1594 job_feedback(information, end(Unit:Test, File:Line, Progress/Total)).
1600running_tests :- 1601 running_tests(Running), 1602 print_message(informational, plunit(running(Running))). 1603 1604running_tests(Running) :- 1605 test_count(Total), 1606 findall(running(Unit:Test, File:Line, Progress/Total, Thread), 1607 ( running(Unit, Test, Line, Progress, Thread), 1608 unit_file(Unit, File) 1609 ), Running).
1616current_test(Unit, Test, Line, Body, Options) :-
1617 current_unit(Unit, Module, _Supers, _UnitOptions),
1618 Module:'unit test'(Test, Line, Options, Body).
1624current_test_unit(Unit, UnitOptions) :- 1625 current_unit(Unit, _Module, _Supers, UnitOptions). 1626 1627 1628count(Goal, Count) :- 1629 aggregate_all(count, Goal, Count).
1636test_summary(Unit, Summary) :- 1637 count(failed(Unit, _0Test, _0Line, _Reason, _0Time), Failed), 1638 count(timeout(Unit, _0Test, _0Line, _Limit, _0Time), Timeout), 1639 count(passed(Unit, _0Test, _0Line, _Det, _0Time), Passed), 1640 count(blocked(Unit, _0Test, _0Line, _0Reason), Blocked), 1641 count(fixme(Unit, _0Test, _0Line, _0Reason, _0How), Fixme), 1642 test_count(Total), 1643 Summary = plunit{total:Total, 1644 passed:Passed, 1645 failed:Failed, 1646 timeout:Timeout, 1647 blocked:Blocked, 1648 fixme:Fixme}. 1649 1650test_summary_passed(Summary) :- 1651 _{failed: 0} :< Summary.
1657report(Time, _Options) :- 1658 test_summary(_, Summary), 1659 print_message(silent, plunit(Summary)), 1660 _{ passed:Passed, 1661 failed:Failed, 1662 timeout:Timeout, 1663 blocked:Blocked, 1664 fixme:Fixme 1665 } :< Summary, 1666 ( Passed+Failed+Timeout+Blocked+Fixme =:= 0 1667 -> info(plunit(no_tests)) 1668 ; Failed+Timeout =:= 0 1669 -> report_blocked(Blocked), 1670 report_fixme, 1671 test_count(Total), 1672 info(plunit(all_passed(Total, Passed, Time))) 1673 ; report_blocked(Blocked), 1674 report_fixme, 1675 report_failed(Failed), 1676 report_timeout(Timeout), 1677 info(plunit(passed(Passed))), 1678 info(plunit(total_time(Time))) 1679 ). 1680 1681report_blocked(0) => 1682 true. 1683report_blocked(Blocked) => 1684 findall(blocked(Unit:Name, File:Line, Reason), 1685 ( blocked(Unit, Name, Line, Reason), 1686 unit_file(Unit, File) 1687 ), 1688 BlockedTests), 1689 info(plunit(blocked(Blocked, BlockedTests))). 1690 1691report_failed(Failed) :- 1692 print_message(error, plunit(failed(Failed))). 1693 1694report_timeout(Count) :- 1695 print_message(warning, plunit(timeout(Count))). 1696 1697report_fixme :- 1698 report_fixme(_,_,_). 1699 1700report_fixme(TuplesF, TuplesP, TuplesN) :- 1701 fixme(failed, TuplesF, Failed), 1702 fixme(passed, TuplesP, Passed), 1703 fixme(nondet, TuplesN, Nondet), 1704 print_message(informational, plunit(fixme(Failed, Passed, Nondet))). 1705 1706 1707fixme(How, Tuples, Count) :- 1708 findall(fixme(Unit, Name, Line, Reason, How), 1709 fixme(Unit, Name, Line, Reason, How), Tuples), 1710 length(Tuples, Count). 1711 1712report_failure(Unit, Name, Progress, Line, Error, 1713 Time, Output, _Options) => 1714 test_count(Total), 1715 job_feedback(error, failed(Unit:Name, Progress/Total, Line, 1716 Error, Time, Output)).
fixme
for What.1724test_report(fixme) :- 1725 !, 1726 report_fixme(TuplesF, TuplesP, TuplesN), 1727 append([TuplesF, TuplesP, TuplesN], Tuples), 1728 print_message(informational, plunit(fixme(Tuples))). 1729test_report(What) :- 1730 throw_error(domain_error(report_class, What), _). 1731 1732 1733 /******************************* 1734 * INFO * 1735 *******************************/
1742unit_file(Unit, File), nonvar(Unit) => 1743 unit_file_(Unit, File), 1744 !. 1745unit_file(Unit, File) => 1746 unit_file_(Unit, File). 1747 1748unit_file_(Unit, File) :- 1749 current_unit(Unit, Module, _Context, _Options), 1750 module_property(Module, file(File)). 1751unit_file_(Unit, PlFile) :- 1752 test_file_for(TestFile, PlFile), 1753 module_property(Module, file(TestFile)), 1754 current_unit(Unit, Module, _Context, _Options). 1755 1756 1757 /******************************* 1758 * FILES * 1759 *******************************/
1766load_test_files(_Options) :- 1767 State = state(0,0), 1768 ( source_file(File), 1769 file_name_extension(Base, Old, File), 1770 Old \== plt, 1771 file_name_extension(Base, plt, TestFile), 1772 exists_file(TestFile), 1773 inc_arg(1, State), 1774 ( test_file_for(TestFile, File) 1775 -> true 1776 ; load_files(TestFile, 1777 [ if(changed), 1778 imports([]) 1779 ]), 1780 inc_arg(2, State), 1781 asserta(test_file_for(TestFile, File)) 1782 ), 1783 fail 1784 ; State = state(Total, Loaded), 1785 print_message(informational, plunit(test_files(Total, Loaded))) 1786 ). 1787 1788inc_arg(Arg, State) :- 1789 arg(Arg, State, N0), 1790 N is N0+1, 1791 nb_setarg(Arg, State, N). 1792 1793 1794 /******************************* 1795 * MESSAGES * 1796 *******************************/
print_message(Level, Term)
, where Level is one of silent
or
informational
(default).
1803info(Term) :-
1804 message_level(Level),
1805 print_message(Level, Term).
forall(Gen,Test)
set. Mapped
to forall(FTotal, FFailed)
1822progress(UnitTest, _Progress, forall(end, Nth, FTotal), Time) => 1823 ( retract(forall_failures(Nth, FFailed)) 1824 -> true 1825 ; FFailed = 0 1826 ), 1827 test_count(Total), 1828 job_feedback(information, progress(UnitTest, forall(FTotal,FFailed), Nth/Total, Time)). 1829progress(UnitTest, Progress, Result, Time), Progress = forall(_Vars, Nth-_I) => 1830 with_mutex(plunit_forall_counter, 1831 update_forall_failures(Nth, Result)), 1832 test_count(Total), 1833 job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)). 1834progress(UnitTest, Progress, Result, Time) => 1835 test_count(Total), 1836 job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)). 1837 1838update_forall_failures(_Nth, passed) => 1839 true. 1840update_forall_failures(Nth, _) => 1841 ( retract(forall_failures(Nth, Failed0)) 1842 -> true 1843 ; Failed0 = 0 1844 ), 1845 Failed is Failed0+1, 1846 asserta(forall_failures(Nth, Failed)). 1847 1848message_level(Level) :- 1849 ( current_test_flag(silent, true) 1850 -> Level = silent 1851 ; Level = informational 1852 ). 1853 1854locationprefix(File:Line) --> 1855 !, 1856 [ url(File:Line), ':'-[], nl, ' ' ]. 1857locationprefix(test(Unit,_Test,Line)) --> 1858 !, 1859 { unit_file(Unit, File) }, 1860 locationprefix(File:Line). 1861locationprefix(unit(Unit)) --> 1862 !, 1863 [ 'PL-Unit: unit ~w: '-[Unit] ]. 1864locationprefix(FileLine) --> 1865 { throw_error(type_error(locationprefix,FileLine), _) }. 1866 1867:- discontiguous 1868 message//1. 1869:- '$hide'(message//1). 1870 1871message(error(context_error(plunit_close(Name, -)), _)) --> 1872 [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ]. 1873message(error(context_error(plunit_close(Name, Start)), _)) --> 1874 [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ]. 1875message(plunit(nondet(File, Line, Name))) --> 1876 locationprefix(File:Line), 1877 [ 'PL-Unit: Test ~w: Test succeeded with choicepoint'- [Name] ]. 1878message(error(plunit(incompatible_options, Tests), _)) --> 1879 [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ]. 1880message(plunit(sto(true))) --> 1881 [ 'Option sto(true) is ignored. See `occurs_check` option.'-[] ]. 1882message(plunit(test_files(Total, Loaded))) --> 1883 [ 'Found ~D .plt test files, loaded ~D'-[Total, Loaded] ]. 1884 1885 % Unit start/end 1886message(plunit(jobs(1))) --> 1887 !. 1888message(plunit(jobs(N))) --> 1889 [ 'Testing with ~D parallel jobs'-[N] ]. 1890message(plunit(begin(_Unit))) --> 1891 { tty_feedback }, 1892 !. 1893message(plunit(begin(Unit))) --> 1894 [ 'Start unit: ~w~n'-[Unit], flush ]. 1895message(plunit(end(_Unit, _Summary))) --> 1896 { tty_feedback }, 1897 !. 1898message(plunit(end(Unit, Summary))) --> 1899 ( {test_summary_passed(Summary)} 1900 -> [ 'End unit ~w: passed (~3f sec CPU)'-[Unit, Summary.time.cpu] ] 1901 ; [ ansi(error, 'End unit ~w: **FAILED (~3f sec CPU)', [Unit, Summary.time.cpu]) ] 1902 ). 1903message(plunit(blocked(unit(Unit, Reason)))) --> 1904 [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ]. 1905message(plunit(running([]))) --> 1906 !, 1907 [ 'PL-Unit: no tests running' ]. 1908message(plunit(running([One]))) --> 1909 !, 1910 [ 'PL-Unit: running ' ], 1911 running(One). 1912message(plunit(running(More))) --> 1913 !, 1914 [ 'PL-Unit: running tests:', nl ], 1915 running(More). 1916message(plunit(fixme([]))) --> !. 1917message(plunit(fixme(Tuples))) --> 1918 !, 1919 fixme_message(Tuples). 1920message(plunit(total_time(Time))) --> 1921 [ 'Test run completed'-[] ], 1922 test_time(Time). 1923 1924 % Blocked tests 1925message(plunit(blocked(1, Tests))) --> 1926 !, 1927 [ 'one test is blocked'-[] ], 1928 blocked_tests(Tests). 1929message(plunit(blocked(N, Tests))) --> 1930 [ '~D tests are blocked'-[N] ], 1931 blocked_tests(Tests). 1932 1933blocked_tests(Tests) --> 1934 { current_test_flag(show_blocked, true) }, 1935 !, 1936 [':'-[]], 1937 list_blocked(Tests). 1938blocked_tests(_) --> 1939 [ ' (use run_tests/2 with ', ansi(code, 'show_blocked(true)', []), 1940 ' for details)'-[] 1941 ]. 1942 1943list_blocked([]) --> !. 1944list_blocked([blocked(Unit:Test, Pos, Reason)|T]) --> 1945 [nl], 1946 locationprefix(Pos), 1947 test_name(Unit:Test, -), 1948 [ ': ~w'-[Reason] ], 1949 list_blocked(T). 1950 1951 % fail/success 1952message(plunit(no_tests)) --> 1953 !, 1954 [ 'No tests to run' ]. 1955message(plunit(all_passed(1, 1, Time))) --> 1956 !, 1957 [ 'test passed' ], 1958 test_time(Time). 1959message(plunit(all_passed(Total, Total, Time))) --> 1960 !, 1961 [ 'All ~D tests passed'-[Total] ], 1962 test_time(Time). 1963message(plunit(all_passed(Total, Count, Time))) --> 1964 !, 1965 { SubTests is Count-Total }, 1966 [ 'All ~D (+~D sub-tests) tests passed'- [Total, SubTests] ], 1967 test_time(Time). 1968 1969test_time(Time) --> 1970 { var(Time) }, !. 1971test_time(Time) --> 1972 [ ' in ~3f seconds (~3f cpu)'-[Time.wall, Time.cpu] ]. 1973 1974message(plunit(passed(Count))) --> 1975 !, 1976 [ '~D tests passed'-[Count] ]. 1977message(plunit(failed(0))) --> 1978 !, 1979 []. 1980message(plunit(failed(1))) --> 1981 !, 1982 [ '1 test failed'-[] ]. 1983message(plunit(failed(N))) --> 1984 [ '~D tests failed'-[N] ]. 1985message(plunit(timeout(0))) --> 1986 !, 1987 []. 1988message(plunit(timeout(N))) --> 1989 [ '~D tests timed out'-[N] ]. 1990message(plunit(fixme(0,0,0))) --> 1991 []. 1992message(plunit(fixme(Failed,0,0))) --> 1993 !, 1994 [ 'all ~D tests flagged FIXME failed'-[Failed] ]. 1995message(plunit(fixme(Failed,Passed,0))) --> 1996 [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ]. 1997message(plunit(fixme(Failed,Passed,Nondet))) --> 1998 { TotalPassed is Passed+Nondet }, 1999 [ 'FIXME: ~D failed; ~D passed; (~D nondet)'- 2000 [Failed, TotalPassed, Nondet] ]. 2001 2002message(plunit(begin(Unit:Test, _Location, Progress))) --> 2003 { tty_columns(SummaryWidth, _Margin), 2004 test_name_summary(Unit:Test, SummaryWidth, NameS), 2005 progress_string(Progress, ProgressS) 2006 }, 2007 ( { tty_feedback, 2008 tty_clear_to_eol(CE) 2009 } 2010 -> [ at_same_line, '\r[~w] ~w ..~w'-[ProgressS, NameS, 2011 CE], flush ] 2012 ; { jobs(_) } 2013 -> [ '[~w] ~w ..'-[ProgressS, NameS] ] 2014 ; [ '[~w] ~w ..'-[ProgressS, NameS], flush ] 2015 ). 2016message(plunit(end(_UnitTest, _Location, _Progress))) --> 2017 []. 2018message(plunit(progress(_UnitTest, Status, _Progress, _Time))) --> 2019 { Status = forall(_,_) 2020 ; Status == assertion 2021 }, 2022 !. 2023message(plunit(progress(Unit:Test, Status, Progress, Time))) --> 2024 { jobs(_), 2025 !, 2026 tty_columns(SummaryWidth, Margin), 2027 test_name_summary(Unit:Test, SummaryWidth, NameS), 2028 progress_string(Progress, ProgressS), 2029 progress_tag(Status, Tag, _Keep, Style) 2030 }, 2031 [ ansi(Style, '[~w] ~w ~`.t ~w (~3f sec)~*|', 2032 [ProgressS, NameS, Tag, Time.wall, Margin]) ]. 2033message(plunit(progress(_UnitTest, Status, _Progress, Time))) --> 2034 { tty_columns(_SummaryWidth, Margin), 2035 progress_tag(Status, Tag, _Keep, Style) 2036 }, 2037 [ at_same_line, ansi(Style, '~`.t ~w (~3f sec)~*|', 2038 [Tag, Time.wall, Margin]) ], 2039 ( { tty_feedback } 2040 -> [flush] 2041 ; [] 2042 ). 2043message(plunit(failed(Unit:Test, Progress, Line, Failure, _Time, Output))) --> 2044 { unit_file(Unit, File) }, 2045 locationprefix(File:Line), 2046 test_name(Unit:Test, Progress), 2047 [': '-[] ], 2048 failure(Failure), 2049 test_output(Output). 2050message(plunit(timeout(Unit:Test, Progress, Line, Limit, Output))) --> 2051 { unit_file(Unit, File) }, 2052 locationprefix(File:Line), 2053 test_name(Unit:Test, Progress), 2054 [': '-[] ], 2055 timeout(Limit), 2056 test_output(Output). 2057:- if(swi). 2058message(plunit(failed_assertion(Unit:Test, Line, AssertLoc, 2059 Progress, Reason, Goal))) --> 2060 { unit_file(Unit, File) }, 2061 locationprefix(File:Line), 2062 test_name(Unit:Test, Progress), 2063 [ ': assertion'-[] ], 2064 assertion_location(AssertLoc, File), 2065 assertion_reason(Reason), ['\n\t'], 2066 assertion_goal(Unit, Goal). 2067 2068assertion_location(File:Line, File) --> 2069 [ ' at line ~w'-[Line] ]. 2070assertion_location(File:Line, _) --> 2071 [ ' at ', url(File:Line) ]. 2072assertion_location(unknown, _) --> 2073 []. 2074 2075assertion_reason(fail) --> 2076 !, 2077 [ ' failed'-[] ]. 2078assertion_reason(Error) --> 2079 { message_to_string(Error, String) }, 2080 [ ' raised "~w"'-[String] ]. 2081 2082assertion_goal(Unit, Goal) --> 2083 { unit_module(Unit, Module), 2084 unqualify(Goal, Module, Plain) 2085 }, 2086 [ 'Assertion: ~p'-[Plain] ]. 2087 2088unqualify(Var, _, Var) :- 2089 var(Var), 2090 !. 2091unqualify(M:Goal, Unit, Goal) :- 2092 nonvar(M), 2093 unit_module(Unit, M), 2094 !. 2095unqualify(M:Goal, _, Goal) :- 2096 callable(Goal), 2097 predicate_property(M:Goal, imported_from(system)), 2098 !. 2099unqualify(Goal, _, Goal). 2100 2101test_output(Msgs-String) --> 2102 { nonvar(Msgs) }, 2103 !, 2104 test_output(String). 2105test_output("") --> []. 2106test_output(Output) --> 2107 [ ansi(code, '~N~s', [Output]) ]. 2108 2109:- endif. 2110 % Setup/condition errors 2111message(plunit(error(Where, Context, _Output, throw(Exception)))) --> 2112 locationprefix(Context), 2113 { message_to_string(Exception, String) }, 2114 [ 'error in ~w: ~w'-[Where, String] ]. 2115message(plunit(error(Where, Context, _Output, false))) --> 2116 locationprefix(Context), 2117 [ 'setup failed in ~w'-[Where] ]. 2118 2119 % delayed output 2120message(plunit(test_output(_, Output))) --> 2121 [ '~s'-[Output] ]. 2122 % Interrupts (SWI) 2123:- if(swi). 2124message(interrupt(begin)) --> 2125 { thread_self(Me), 2126 running(Unit, Test, Line, Progress, Me), 2127 !, 2128 unit_file(Unit, File), 2129 restore_output_state 2130 }, 2131 [ 'Interrupted test '-[] ], 2132 running(running(Unit:Test, File:Line, Progress, Me)), 2133 [nl], 2134 '$messages':prolog_message(interrupt(begin)). 2135message(interrupt(begin)) --> 2136 '$messages':prolog_message(interrupt(begin)). 2137:- endif. 2138 2139message(concurrent) --> 2140 [ 'concurrent(true) at the level of units is currently ignored.', nl, 2141 'See set_test_options/1 with jobs(Count) for concurrent testing.' 2142 ]. 2143 2144test_name(Name, forall(Bindings, _Nth-I)) --> 2145 !, 2146 test_name(Name, -), 2147 [ ' (~d-th forall bindings = '-[I], 2148 ansi(code, '~p', [Bindings]), ')'-[] 2149 ]. 2150test_name(Name, _) --> 2151 !, 2152 [ 'test ', ansi(code, '~q', [Name]) ]. 2153 2154running(running(Unit:Test, File:Line, _Progress, Thread)) --> 2155 thread(Thread), 2156 [ '~q:~q at '-[Unit, Test], url(File:Line) ]. 2157running([H|T]) --> 2158 ['\t'], running(H), 2159 ( {T == []} 2160 -> [] 2161 ; [nl], running(T) 2162 ). 2163 2164thread(main) --> !. 2165thread(Other) --> 2166 [' [~w] '-[Other] ]. 2167 2168:- if(swi). 2169write_term(T, OPS) --> 2170 ['~W'-[T,OPS] ]. 2171:- else. 2172write_term(T, _OPS) --> 2173 ['~q'-[T]]. 2174:- endif. 2175 2176expected_got_ops_(Ex, E, OPS, Goals) --> 2177 [' Expected: '-[]], write_term(Ex, OPS), [nl], 2178 [' Got: '-[]], write_term(E, OPS), [], 2179 ( { Goals = [] } -> [] 2180 ; [nl, ' with: '-[]], write_term(Goals, OPS), [] 2181 ). 2182 2183 2184failure(List) --> 2185 { is_list(List) }, 2186 !, 2187 [ nl ], 2188 failures(List). 2189failure(Var) --> 2190 { var(Var) }, 2191 !, 2192 [ 'Unknown failure?' ]. 2193failure(succeeded(Time)) --> 2194 !, 2195 [ 'must fail but succeeded in ~2f seconds~n'-[Time] ]. 2196failure(wrong_error(Expected, Error)) --> 2197 !, 2198 { copy_term(Expected-Error, Ex-E, Goals), 2199 numbervars(Ex-E-Goals, 0, _), 2200 write_options(OPS) 2201 }, 2202 [ 'wrong error'-[], nl ], 2203 expected_got_ops_(Ex, E, OPS, Goals). 2204failure(wrong_answer(cmp(Var, Cmp))) --> 2205 { Cmp =.. [Op,Answer,Expected], 2206 !, 2207 copy_term(Expected-Answer, Ex-A, Goals), 2208 numbervars(Ex-A-Goals, 0, _), 2209 write_options(OPS) 2210 }, 2211 [ 'wrong answer for ', ansi(code, '~w', [Var]), 2212 ' (compared using ~w)'-[Op], nl ], 2213 expected_got_ops_(Ex, A, OPS, Goals). 2214failure(wrong_answer(Cmp)) --> 2215 { Cmp =.. [Op,Answer,Expected], 2216 !, 2217 copy_term(Expected-Answer, Ex-A, Goals), 2218 numbervars(Ex-A-Goals, 0, _), 2219 write_options(OPS) 2220 }, 2221 [ 'wrong answer (compared using ~w)'-[Op], nl ], 2222 expected_got_ops_(Ex, A, OPS, Goals). 2223failure(wrong_answer(CmpExpected, Bindings)) --> 2224 { ( CmpExpected = all(Cmp) 2225 -> Cmp =.. [_Op1,_,Expected], 2226 Got = Bindings, 2227 Type = all 2228 ; CmpExpected = set(Cmp), 2229 Cmp =.. [_Op2,_,Expected0], 2230 sort(Expected0, Expected), 2231 sort(Bindings, Got), 2232 Type = set 2233 ) 2234 }, 2235 [ 'wrong "~w" answer:'-[Type] ], 2236 [ nl, ' Expected: ~q'-[Expected] ], 2237 [ nl, ' Found: ~q'-[Got] ]. 2238:- if(swi). 2239failure(cmp_error(_Cmp, Error)) --> 2240 { message_to_string(Error, Message) }, 2241 [ 'Comparison error: ~w'-[Message] ]. 2242failure(throw(Error)) --> 2243 { Error = error(_,_), 2244 !, 2245 message_to_string(Error, Message) 2246 }, 2247 [ 'received error: ~w'-[Message] ]. 2248:- endif. 2249failure(message) --> 2250 !, 2251 [ 'Generated unexpected warning or error'-[] ]. 2252failure(setup_failed(throw(Error))) --> 2253 { Error = error(_,_), 2254 !, 2255 message_to_string(Error, Message) 2256 }, 2257 [ 'test setup goal raised error: ~w'-[Message] ]. 2258failure(setup_failed(_)) --> 2259 !, 2260 [ 'test setup goal failed' ]. 2261failure(Why) --> 2262 [ '~p'-[Why] ]. 2263 2264failures([]) --> 2265 !. 2266failures([H|T]) --> 2267 !, 2268 failure(H), [nl], 2269 failures(T). 2270 2271timeout(Limit) --> 2272 [ 'Timeout exceeeded (~2f sec)'-[Limit] ]. 2273 2274fixme_message([]) --> []. 2275fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) --> 2276 { unit_file(Unit, File) }, 2277 fixme_message(File:Line, Reason, How), 2278 ( {T == []} 2279 -> [] 2280 ; [nl], 2281 fixme_message(T) 2282 ). 2283 2284fixme_message(Location, Reason, failed) --> 2285 [ 'FIXME: ~w: ~w'-[Location, Reason] ]. 2286fixme_message(Location, Reason, passed) --> 2287 [ 'FIXME: ~w: passed ~w'-[Location, Reason] ]. 2288fixme_message(Location, Reason, nondet) --> 2289 [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ]. 2290 2291 2292write_options([ numbervars(true), 2293 quoted(true), 2294 portray(true), 2295 max_depth(100), 2296 attributes(portray) 2297 ]).
2304test_name_summary(Term, MaxLen, Summary) :- 2305 summary_string(Term, Text), 2306 atom_length(Text, Len), 2307 ( Len =< MaxLen 2308 -> Summary = Text 2309 ; End is MaxLen//2, 2310 Pre is MaxLen - End - 2, 2311 sub_string(Text, 0, Pre, _, PreText), 2312 sub_string(Text, _, End, 0, PostText), 2313 format(string(Summary), '~w..~w', [PreText,PostText]) 2314 ). 2315 2316summary_string(Unit:Test, String) => 2317 summary_string(Test, String1), 2318 atomics_to_string([Unit, String1], :, String). 2319summary_string(@(Name,Vars), String) => 2320 format(string(String), '~W (using ~W)', 2321 [ Name, [numbervars(true), quoted(false)], 2322 Vars, [numbervars(true), portray(true), quoted(true)] 2323 ]). 2324summary_string(Name, String) => 2325 term_string(Name, String, [numbervars(true), quoted(false)]).
2331progress_string(forall(_Vars, N-I)/Total, S) => 2332 format(string(S), '~w-~w/~w', [N,I,Total]). 2333progress_string(Progress, S) => 2334 term_string(Progress, S).
2342progress_tag(passed, Tag, Keep, Style) => 2343 Tag = passed, Keep = false, Style = comment. 2344progress_tag(fixme(passed), Tag, Keep, Style) => 2345 Tag = passed, Keep = false, Style = comment. 2346progress_tag(fixme(_), Tag, Keep, Style) => 2347 Tag = fixme, Keep = true, Style = warning. 2348progress_tag(nondet, Tag, Keep, Style) => 2349 Tag = '**NONDET', Keep = true, Style = warning. 2350progress_tag(timeout(_Limit), Tag, Keep, Style) => 2351 Tag = '**TIMEOUT', Keep = true, Style = warning. 2352progress_tag(assertion, Tag, Keep, Style) => 2353 Tag = '**FAILED', Keep = true, Style = error. 2354progress_tag(failed, Tag, Keep, Style) => 2355 Tag = '**FAILED', Keep = true, Style = error. 2356progress_tag(forall(_,0), Tag, Keep, Style) => 2357 Tag = passed, Keep = false, Style = comment. 2358progress_tag(forall(_,_), Tag, Keep, Style) => 2359 Tag = '**FAILED', Keep = true, Style = error. 2360 2361 2362 /******************************* 2363 * OUTPUT * 2364 *******************************/ 2365 2366save_output_state :- 2367 stream_property(Output, alias(user_output)), 2368 stream_property(Error, alias(user_error)), 2369 asserta(output_streams(Output, Error)). 2370 2371restore_output_state :- 2372 output_streams(Output, Error), 2373 !, 2374 set_stream(Output, alias(user_output)), 2375 set_stream(Error, alias(user_error)). 2376restore_output_state. 2377 2378 2379 2380 /******************************* 2381 * CONCURRENT STATUS * 2382 *******************************/ 2383 2384/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2385This part deals with interactive feedback when we are running multiple 2386threads. The terminal window cannot work on top of the Prolog message 2387infrastructure and (thus) we have to use more low-level means. 2388- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2389 2390:- dynamic 2391 jobs/1, % Count 2392 job_window/1, % Count 2393 job_status_line/3. % Job, Format, Args 2394 2395job_feedback(_, jobs(Jobs)) :- 2396 retractall(jobs(_)), 2397 Jobs > 1, 2398 asserta(jobs(Jobs)), 2399 tty_feedback, 2400 !, 2401 retractall(job_window(_)), 2402 asserta(job_window(Jobs)), 2403 retractall(job_status_line(_,_,_)), 2404 jobs_redraw. 2405job_feedback(_, jobs(Jobs)) :- 2406 !, 2407 retractall(job_window(_)), 2408 info(plunit(jobs(Jobs))). 2409job_feedback(_, Msg) :- 2410 job_window(_), 2411 !, 2412 with_mutex(plunit_feedback, job_feedback(Msg)). 2413job_feedback(Level, Msg) :- 2414 print_message(Level, plunit(Msg)). 2415 2416job_feedback(begin(Unit:Test, _Location, Progress)) => 2417 tty_columns(SummaryWidth, _Margin), 2418 test_name_summary(Unit:Test, SummaryWidth, NameS), 2419 progress_string(Progress, ProgressS), 2420 tty_clear_to_eol(CE), 2421 job_format(comment, '\r[~w] ~w ..~w', 2422 [ProgressS, NameS, CE]), 2423 flush_output. 2424job_feedback(end(_UnitTest, _Location, _Progress)) => 2425 true. 2426job_feedback(progress(_UnitTest, Status, _Progress, Time)) => 2427 ( hide_progress(Status) 2428 -> true 2429 ; tty_columns(_SummaryWidth, Margin), 2430 progress_tag(Status, Tag, _Keep, Style), 2431 job_finish(Style, '~`.t ~w (~3f sec)~*|', 2432 [Tag, Time.wall, Margin]) 2433 ). 2434job_feedback(failed(UnitTest, Progress, Line, Error, Time, Output)) => 2435 tty_columns(_SummaryWidth, Margin), 2436 progress_tag(failed, Tag, _Keep, Style), 2437 job_finish(Style, '~`.t ~w (~3f sec)~*|', 2438 [Tag, Time.wall, Margin]), 2439 print_test_output(Error, Output), 2440 ( ( Error = timeout(_) % Status line suffices 2441 ; Error == assertion % We will get an failed test later 2442 ) 2443 -> true 2444 ; print_message(Style, plunit(failed(UnitTest, Progress, Line, 2445 Error, Time, ""))) 2446 ), 2447 jobs_redraw. 2448job_feedback(begin(_Unit)) => true. 2449job_feedback(end(_Unit, _Summary)) => true. 2450 2451hide_progress(assertion). 2452hide_progress(forall(_,_)). 2453hide_progress(failed). 2454hide_progress(timeout(_)). 2455 2456print_test_output(Error, _Msgs-Output) => 2457 print_test_output(Error, Output). 2458print_test_output(_, "") => true. 2459print_test_output(assertion, Output) => 2460 print_message(debug, plunit(test_output(error, Output))). 2461print_test_output(message, Output) => 2462 print_message(debug, plunit(test_output(error, Output))). 2463print_test_output(_, Output) => 2464 print_message(debug, plunit(test_output(informational, Output))).
2470jobs_redraw :- 2471 job_window(N), 2472 !, 2473 tty_columns(_, Width), 2474 tty_header_line(Width), 2475 forall(between(1,N,Line), job_redraw_worker(Line)), 2476 tty_header_line(Width). 2477jobs_redraw. 2478 2479job_redraw_worker(Line) :- 2480 ( job_status_line(Line, Fmt, Args) 2481 -> ansi_format(comment, Fmt, Args) 2482 ; true 2483 ), 2484 nl.
2492job_format(Style, Fmt, Args) :-
2493 job_self(Job),
2494 job_format(Job, Style, Fmt, Args, true).
2502job_finish(Style, Fmt, Args) :- 2503 job_self(Job), 2504 job_finish(Job, Style, Fmt, Args). 2505 2506:- det(job_finish/4). 2507job_finish(Job, Style, Fmt, Args) :- 2508 retract(job_status_line(Job, Fmt0, Args0)), 2509 !, 2510 string_concat(Fmt0, Fmt, Fmt1), 2511 append(Args0, Args, Args1), 2512 job_format(Job, Style, Fmt1, Args1, false). 2513 2514:- det(job_format/5). 2515job_format(Job, Style, Fmt, Args, Save) :- 2516 job_window(Jobs), 2517 Up is Jobs+2-Job, 2518 flush_output(user_output), 2519 tty_up_and_clear(Up), 2520 ansi_format(Style, Fmt, Args), 2521 ( Save == true 2522 -> retractall(job_status_line(Job, _, _)), 2523 asserta(job_status_line(Job, Fmt, Args)) 2524 ; true 2525 ), 2526 tty_down_and_home(Up), 2527 flush_output(user_output). 2528 2529:- det(job_self/1). 2530job_self(Job) :- 2531 job_window(N), 2532 N > 1, 2533 thread_self(Me), 2534 split_string(Me, '_', '', [_,_,S]), 2535 number_string(Job, S).
tty
format, which reuses the current
output line if the test is successful.2542tty_feedback :- 2543 has_tty, 2544 current_test_flag(format, tty). 2545 2546has_tty :- 2547 stream_property(user_output, tty(true)). 2548 2549tty_columns(SummaryWidth, Margin) :- 2550 tty_width(W), 2551 Margin is W-8, 2552 SummaryWidth is max(20,Margin-34). 2553 2554tty_width(W) :- 2555 current_predicate(tty_size/2), 2556 catch(tty_size(_Rows, Cols), error(_,_), fail), 2557 Cols > 25, 2558 !, 2559 W = Cols. 2560tty_width(80). 2561 2562tty_header_line(Width) :- 2563 ansi_format(comment, '~N~`\u2015t~*|~n', [Width]). 2564 2565:- if(current_predicate(tty_get_capability/3)). 2566tty_clear_to_eol(S) :- 2567 getenv('TERM', _), 2568 catch(tty_get_capability(ce, string, S), 2569 error(_,_), 2570 fail), 2571 !. 2572:- endif. 2573tty_clear_to_eol('\e[K'). 2574 2575tty_up_and_clear(Lines) :- 2576 format(user_output, '\e[~dA\r\e[K', [Lines]). 2577 2578tty_down_and_home(Lines) :- 2579 format(user_output, '\e[~dB\r', [Lines]). 2580 2581:- if(swi). 2582 2583:- multifile 2584 prolog:message/3, 2585 user:message_hook/3. 2586 2587prologmessage(Term) --> 2588 message(Term). 2589 2590% user:message_hook(+Term, +Kind, +Lines) 2591 2592user:message_hook(make(done(Files)), _, _) :- 2593 make_run_tests(Files), 2594 fail. % give other hooks a chance 2595 2596:- endif. 2597 2598:- if(sicstus). 2599 2600usergenerate_message_hook(Message) --> 2601 message(Message), 2602 [nl]. % SICStus requires nl at the end
2611user:message_hook(informational, plunit(begin(Unit)), _Lines) :- 2612 format(user_error, '% PL-Unit: ~w ', [Unit]), 2613 flush_output(user_error). 2614user:message_hook(informational, plunit(end(_Unit)), _Lines) :- 2615 format(user, ' done~n', []). 2616 2617:- endif.
Unit Testing
Unit testing environment for SWI-Prolog and SICStus Prolog. For usage, please visit https://www.swi-prolog.org/pldoc/package/plunit. */