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).
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
123goal_expansion(forall(C,A),
124 \+ (C, \+ A)).
125goal_expansion(current_module(Module,File),
126 module_property(Module, file(File))).
127
128
129 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.
152
153
154
202
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).
236
240
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 252
253:- dynamic
254 loading_unit/4, 255 current_unit/4, 256 test_file_for/2. 257
263
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
310
311user:term_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. 331
338
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, -)), _).
349
352
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 387
392
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) 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)) :- !. 428expand_option(_, error(F,C), throws(error(F,C))) :- !. 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(_)).
470
471
473
474expand(end_of_file, _) :-
475 loading_unit(Unit, _, _, _),
476 !,
477 end_tests(Unit), 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
500system:term_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 514
521
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).
536
540
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).
555
560
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 580
581:- meta_predicate
582 reify_tmo(0, -, +),
583 reify(0, -),
584 capture_output(0,-),
585 capture_output(0,-,+),
586 got_messages(0,-). 587
589
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).
603
608
609reify(Goal, Result) :-
610 ( catch(Goal, E, true)
611 -> ( var(E)
612 -> Result = true
613 ; Result = throw(E)
614 )
615 ; Result = false
616 ).
617
624
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 634 ; with_output_to(string(Output), got_messages(Goal, Msgs),
635 [ capture([user_output, user_error]),
636 color(true)
637 ])
638 ).
639
641
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 671
672:- dynamic
673 output_streams/2, 674 test_count/1, 675 passed/5, 676 failed/5, 677 timeout/5, 678 failed_assertion/7, 679 blocked/4, 680 fixme/5, 681 running/5, 682 forall_failures/2. 683
713
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) 752 ).
753
758
759report_and_cleanup(Ref, Time, Options) :-
760 cleanup_trap_assertions(Ref),
761 report(Time, Options),
762 cleanup_after_test.
763
764
768
769run_units(Units, _Options) :-
770 maplist(schedule_unit, Units),
771 job_wait(_).
772
779
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 ).
821
827
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)).
852
857
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 ).
907
908
912
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 935
939
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 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 1003
1007
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).
1013
1017
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, 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).
1044
1049
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 ).
1069
1074
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).
1093
1095
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).
1107
1127
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).
1144
1151
1152run_test_7(Unit, Name, Line, Options, Body, Result) :-
1153 option(true(Cmp), Options), 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), 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), 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), 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), 1201 !,
1202 nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
1203
1207
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.
1241
1242
1247
1248result_vars(Expected, Vars) :-
1249 arg(1, Expected, CmpOp),
1250 arg(1, CmpOp, Vars).
1251
1259
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).
1273
1275
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). 1284:- endif. 1285:- endif. 1286
1287
1292
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. 1301
1306
1307match_error(Expect, Rec) :-
1308 subsumes_term(Expect, Rec).
1309
1320
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(_,_,_).
1332
1336
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(_, _, _).
1350
1351
1355
1356call_ex(Module, Goal) :-
1357 Module:(expand_goal(Goal, GoalEx),
1358 GoalEx).
1359
1364
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 ).
1405
1410
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).
1424
1432
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((Head :- recorded(_, Var, Id), Var = NewArgs)).
1445:- else. 1446:- if(sicstus). 1447:- endif. 1448assert_cyclic(Term) :-
1449 assert(Term).
1450:- endif. 1451
1452
1453 1456
1457:- if(current_prolog_flag(threads, true)). 1458
1459:- dynamic
1460 job_data/2, 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).
1473
1477
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.
1522
1526
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. 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 1566
1577
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)).
1591
1595
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).
1606
1607
1611
1612current_test(Unit, Test, Line, Body, Options) :-
1613 current_unit(Unit, Module, _Supers, _UnitOptions),
1614 Module:'unit test'(Test, Line, Options, Body).
1615
1619
1620current_test_unit(Unit, UnitOptions) :-
1621 current_unit(Unit, _Module, _Supers, UnitOptions).
1622
1623
1624count(Goal, Count) :-
1625 aggregate_all(count, Goal, Count).
1626
1631
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.
1648
1652
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)).
1713
1714
1719
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 1732
1737
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 1756
1761
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 1793
1798
1799info(Term) :-
1800 message_level(Level),
1801 print_message(Level, Term).
1802
1817
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 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 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 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 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 2116message(plunit(test_output(_, Output))) -->
2117 [ '~s'-[Output] ].
2118 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 ]).
2294
2299
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)]).
2322
2326
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).
2331
2337
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 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 2379
2385
2386:- dynamic
2387 jobs/1, 2388 job_window/1, 2389 job_status_line/3. 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(_) 2437 ; Error == assertion 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))).
2461
2465
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.
2481
2487
2488job_format(Style, Fmt, Args) :-
2489 job_self(Job),
2490 job_format(Job, Style, Fmt, Args, true).
2491
2497
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).
2532
2537
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
(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
2583prolog:message(Term) -->
2584 message(Term).
2585
2587
2588user:message_hook(make(done(Files)), _, _) :-
2589 make_run_tests(Files),
2590 fail. 2591
2592:- endif. 2593
2594:- if(sicstus). 2595
2596user:generate_message_hook(Message) -->
2597 message(Message),
2598 [nl]. 2599
2606
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.