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_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 failure(Unit, Name, Progress, Line, How, Time, Output, Options). 1100report_result(success(Unit, Name, Line, Determinism, Time), 1101 Progress, Output, Options) => 1102 success(Unit, Name, Progress, Line, Determinism, Time, Output, Options). 1103report_result(setup_failed(Unit, Name, Line, Time, Output, Result), 1104 Progress, _Output, Options) => 1105 failure(Unit, Name, Progress, Line, 1106 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)
1128run_test_6(Unit, Name, Line, Options, Body, Result) :- 1129 option(setup(Setup), Options), 1130 !, 1131 unit_module(Unit, Module), 1132 capture_output(call_time(reify(call_ex(Module, Setup), SetupResult), 1133 Time), 1134 Output), 1135 ( SetupResult == true 1136 -> run_test_7(Unit, Name, Line, Options, Body, Result), 1137 cleanup(Module, Options) 1138 ; Result = setup_failed(Unit, Name, Line, Time, Output, SetupResult) 1139 ). 1140run_test_6(Unit, Name, Line, Options, Body, Result) :- 1141 unit_module(Unit, Module), 1142 run_test_7(Unit, Name, Line, Options, Body, Result), 1143 cleanup(Module, Options).
1152run_test_7(Unit, Name, Line, Options, Body, Result) :- 1153 option(true(Cmp), Options), % expected success 1154 !, 1155 unit_module(Unit, Module), 1156 call_time(reify_tmo(call_det(Module:Body, Det), Result0, Options), Time), 1157 ( Result0 == true 1158 -> cmp_true(Cmp, Module, CmpResult), 1159 ( CmpResult == [] 1160 -> Result = success(Unit, Name, Line, Det, Time) 1161 ; Result = failure(Unit, Name, Line, CmpResult, Time) 1162 ) 1163 ; Result0 == false 1164 -> Result = failure(Unit, Name, Line, failed, Time) 1165 ; Result0 = throw(E2) 1166 -> Result = failure(Unit, Name, Line, throw(E2), Time) 1167 ). 1168run_test_7(Unit, Name, Line, Options, Body, Result) :- 1169 option(fail, Options), % expected failure 1170 !, 1171 unit_module(Unit, Module), 1172 call_time(reify_tmo(Module:Body, Result0, Options), Time), 1173 ( Result0 == true 1174 -> Result = failure(Unit, Name, Line, succeeded, Time) 1175 ; Result0 == false 1176 -> Result = success(Unit, Name, Line, true, Time) 1177 ; Result0 = throw(E) 1178 -> Result = failure(Unit, Name, Line, throw(E), Time) 1179 ). 1180run_test_7(Unit, Name, Line, Options, Body, Result) :- 1181 option(throws(Expect), Options), % Expected error 1182 !, 1183 unit_module(Unit, Module), 1184 call_time(reify_tmo(Module:Body, Result0, Options), Time), 1185 ( Result0 == true 1186 -> Result = failure(Unit, Name, Line, no_exception, Time) 1187 ; Result0 == false 1188 -> Result = failure(Unit, Name, Line, failed, Time) 1189 ; Result0 = throw(E) 1190 -> ( match_error(Expect, E) 1191 -> Result = success(Unit, Name, Line, true, Time) 1192 ; Result = failure(Unit, Name, Line, wrong_error(Expect, E), Time) 1193 ) 1194 ). 1195run_test_7(Unit, Name, Line, Options, Body, Result) :- 1196 option(all(Answer), Options), % all(Bindings) 1197 !, 1198 nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result). 1199run_test_7(Unit, Name, Line, Options, Body, Result) :- 1200 option(set(Answer), Options), % set(Bindings) 1201 !, 1202 nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
1208nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :- 1209 unit_module(Unit, Module), 1210 result_vars(Expected, Vars), 1211 ( call_time(reify_tmo(findall(Vars, Module:Body, Bindings), 1212 Result0, Options), Time) 1213 -> ( Result0 == true 1214 -> ( nondet_compare(Expected, Bindings, Unit, Name, Line) 1215 -> Result = success(Unit, Name, Line, true, Time) 1216 ; Result = failure(Unit, Name, Line, 1217 [wrong_answer(Expected, Bindings)], Time) 1218 ) 1219 ; Result0 = throw(E) 1220 -> Result = failure(Unit, Name, Line, throw(E), Time) 1221 ) 1222 ). 1223 1224cmp_true([], _, L) => 1225 L = []. 1226cmp_true([Cmp|T], Module, L) => 1227 E = error(Formal,_), 1228 cmp_goal(Cmp, Goal), 1229 ( catch(Module:Goal, E, true) 1230 -> ( var(Formal) 1231 -> cmp_true(T, Module, L) 1232 ; L = [cmp_error(Cmp,E)|L1], 1233 cmp_true(T, Module, L1) 1234 ) 1235 ; L = [wrong_answer(Cmp)|L1], 1236 cmp_true(T, Module, L1) 1237 ). 1238 1239cmp_goal(cmp(_Var, Expr), Goal) => Goal = Expr. 1240cmp_goal(Expr, Goal) => Goal = Expr.
v(V1, ...)
containing all variables at the left
side of the comparison operator on Expected.
1248result_vars(Expected, Vars) :-
1249 arg(1, Expected, CmpOp),
1250 arg(1, CmpOp, Vars).
1260nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :- 1261 cmp(Cmp, _Vars, Op, Values), 1262 cmp_list(Values, Bindings, Op). 1263nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :- 1264 cmp(Cmp, _Vars, Op, Values0), 1265 sort(Bindings0, Bindings), 1266 sort(Values0, Values), 1267 cmp_list(Values, Bindings, Op). 1268 1269cmp_list([], [], _Op). 1270cmp_list([E0|ET], [V0|VT], Op) :- 1271 call(Op, E0, V0), 1272 cmp_list(ET, VT, Op).
1276cmp(Var == Value, Var, ==, Value). 1277cmp(Var =:= Value, Var, =:=, Value). 1278cmp(Var = Value, Var, =, Value). 1279:- if(swi). 1280cmp(Var =@= Value, Var, =@=, Value). 1281:- else. 1282:- if(sicstus). 1283cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@= 1284:- endif. 1285:- endif.
true
if Goal left
no choicepoints and false
otherwise.1293:- if((swi;sicstus)). 1294call_det(Goal, Det) :- 1295 call_cleanup(Goal,Det0=true), 1296 ( var(Det0) -> Det = false ; Det = true ). 1297:- else. 1298call_det(Goal, true) :- 1299 call(Goal). 1300:- endif.
1307match_error(Expect, Rec) :-
1308 subsumes_term(Expect, Rec).
1321setup(Module, Context, Options) :- 1322 option(setup(Setup), Options), 1323 !, 1324 capture_output(reify(call_ex(Module, Setup), Result), Output), 1325 ( Result == true 1326 -> true 1327 ; print_message(error, 1328 plunit(error(setup, Context, Output, Result))), 1329 fail 1330 ). 1331setup(_,_,_).
1337condition(Module, Context, Options) :- 1338 option(condition(Cond), Options), 1339 !, 1340 capture_output(reify(call_ex(Module, Cond), Result), Output), 1341 ( Result == true 1342 -> true 1343 ; Result == false 1344 -> fail 1345 ; print_message(error, 1346 plunit(error(condition, Context, Output, Result))), 1347 fail 1348 ). 1349condition(_, _, _).
1356call_ex(Module, Goal) :-
1357 Module:(expand_goal(Goal, GoalEx),
1358 GoalEx).
1365cleanup(Module, Options) :- 1366 option(cleanup(Cleanup), Options, true), 1367 ( catch(call_ex(Module, Cleanup), E, true) 1368 -> ( var(E) 1369 -> true 1370 ; print_message(warning, E) 1371 ) 1372 ; print_message(warning, goal_failed(Cleanup, '(cleanup handler)')) 1373 ). 1374 1375success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :- 1376 memberchk(fixme(Reason), Options), 1377 !, 1378 ( ( Det == true 1379 ; memberchk(nondet, Options) 1380 ) 1381 -> progress(Unit:Name, Progress, fixme(passed), Time), 1382 Ok = passed 1383 ; progress(Unit:Name, Progress, fixme(nondet), Time), 1384 Ok = nondet 1385 ), 1386 flush_output(user_error), 1387 assert(fixme(Unit, Name, Line, Reason, Ok)). 1388success(Unit, Name, Progress, Line, _, Time, Output, Options) :- 1389 failed_assertion(Unit, Name, Line, _,Progress,_,_), 1390 !, 1391 failure(Unit, Name, Progress, Line, assertion, Time, Output, Options). 1392success(Unit, Name, Progress, Line, _, Time, Output, Options) :- 1393 Output = true-_, 1394 !, 1395 failure(Unit, Name, Progress, Line, message, Time, Output, Options). 1396success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :- 1397 assert(passed(Unit, Name, Line, Det, Time)), 1398 ( ( Det == true 1399 ; memberchk(nondet, Options) 1400 ) 1401 -> progress(Unit:Name, Progress, passed, Time) 1402 ; unit_file(Unit, File), 1403 print_message(warning, plunit(nondet(File, Line, Name))) 1404 ).
1411failure(Unit, Name, Progress, Line, _, Time, _Output, Options), 1412 memberchk(fixme(Reason), Options) => 1413 assert(fixme(Unit, Name, Line, Reason, failed)), 1414 progress(Unit:Name, Progress, fixme(failed), Time). 1415failure(Unit, Name, Progress, Line, time_limit_exceeded(Limit), Time, 1416 Output, Options) => 1417 assert_cyclic(timeout(Unit, Name, Line, Limit, Time)), 1418 progress(Unit:Name, Progress, timeout(Limit), Time), 1419 report_failure(Unit, Name, Progress, Line, timeout(Limit), Time, Output, Options). 1420failure(Unit, Name, Progress, Line, E, Time, Output, Options) => 1421 assert_cyclic(failed(Unit, Name, Line, E, Time)), 1422 progress(Unit:Name, Progress, failed, Time), 1423 report_failure(Unit, Name, Progress, Line, E, Time, Output, Options).
1433:- if(swi). 1434assert_cyclic(Term) :- 1435 acyclic_term(Term), 1436 !, 1437 assert(Term). 1438assert_cyclic(Term) :- 1439 Term =.. [Functor|Args], 1440 recorda(cyclic, Args, Id), 1441 functor(Term, _, Arity), 1442 length(NewArgs, Arity), 1443 Head =.. [Functor|NewArgs], 1444 assert(( :- recorded(_, Var, Id), Var = NewArgs)). 1445:- else. 1446:- if(sicstus). 1447:- endif. 1448assert_cyclic(Term) :- 1449 assert(Term). 1450:- endif. 1451 1452 1453 /******************************* 1454 * JOBS * 1455 *******************************/ 1456 1457:- if(current_prolog_flag(threads, true)). 1458 1459:- dynamic 1460 job_data/2, % Queue, Threads 1461 scheduled_unit/1. 1462 1463schedule_unit(_:[]) :- 1464 !. 1465schedule_unit(UnitAndTests) :- 1466 UnitAndTests = Unit:_Tests, 1467 job_data(Queue, _), 1468 !, 1469 assertz(scheduled_unit(Unit)), 1470 thread_send_message(Queue, unit(UnitAndTests)). 1471schedule_unit(Unit) :- 1472 run_unit(Unit).
1478setup_jobs(Count) :- 1479 ( current_test_flag(jobs, Jobs0), 1480 integer(Jobs0) 1481 -> true 1482 ; current_prolog_flag(cpu_count, Jobs0) 1483 ), 1484 Jobs is min(Count, Jobs0), 1485 Jobs > 1, 1486 !, 1487 message_queue_create(Q, [alias(plunit_jobs)]), 1488 length(TIDs, Jobs), 1489 foldl(create_plunit_job(Q), TIDs, 1, _), 1490 asserta(job_data(Q, TIDs)), 1491 job_feedback(informational, jobs(Jobs)). 1492setup_jobs(_) :- 1493 job_feedback(informational, jobs(1)). 1494 1495create_plunit_job(Q, TID, N, N1) :- 1496 N1 is N + 1, 1497 atom_concat(plunit_job_, N, Alias), 1498 thread_create(plunit_job(Q), TID, [alias(Alias)]). 1499 1500plunit_job(Queue) :- 1501 repeat, 1502 ( catch(thread_get_message(Queue, Job, 1503 [ timeout(10) 1504 ]), 1505 error(_,_), fail) 1506 -> job(Job), 1507 fail 1508 ; ! 1509 ). 1510 1511job(unit(Unit:Tests)) => 1512 run_unit(Unit:Tests). 1513job(test(Unit, Test)) => 1514 run_test(Unit, Test). 1515 1516cleanup_jobs :- 1517 retract(job_data(Queue, TIDSs)), 1518 !, 1519 message_queue_destroy(Queue), 1520 maplist(thread_join, TIDSs). 1521cleanup_jobs.
1527job_wait(Unit) :- 1528 thread_wait(\+ scheduled_unit(Unit), 1529 [ wait_preds([scheduled_unit/1]), 1530 timeout(1) 1531 ]), 1532 !. 1533job_wait(Unit) :- 1534 job_data(_Queue, TIDs), 1535 member(TID, TIDs), 1536 thread_property(TID, status(running)), 1537 !, 1538 job_wait(Unit). 1539job_wait(_). 1540 1541 1542job_info(begin(unit(Unit))) => 1543 print_message(silent, plunit(begin(Unit))). 1544job_info(end(unit(Unit, Summary))) => 1545 retractall(scheduled_unit(Unit)), 1546 print_message(silent, plunit(end(Unit, Summary))). 1547 1548:- else. % No jobs 1549 1550schedule_unit(Unit) :- 1551 run_unit(Unit). 1552 1553setup_jobs(_) :- 1554 print_message(silent, plunit(jobs(1))). 1555cleanup_jobs. 1556job_wait(_). 1557job_info(_). 1558 1559:- endif. 1560 1561 1562 1563 /******************************* 1564 * REPORTING * 1565 *******************************/
silent
message:
plunit(begin(Unit:Test, File:Line, Progress))
plunit(end(Unit:Test, File:Line, Progress))
1578begin_test(Unit, Test, Line, Progress) :- 1579 thread_self(Me), 1580 assert(running(Unit, Test, Line, Progress, Me)), 1581 unit_file(Unit, File), 1582 test_count(Total), 1583 job_feedback(information, begin(Unit:Test, File:Line, Progress/Total)). 1584 1585end_test(Unit, Test, Line, Progress) :- 1586 thread_self(Me), 1587 retractall(running(_,_,_,_,Me)), 1588 unit_file(Unit, File), 1589 test_count(Total), 1590 job_feedback(information, end(Unit:Test, File:Line, Progress/Total)).
1596running_tests :- 1597 running_tests(Running), 1598 print_message(informational, plunit(running(Running))). 1599 1600running_tests(Running) :- 1601 test_count(Total), 1602 findall(running(Unit:Test, File:Line, Progress/Total, Thread), 1603 ( running(Unit, Test, Line, Progress, Thread), 1604 unit_file(Unit, File) 1605 ), Running).
1612current_test(Unit, Test, Line, Body, Options) :-
1613 current_unit(Unit, Module, _Supers, _UnitOptions),
1614 Module:'unit test'(Test, Line, Options, Body).
1620current_test_unit(Unit, UnitOptions) :- 1621 current_unit(Unit, _Module, _Supers, UnitOptions). 1622 1623 1624count(Goal, Count) :- 1625 aggregate_all(count, Goal, Count).
1632test_summary(Unit, Summary) :- 1633 count(failed(Unit, _0Test, _0Line, _Reason, _0Time), Failed), 1634 count(timeout(Unit, _0Test, _0Line, _Limit, _0Time), Timeout), 1635 count(passed(Unit, _0Test, _0Line, _Det, _0Time), Passed), 1636 count(blocked(Unit, _0Test, _0Line, _0Reason), Blocked), 1637 count(fixme(Unit, _0Test, _0Line, _0Reason, _0How), Fixme), 1638 test_count(Total), 1639 Summary = plunit{total:Total, 1640 passed:Passed, 1641 failed:Failed, 1642 timeout:Timeout, 1643 blocked:Blocked, 1644 fixme:Fixme}. 1645 1646test_summary_passed(Summary) :- 1647 _{failed: 0} :< Summary.
1653report(Time, _Options) :- 1654 test_summary(_, Summary), 1655 print_message(silent, plunit(Summary)), 1656 _{ passed:Passed, 1657 failed:Failed, 1658 timeout:Timeout, 1659 blocked:Blocked, 1660 fixme:Fixme 1661 } :< Summary, 1662 ( Passed+Failed+Timeout+Blocked+Fixme =:= 0 1663 -> info(plunit(no_tests)) 1664 ; Failed+Timeout =:= 0 1665 -> report_blocked(Blocked), 1666 report_fixme, 1667 test_count(Total), 1668 info(plunit(all_passed(Total, Passed, Time))) 1669 ; report_blocked(Blocked), 1670 report_fixme, 1671 report_failed(Failed), 1672 report_timeout(Timeout), 1673 info(plunit(passed(Passed))), 1674 info(plunit(total_time(Time))) 1675 ). 1676 1677report_blocked(0) => 1678 true. 1679report_blocked(Blocked) => 1680 findall(blocked(Unit:Name, File:Line, Reason), 1681 ( blocked(Unit, Name, Line, Reason), 1682 unit_file(Unit, File) 1683 ), 1684 BlockedTests), 1685 info(plunit(blocked(Blocked, BlockedTests))). 1686 1687report_failed(Failed) :- 1688 print_message(error, plunit(failed(Failed))). 1689 1690report_timeout(Count) :- 1691 print_message(warning, plunit(timeout(Count))). 1692 1693report_fixme :- 1694 report_fixme(_,_,_). 1695 1696report_fixme(TuplesF, TuplesP, TuplesN) :- 1697 fixme(failed, TuplesF, Failed), 1698 fixme(passed, TuplesP, Passed), 1699 fixme(nondet, TuplesN, Nondet), 1700 print_message(informational, plunit(fixme(Failed, Passed, Nondet))). 1701 1702 1703fixme(How, Tuples, Count) :- 1704 findall(fixme(Unit, Name, Line, Reason, How), 1705 fixme(Unit, Name, Line, Reason, How), Tuples), 1706 length(Tuples, Count). 1707 1708report_failure(Unit, Name, Progress, Line, Error, 1709 Time, Output, _Options) => 1710 test_count(Total), 1711 job_feedback(error, failed(Unit:Name, Progress/Total, Line, 1712 Error, Time, Output)).
fixme
for What.1720test_report(fixme) :- 1721 !, 1722 report_fixme(TuplesF, TuplesP, TuplesN), 1723 append([TuplesF, TuplesP, TuplesN], Tuples), 1724 print_message(informational, plunit(fixme(Tuples))). 1725test_report(What) :- 1726 throw_error(domain_error(report_class, What), _). 1727 1728 1729 /******************************* 1730 * INFO * 1731 *******************************/
1738unit_file(Unit, File), nonvar(Unit) => 1739 unit_file_(Unit, File), 1740 !. 1741unit_file(Unit, File) => 1742 unit_file_(Unit, File). 1743 1744unit_file_(Unit, File) :- 1745 current_unit(Unit, Module, _Context, _Options), 1746 module_property(Module, file(File)). 1747unit_file_(Unit, PlFile) :- 1748 test_file_for(TestFile, PlFile), 1749 module_property(Module, file(TestFile)), 1750 current_unit(Unit, Module, _Context, _Options). 1751 1752 1753 /******************************* 1754 * FILES * 1755 *******************************/
1762load_test_files(_Options) :- 1763 State = state(0,0), 1764 ( source_file(File), 1765 file_name_extension(Base, Old, File), 1766 Old \== plt, 1767 file_name_extension(Base, plt, TestFile), 1768 exists_file(TestFile), 1769 inc_arg(1, State), 1770 ( test_file_for(TestFile, File) 1771 -> true 1772 ; load_files(TestFile, 1773 [ if(changed), 1774 imports([]) 1775 ]), 1776 inc_arg(2, State), 1777 asserta(test_file_for(TestFile, File)) 1778 ), 1779 fail 1780 ; State = state(Total, Loaded), 1781 print_message(informational, plunit(test_files(Total, Loaded))) 1782 ). 1783 1784inc_arg(Arg, State) :- 1785 arg(Arg, State, N0), 1786 N is N0+1, 1787 nb_setarg(Arg, State, N). 1788 1789 1790 /******************************* 1791 * MESSAGES * 1792 *******************************/
print_message(Level, Term)
, where Level is one of silent
or
informational
(default).
1799info(Term) :-
1800 message_level(Level),
1801 print_message(Level, Term).
forall(Gen,Test)
set. Mapped
to forall(FTotal, FFailed)
1818progress(UnitTest, _Progress, forall(end, Nth, FTotal), Time) => 1819 ( retract(forall_failures(Nth, FFailed)) 1820 -> true 1821 ; FFailed = 0 1822 ), 1823 test_count(Total), 1824 job_feedback(information, progress(UnitTest, forall(FTotal,FFailed), Nth/Total, Time)). 1825progress(UnitTest, Progress, Result, Time), Progress = forall(_Vars, Nth-_I) => 1826 with_mutex(plunit_forall_counter, 1827 update_forall_failures(Nth, Result)), 1828 test_count(Total), 1829 job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)). 1830progress(UnitTest, Progress, Result, Time) => 1831 test_count(Total), 1832 job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)). 1833 1834update_forall_failures(_Nth, passed) => 1835 true. 1836update_forall_failures(Nth, _) => 1837 ( retract(forall_failures(Nth, Failed0)) 1838 -> true 1839 ; Failed0 = 0 1840 ), 1841 Failed is Failed0+1, 1842 asserta(forall_failures(Nth, Failed)). 1843 1844message_level(Level) :- 1845 ( current_test_flag(silent, true) 1846 -> Level = silent 1847 ; Level = informational 1848 ). 1849 1850locationprefix(File:Line) --> 1851 !, 1852 [ url(File:Line), ':'-[], nl, ' ' ]. 1853locationprefix(test(Unit,_Test,Line)) --> 1854 !, 1855 { unit_file(Unit, File) }, 1856 locationprefix(File:Line). 1857locationprefix(unit(Unit)) --> 1858 !, 1859 [ 'PL-Unit: unit ~w: '-[Unit] ]. 1860locationprefix(FileLine) --> 1861 { throw_error(type_error(locationprefix,FileLine), _) }. 1862 1863:- discontiguous 1864 message//1. 1865:- '$hide'(message//1). 1866 1867message(error(context_error(plunit_close(Name, -)), _)) --> 1868 [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ]. 1869message(error(context_error(plunit_close(Name, Start)), _)) --> 1870 [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ]. 1871message(plunit(nondet(File, Line, Name))) --> 1872 locationprefix(File:Line), 1873 [ 'PL-Unit: Test ~w: Test succeeded with choicepoint'- [Name] ]. 1874message(error(plunit(incompatible_options, Tests), _)) --> 1875 [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ]. 1876message(plunit(sto(true))) --> 1877 [ 'Option sto(true) is ignored. See `occurs_check` option.'-[] ]. 1878message(plunit(test_files(Total, Loaded))) --> 1879 [ 'Found ~D .plt test files, loaded ~D'-[Total, Loaded] ]. 1880 1881 % Unit start/end 1882message(plunit(jobs(1))) --> 1883 !. 1884message(plunit(jobs(N))) --> 1885 [ 'Testing with ~D parallel jobs'-[N] ]. 1886message(plunit(begin(_Unit))) --> 1887 { tty_feedback }, 1888 !. 1889message(plunit(begin(Unit))) --> 1890 [ 'Start unit: ~w~n'-[Unit], flush ]. 1891message(plunit(end(_Unit, _Summary))) --> 1892 { tty_feedback }, 1893 !. 1894message(plunit(end(Unit, Summary))) --> 1895 ( {test_summary_passed(Summary)} 1896 -> [ 'End unit ~w: passed (~3f sec CPU)'-[Unit, Summary.time.cpu] ] 1897 ; [ ansi(error, 'End unit ~w: **FAILED (~3f sec CPU)', [Unit, Summary.time.cpu]) ] 1898 ). 1899message(plunit(blocked(unit(Unit, Reason)))) --> 1900 [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ]. 1901message(plunit(running([]))) --> 1902 !, 1903 [ 'PL-Unit: no tests running' ]. 1904message(plunit(running([One]))) --> 1905 !, 1906 [ 'PL-Unit: running ' ], 1907 running(One). 1908message(plunit(running(More))) --> 1909 !, 1910 [ 'PL-Unit: running tests:', nl ], 1911 running(More). 1912message(plunit(fixme([]))) --> !. 1913message(plunit(fixme(Tuples))) --> 1914 !, 1915 fixme_message(Tuples). 1916message(plunit(total_time(Time))) --> 1917 [ 'Test run completed'-[] ], 1918 test_time(Time). 1919 1920 % Blocked tests 1921message(plunit(blocked(1, Tests))) --> 1922 !, 1923 [ 'one test is blocked'-[] ], 1924 blocked_tests(Tests). 1925message(plunit(blocked(N, Tests))) --> 1926 [ '~D tests are blocked'-[N] ], 1927 blocked_tests(Tests). 1928 1929blocked_tests(Tests) --> 1930 { current_test_flag(show_blocked, true) }, 1931 !, 1932 [':'-[]], 1933 list_blocked(Tests). 1934blocked_tests(_) --> 1935 [ ' (use run_tests/2 with ', ansi(code, 'show_blocked(true)', []), 1936 ' for details)'-[] 1937 ]. 1938 1939list_blocked([]) --> !. 1940list_blocked([blocked(Unit:Test, Pos, Reason)|T]) --> 1941 [nl], 1942 locationprefix(Pos), 1943 test_name(Unit:Test, -), 1944 [ ': ~w'-[Reason] ], 1945 list_blocked(T). 1946 1947 % fail/success 1948message(plunit(no_tests)) --> 1949 !, 1950 [ 'No tests to run' ]. 1951message(plunit(all_passed(1, 1, Time))) --> 1952 !, 1953 [ 'test passed' ], 1954 test_time(Time). 1955message(plunit(all_passed(Total, Total, Time))) --> 1956 !, 1957 [ 'All ~D tests passed'-[Total] ], 1958 test_time(Time). 1959message(plunit(all_passed(Total, Count, Time))) --> 1960 !, 1961 { SubTests is Count-Total }, 1962 [ 'All ~D (+~D sub-tests) tests passed'- [Total, SubTests] ], 1963 test_time(Time). 1964 1965test_time(Time) --> 1966 { var(Time) }, !. 1967test_time(Time) --> 1968 [ ' in ~3f seconds (~3f cpu)'-[Time.wall, Time.cpu] ]. 1969 1970message(plunit(passed(Count))) --> 1971 !, 1972 [ '~D tests passed'-[Count] ]. 1973message(plunit(failed(0))) --> 1974 !, 1975 []. 1976message(plunit(failed(1))) --> 1977 !, 1978 [ '1 test failed'-[] ]. 1979message(plunit(failed(N))) --> 1980 [ '~D tests failed'-[N] ]. 1981message(plunit(timeout(0))) --> 1982 !, 1983 []. 1984message(plunit(timeout(N))) --> 1985 [ '~D tests timed out'-[N] ]. 1986message(plunit(fixme(0,0,0))) --> 1987 []. 1988message(plunit(fixme(Failed,0,0))) --> 1989 !, 1990 [ 'all ~D tests flagged FIXME failed'-[Failed] ]. 1991message(plunit(fixme(Failed,Passed,0))) --> 1992 [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ]. 1993message(plunit(fixme(Failed,Passed,Nondet))) --> 1994 { TotalPassed is Passed+Nondet }, 1995 [ 'FIXME: ~D failed; ~D passed; (~D nondet)'- 1996 [Failed, TotalPassed, Nondet] ]. 1997 1998message(plunit(begin(Unit:Test, _Location, Progress))) --> 1999 { tty_columns(SummaryWidth, _Margin), 2000 test_name_summary(Unit:Test, SummaryWidth, NameS), 2001 progress_string(Progress, ProgressS) 2002 }, 2003 ( { tty_feedback, 2004 tty_clear_to_eol(CE) 2005 } 2006 -> [ at_same_line, '\r[~w] ~w ..~w'-[ProgressS, NameS, 2007 CE], flush ] 2008 ; { jobs(_) } 2009 -> [ '[~w] ~w ..'-[ProgressS, NameS] ] 2010 ; [ '[~w] ~w ..'-[ProgressS, NameS], flush ] 2011 ). 2012message(plunit(end(_UnitTest, _Location, _Progress))) --> 2013 []. 2014message(plunit(progress(_UnitTest, Status, _Progress, _Time))) --> 2015 { Status = forall(_,_) 2016 ; Status == assertion 2017 }, 2018 !. 2019message(plunit(progress(Unit:Test, Status, Progress, Time))) --> 2020 { jobs(_), 2021 !, 2022 tty_columns(SummaryWidth, Margin), 2023 test_name_summary(Unit:Test, SummaryWidth, NameS), 2024 progress_string(Progress, ProgressS), 2025 progress_tag(Status, Tag, _Keep, Style) 2026 }, 2027 [ ansi(Style, '[~w] ~w ~`.t ~w (~3f sec)~*|', 2028 [ProgressS, NameS, Tag, Time.wall, Margin]) ]. 2029message(plunit(progress(_UnitTest, Status, _Progress, Time))) --> 2030 { tty_columns(_SummaryWidth, Margin), 2031 progress_tag(Status, Tag, _Keep, Style) 2032 }, 2033 [ at_same_line, ansi(Style, '~`.t ~w (~3f sec)~*|', 2034 [Tag, Time.wall, Margin]) ], 2035 ( { tty_feedback } 2036 -> [flush] 2037 ; [] 2038 ). 2039message(plunit(failed(Unit:Test, Progress, Line, Failure, _Time, Output))) --> 2040 { unit_file(Unit, File) }, 2041 locationprefix(File:Line), 2042 test_name(Unit:Test, Progress), 2043 [': '-[] ], 2044 failure(Failure), 2045 test_output(Output). 2046message(plunit(timeout(Unit:Test, Progress, Line, Limit, Output))) --> 2047 { unit_file(Unit, File) }, 2048 locationprefix(File:Line), 2049 test_name(Unit:Test, Progress), 2050 [': '-[] ], 2051 timeout(Limit), 2052 test_output(Output). 2053:- if(swi). 2054message(plunit(failed_assertion(Unit:Test, Line, AssertLoc, 2055 Progress, Reason, Goal))) --> 2056 { unit_file(Unit, File) }, 2057 locationprefix(File:Line), 2058 test_name(Unit:Test, Progress), 2059 [ ': assertion'-[] ], 2060 assertion_location(AssertLoc, File), 2061 assertion_reason(Reason), ['\n\t'], 2062 assertion_goal(Unit, Goal). 2063 2064assertion_location(File:Line, File) --> 2065 [ ' at line ~w'-[Line] ]. 2066assertion_location(File:Line, _) --> 2067 [ ' at ', url(File:Line) ]. 2068assertion_location(unknown, _) --> 2069 []. 2070 2071assertion_reason(fail) --> 2072 !, 2073 [ ' failed'-[] ]. 2074assertion_reason(Error) --> 2075 { message_to_string(Error, String) }, 2076 [ ' raised "~w"'-[String] ]. 2077 2078assertion_goal(Unit, Goal) --> 2079 { unit_module(Unit, Module), 2080 unqualify(Goal, Module, Plain) 2081 }, 2082 [ 'Assertion: ~p'-[Plain] ]. 2083 2084unqualify(Var, _, Var) :- 2085 var(Var), 2086 !. 2087unqualify(M:Goal, Unit, Goal) :- 2088 nonvar(M), 2089 unit_module(Unit, M), 2090 !. 2091unqualify(M:Goal, _, Goal) :- 2092 callable(Goal), 2093 predicate_property(M:Goal, imported_from(system)), 2094 !. 2095unqualify(Goal, _, Goal). 2096 2097test_output(Msgs-String) --> 2098 { nonvar(Msgs) }, 2099 !, 2100 test_output(String). 2101test_output("") --> []. 2102test_output(Output) --> 2103 [ ansi(code, '~N~s', [Output]) ]. 2104 2105:- endif. 2106 % Setup/condition errors 2107message(plunit(error(Where, Context, _Output, throw(Exception)))) --> 2108 locationprefix(Context), 2109 { message_to_string(Exception, String) }, 2110 [ 'error in ~w: ~w'-[Where, String] ]. 2111message(plunit(error(Where, Context, _Output, false))) --> 2112 locationprefix(Context), 2113 [ 'setup failed in ~w'-[Where] ]. 2114 2115 % delayed output 2116message(plunit(test_output(_, Output))) --> 2117 [ '~s'-[Output] ]. 2118 % Interrupts (SWI) 2119:- if(swi). 2120message(interrupt(begin)) --> 2121 { thread_self(Me), 2122 running(Unit, Test, Line, Progress, Me), 2123 !, 2124 unit_file(Unit, File), 2125 restore_output_state 2126 }, 2127 [ 'Interrupted test '-[] ], 2128 running(running(Unit:Test, File:Line, Progress, Me)), 2129 [nl], 2130 '$messages':prolog_message(interrupt(begin)). 2131message(interrupt(begin)) --> 2132 '$messages':prolog_message(interrupt(begin)). 2133:- endif. 2134 2135message(concurrent) --> 2136 [ 'concurrent(true) at the level of units is currently ignored.', nl, 2137 'See set_test_options/1 with jobs(Count) for concurrent testing.' 2138 ]. 2139 2140test_name(Name, forall(Bindings, _Nth-I)) --> 2141 !, 2142 test_name(Name, -), 2143 [ ' (~d-th forall bindings = '-[I], 2144 ansi(code, '~p', [Bindings]), ')'-[] 2145 ]. 2146test_name(Name, _) --> 2147 !, 2148 [ 'test ', ansi(code, '~q', [Name]) ]. 2149 2150running(running(Unit:Test, File:Line, _Progress, Thread)) --> 2151 thread(Thread), 2152 [ '~q:~q at '-[Unit, Test], url(File:Line) ]. 2153running([H|T]) --> 2154 ['\t'], running(H), 2155 ( {T == []} 2156 -> [] 2157 ; [nl], running(T) 2158 ). 2159 2160thread(main) --> !. 2161thread(Other) --> 2162 [' [~w] '-[Other] ]. 2163 2164:- if(swi). 2165write_term(T, OPS) --> 2166 ['~W'-[T,OPS] ]. 2167:- else. 2168write_term(T, _OPS) --> 2169 ['~q'-[T]]. 2170:- endif. 2171 2172expected_got_ops_(Ex, E, OPS, Goals) --> 2173 [' Expected: '-[]], write_term(Ex, OPS), [nl], 2174 [' Got: '-[]], write_term(E, OPS), [], 2175 ( { Goals = [] } -> [] 2176 ; [nl, ' with: '-[]], write_term(Goals, OPS), [] 2177 ). 2178 2179 2180failure(List) --> 2181 { is_list(List) }, 2182 !, 2183 [ nl ], 2184 failures(List). 2185failure(Var) --> 2186 { var(Var) }, 2187 !, 2188 [ 'Unknown failure?' ]. 2189failure(succeeded(Time)) --> 2190 !, 2191 [ 'must fail but succeeded in ~2f seconds~n'-[Time] ]. 2192failure(wrong_error(Expected, Error)) --> 2193 !, 2194 { copy_term(Expected-Error, Ex-E, Goals), 2195 numbervars(Ex-E-Goals, 0, _), 2196 write_options(OPS) 2197 }, 2198 [ 'wrong error'-[], nl ], 2199 expected_got_ops_(Ex, E, OPS, Goals). 2200failure(wrong_answer(cmp(Var, Cmp))) --> 2201 { Cmp =.. [Op,Answer,Expected], 2202 !, 2203 copy_term(Expected-Answer, Ex-A, Goals), 2204 numbervars(Ex-A-Goals, 0, _), 2205 write_options(OPS) 2206 }, 2207 [ 'wrong answer for ', ansi(code, '~w', [Var]), 2208 ' (compared using ~w)'-[Op], nl ], 2209 expected_got_ops_(Ex, A, OPS, Goals). 2210failure(wrong_answer(Cmp)) --> 2211 { Cmp =.. [Op,Answer,Expected], 2212 !, 2213 copy_term(Expected-Answer, Ex-A, Goals), 2214 numbervars(Ex-A-Goals, 0, _), 2215 write_options(OPS) 2216 }, 2217 [ 'wrong answer (compared using ~w)'-[Op], nl ], 2218 expected_got_ops_(Ex, A, OPS, Goals). 2219failure(wrong_answer(CmpExpected, Bindings)) --> 2220 { ( CmpExpected = all(Cmp) 2221 -> Cmp =.. [_Op1,_,Expected], 2222 Got = Bindings, 2223 Type = all 2224 ; CmpExpected = set(Cmp), 2225 Cmp =.. [_Op2,_,Expected0], 2226 sort(Expected0, Expected), 2227 sort(Bindings, Got), 2228 Type = set 2229 ) 2230 }, 2231 [ 'wrong "~w" answer:'-[Type] ], 2232 [ nl, ' Expected: ~q'-[Expected] ], 2233 [ nl, ' Found: ~q'-[Got] ]. 2234:- if(swi). 2235failure(cmp_error(_Cmp, Error)) --> 2236 { message_to_string(Error, Message) }, 2237 [ 'Comparison error: ~w'-[Message] ]. 2238failure(throw(Error)) --> 2239 { Error = error(_,_), 2240 !, 2241 message_to_string(Error, Message) 2242 }, 2243 [ 'received error: ~w'-[Message] ]. 2244:- endif. 2245failure(message) --> 2246 !, 2247 [ 'Generated unexpected warning or error'-[] ]. 2248failure(setup_failed(throw(Error))) --> 2249 { Error = error(_,_), 2250 !, 2251 message_to_string(Error, Message) 2252 }, 2253 [ 'test setup goal raised error: ~w'-[Message] ]. 2254failure(setup_failed(_)) --> 2255 !, 2256 [ 'test setup goal failed' ]. 2257failure(Why) --> 2258 [ '~p'-[Why] ]. 2259 2260failures([]) --> 2261 !. 2262failures([H|T]) --> 2263 !, 2264 failure(H), [nl], 2265 failures(T). 2266 2267timeout(Limit) --> 2268 [ 'Timeout exceeeded (~2f sec)'-[Limit] ]. 2269 2270fixme_message([]) --> []. 2271fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) --> 2272 { unit_file(Unit, File) }, 2273 fixme_message(File:Line, Reason, How), 2274 ( {T == []} 2275 -> [] 2276 ; [nl], 2277 fixme_message(T) 2278 ). 2279 2280fixme_message(Location, Reason, failed) --> 2281 [ 'FIXME: ~w: ~w'-[Location, Reason] ]. 2282fixme_message(Location, Reason, passed) --> 2283 [ 'FIXME: ~w: passed ~w'-[Location, Reason] ]. 2284fixme_message(Location, Reason, nondet) --> 2285 [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ]. 2286 2287 2288write_options([ numbervars(true), 2289 quoted(true), 2290 portray(true), 2291 max_depth(100), 2292 attributes(portray) 2293 ]).
2300test_name_summary(Term, MaxLen, Summary) :- 2301 summary_string(Term, Text), 2302 atom_length(Text, Len), 2303 ( Len =< MaxLen 2304 -> Summary = Text 2305 ; End is MaxLen//2, 2306 Pre is MaxLen - End - 2, 2307 sub_string(Text, 0, Pre, _, PreText), 2308 sub_string(Text, _, End, 0, PostText), 2309 format(string(Summary), '~w..~w', [PreText,PostText]) 2310 ). 2311 2312summary_string(Unit:Test, String) => 2313 summary_string(Test, String1), 2314 atomics_to_string([Unit, String1], :, String). 2315summary_string(@(Name,Vars), String) => 2316 format(string(String), '~W (using ~W)', 2317 [ Name, [numbervars(true), quoted(false)], 2318 Vars, [numbervars(true), portray(true), quoted(true)] 2319 ]). 2320summary_string(Name, String) => 2321 term_string(Name, String, [numbervars(true), quoted(false)]).
2327progress_string(forall(_Vars, N-I)/Total, S) => 2328 format(string(S), '~w-~w/~w', [N,I,Total]). 2329progress_string(Progress, S) => 2330 term_string(Progress, S).
2338progress_tag(passed, Tag, Keep, Style) => 2339 Tag = passed, Keep = false, Style = comment. 2340progress_tag(fixme(passed), Tag, Keep, Style) => 2341 Tag = passed, Keep = false, Style = comment. 2342progress_tag(fixme(_), Tag, Keep, Style) => 2343 Tag = fixme, Keep = true, Style = warning. 2344progress_tag(nondet, Tag, Keep, Style) => 2345 Tag = '**NONDET', Keep = true, Style = warning. 2346progress_tag(timeout(_Limit), Tag, Keep, Style) => 2347 Tag = '**TIMEOUT', Keep = true, Style = warning. 2348progress_tag(assertion, Tag, Keep, Style) => 2349 Tag = '**FAILED', Keep = true, Style = error. 2350progress_tag(failed, Tag, Keep, Style) => 2351 Tag = '**FAILED', Keep = true, Style = error. 2352progress_tag(forall(_,0), Tag, Keep, Style) => 2353 Tag = passed, Keep = false, Style = comment. 2354progress_tag(forall(_,_), Tag, Keep, Style) => 2355 Tag = '**FAILED', Keep = true, Style = error. 2356 2357 2358 /******************************* 2359 * OUTPUT * 2360 *******************************/ 2361 2362save_output_state :- 2363 stream_property(Output, alias(user_output)), 2364 stream_property(Error, alias(user_error)), 2365 asserta(output_streams(Output, Error)). 2366 2367restore_output_state :- 2368 output_streams(Output, Error), 2369 !, 2370 set_stream(Output, alias(user_output)), 2371 set_stream(Error, alias(user_error)). 2372restore_output_state. 2373 2374 2375 2376 /******************************* 2377 * CONCURRENT STATUS * 2378 *******************************/ 2379 2380/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 2381This part deals with interactive feedback when we are running multiple 2382threads. The terminal window cannot work on top of the Prolog message 2383infrastructure and (thus) we have to use more low-level means. 2384- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 2385 2386:- dynamic 2387 jobs/1, % Count 2388 job_window/1, % Count 2389 job_status_line/3. % Job, Format, Args 2390 2391job_feedback(_, jobs(Jobs)) :- 2392 retractall(jobs(_)), 2393 Jobs > 1, 2394 asserta(jobs(Jobs)), 2395 tty_feedback, 2396 !, 2397 retractall(job_window(_)), 2398 asserta(job_window(Jobs)), 2399 retractall(job_status_line(_,_,_)), 2400 jobs_redraw. 2401job_feedback(_, jobs(Jobs)) :- 2402 !, 2403 retractall(job_window(_)), 2404 info(plunit(jobs(Jobs))). 2405job_feedback(_, Msg) :- 2406 job_window(_), 2407 !, 2408 with_mutex(plunit_feedback, job_feedback(Msg)). 2409job_feedback(Level, Msg) :- 2410 print_message(Level, plunit(Msg)). 2411 2412job_feedback(begin(Unit:Test, _Location, Progress)) => 2413 tty_columns(SummaryWidth, _Margin), 2414 test_name_summary(Unit:Test, SummaryWidth, NameS), 2415 progress_string(Progress, ProgressS), 2416 tty_clear_to_eol(CE), 2417 job_format(comment, '\r[~w] ~w ..~w', 2418 [ProgressS, NameS, CE]), 2419 flush_output. 2420job_feedback(end(_UnitTest, _Location, _Progress)) => 2421 true. 2422job_feedback(progress(_UnitTest, Status, _Progress, Time)) => 2423 ( hide_progress(Status) 2424 -> true 2425 ; tty_columns(_SummaryWidth, Margin), 2426 progress_tag(Status, Tag, _Keep, Style), 2427 job_finish(Style, '~`.t ~w (~3f sec)~*|', 2428 [Tag, Time.wall, Margin]) 2429 ). 2430job_feedback(failed(UnitTest, Progress, Line, Error, Time, Output)) => 2431 tty_columns(_SummaryWidth, Margin), 2432 progress_tag(failed, Tag, _Keep, Style), 2433 job_finish(Style, '~`.t ~w (~3f sec)~*|', 2434 [Tag, Time.wall, Margin]), 2435 print_test_output(Error, Output), 2436 ( ( Error = timeout(_) % Status line suffices 2437 ; Error == assertion % We will get an failed test later 2438 ) 2439 -> true 2440 ; print_message(Style, plunit(failed(UnitTest, Progress, Line, 2441 Error, Time, ""))) 2442 ), 2443 jobs_redraw. 2444job_feedback(begin(_Unit)) => true. 2445job_feedback(end(_Unit, _Summary)) => true. 2446 2447hide_progress(assertion). 2448hide_progress(forall(_,_)). 2449hide_progress(failed). 2450hide_progress(timeout(_)). 2451 2452print_test_output(Error, _Msgs-Output) => 2453 print_test_output(Error, Output). 2454print_test_output(_, "") => true. 2455print_test_output(assertion, Output) => 2456 print_message(debug, plunit(test_output(error, Output))). 2457print_test_output(message, Output) => 2458 print_message(debug, plunit(test_output(error, Output))). 2459print_test_output(_, Output) => 2460 print_message(debug, plunit(test_output(informational, Output))).
2466jobs_redraw :- 2467 job_window(N), 2468 !, 2469 tty_columns(_, Width), 2470 tty_header_line(Width), 2471 forall(between(1,N,Line), job_redraw_worker(Line)), 2472 tty_header_line(Width). 2473jobs_redraw. 2474 2475job_redraw_worker(Line) :- 2476 ( job_status_line(Line, Fmt, Args) 2477 -> ansi_format(comment, Fmt, Args) 2478 ; true 2479 ), 2480 nl.
2488job_format(Style, Fmt, Args) :-
2489 job_self(Job),
2490 job_format(Job, Style, Fmt, Args, true).
2498job_finish(Style, Fmt, Args) :- 2499 job_self(Job), 2500 job_finish(Job, Style, Fmt, Args). 2501 2502:- det(job_finish/4). 2503job_finish(Job, Style, Fmt, Args) :- 2504 retract(job_status_line(Job, Fmt0, Args0)), 2505 !, 2506 string_concat(Fmt0, Fmt, Fmt1), 2507 append(Args0, Args, Args1), 2508 job_format(Job, Style, Fmt1, Args1, false). 2509 2510:- det(job_format/5). 2511job_format(Job, Style, Fmt, Args, Save) :- 2512 job_window(Jobs), 2513 Up is Jobs+2-Job, 2514 flush_output(user_output), 2515 tty_up_and_clear(Up), 2516 ansi_format(Style, Fmt, Args), 2517 ( Save == true 2518 -> retractall(job_status_line(Job, _, _)), 2519 asserta(job_status_line(Job, Fmt, Args)) 2520 ; true 2521 ), 2522 tty_down_and_home(Up), 2523 flush_output(user_output). 2524 2525:- det(job_self/1). 2526job_self(Job) :- 2527 job_window(N), 2528 N > 1, 2529 thread_self(Me), 2530 split_string(Me, '_', '', [_,_,S]), 2531 number_string(Job, S).
tty
format, which reuses the current
output line if the test is successful.2538tty_feedback :- 2539 has_tty, 2540 current_test_flag(format, tty). 2541 2542has_tty :- 2543 stream_property(user_output, tty(true)). 2544 2545tty_columns(SummaryWidth, Margin) :- 2546 tty_width(W), 2547 Margin is W-8, 2548 SummaryWidth is max(20,Margin-34). 2549 2550tty_width(W) :- 2551 current_predicate(tty_size/2), 2552 catch(tty_size(_Rows, Cols), error(_,_), fail), 2553 Cols > 25, 2554 !, 2555 W = Cols. 2556tty_width(80). 2557 2558tty_header_line(Width) :- 2559 ansi_format(comment, '~N~`\u2015t~*|~n', [Width]). 2560 2561:- if(current_predicate(tty_get_capability/3)). 2562tty_clear_to_eol(S) :- 2563 getenv('TERM', _), 2564 catch(tty_get_capability(ce, string, S), 2565 error(_,_), 2566 fail), 2567 !. 2568:- endif. 2569tty_clear_to_eol('\e[K'). 2570 2571tty_up_and_clear(Lines) :- 2572 format(user_output, '\e[~dA\r\e[K', [Lines]). 2573 2574tty_down_and_home(Lines) :- 2575 format(user_output, '\e[~dB\r', [Lines]). 2576 2577:- if(swi). 2578 2579:- multifile 2580 prolog:message/3, 2581 user:message_hook/3. 2582 2583prologmessage(Term) --> 2584 message(Term). 2585 2586% user:message_hook(+Term, +Kind, +Lines) 2587 2588user:message_hook(make(done(Files)), _, _) :- 2589 make_run_tests(Files), 2590 fail. % give other hooks a chance 2591 2592:- endif. 2593 2594:- if(sicstus). 2595 2596usergenerate_message_hook(Message) --> 2597 message(Message), 2598 [nl]. % SICStus requires nl at the end
2607user:message_hook(informational, plunit(begin(Unit)), _Lines) :- 2608 format(user_error, '% PL-Unit: ~w ', [Unit]), 2609 flush_output(user_error). 2610user:message_hook(informational, plunit(end(_Unit)), _Lines) :- 2611 format(user, ' done~n', []). 2612 2613:- endif.
Unit Testing
Unit testing environment for SWI-Prolog and SICStus Prolog. For usage, please visit https://www.swi-prolog.org/pldoc/package/plunit. */