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