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),
64 [ option/3, option/2, merge_options/3, select_option/4,
65 select_option/3
66 ]). 67:- autoload(library(ordsets), [ord_intersection/3]). 68:- autoload(library(error), [must_be/2, domain_error/2]). 69:- autoload(library(thread), [concurrent_forall/2]). 70:- autoload(library(aggregate), [aggregate_all/3]). 71:- autoload(library(streams), [with_output_to/3]). 72:- autoload(library(time), [call_with_time_limit/2]). 73:- autoload(library(ansi_term), [ansi_format/3]). 74
75:- meta_predicate
76 valid_options(1, +),
77 count(0, -). 78
79 82
83swi :- catch(current_prolog_flag(dialect, swi), _, fail), !.
84swi :- catch(current_prolog_flag(dialect, yap), _, fail).
85sicstus :- catch(current_prolog_flag(system_type, _), _, fail).
86
87
88:- if(swi). 89throw_error(Error_term,Impldef) :-
90 throw(error(Error_term,context(Impldef,_))).
91
92:- set_prolog_flag(generate_debug_info, false). 93current_test_flag(Name, Value) :-
94 current_prolog_flag(Name, Value).
95
96set_test_flag(Name, Value) :-
97 create_prolog_flag(Name, Value, []).
98
100goal_expansion(forall(C,A),
101 \+ (C, \+ A)).
102goal_expansion(current_module(Module,File),
103 module_property(Module, file(File))).
104
105:- if(current_prolog_flag(dialect, yap)). 106
107'$set_predicate_attribute'(_, _, _).
108
109:- endif. 110:- endif. 111
112:- if(sicstus). 113throw_error(Error_term,Impldef) :-
114 throw(error(Error_term,i(Impldef))). 115
117:- op(700, xfx, =@=). 118
119'$set_source_module'(_, _).
120
125
126:- dynamic test_flag/2. 127
128current_test_flag(optimise, Val) :-
129 current_prolog_flag(compiling, Compiling),
130 ( Compiling == debugcode ; true 131 -> Val = false
132 ; Val = true
133 ).
134current_test_flag(Name, Val) :-
135 test_flag(Name, Val).
136
137
139
140set_test_flag(Name, Val) :-
141 var(Name),
142 !,
143 throw_error(instantiation_error, set_test_flag(Name,Val)).
144set_test_flag( Name, Val ) :-
145 retractall(test_flag(Name,_)),
146 asserta(test_flag(Name, Val)).
147
148:- op(1150, fx, thread_local). 149
150:- discontiguous
151 user:term_expansion/2. 152
153user:term_expansion((:- thread_local(PI)), (:- dynamic(PI))) :-
154 prolog_load_context(module, plunit).
155
156:- endif. 157
158 161
162:- initialization
163 ( current_test_flag(test_options, _)
164 -> true
165 ; set_test_flag(test_options,
166 [ run(make), 167 output(on_failure)
168 ])
169 ). 170
218
219set_test_options(Options) :-
220 select_option(sto(Mode), Options, Options1, _),
221 ( Mode == true
222 -> print_message(warning, plunit(sto(true)))
223 ; true
224 ),
225 ( option(jobs(Jobs), Options1),
226 Jobs > 1
227 -> merge_options([concurrent(true)], Options1, Options2)
228 ; Options2 = Options1
229 ),
230 valid_options(global_test_option, Options2),
231 ( current_test_flag(test_options, OldOptions)
232 -> merge_options(Options2, OldOptions, NewOptions),
233 set_test_flag(test_options, NewOptions)
234 ; set_test_flag(test_options, Options)
235 ).
236
237global_test_option(load(Load)) :-
238 must_be(oneof([never,always,normal]), Load).
239global_test_option(output(Cond)) :-
240 must_be(oneof([always,on_failure]), Cond).
241global_test_option(format(Feedback)) :-
242 must_be(oneof([tty,log]), Feedback).
243global_test_option(run(When)) :-
244 must_be(oneof([manual,make,make(all)]), When).
245global_test_option(silent(Bool)) :-
246 must_be(boolean, Bool).
247global_test_option(occurs_check(Mode)) :-
248 must_be(oneof([false,true,error]), Mode).
249global_test_option(cleanup(Bool)) :-
250 must_be(boolean, Bool).
251global_test_option(concurrent(Bool)) :-
252 must_be(boolean, Bool).
253global_test_option(jobs(Count)) :-
254 must_be(positive_integer, Count).
255global_test_option(timeout(Number)) :-
256 must_be(number, Number).
257
261
262loading_tests :-
263 current_test_flag(test_options, Options),
264 option(load(Load), Options, normal),
265 ( Load == always
266 -> true
267 ; Load == normal,
268 \+ current_test_flag(optimise, true)
269 ).
270
271 274
275:- dynamic
276 loading_unit/4, 277 current_unit/4, 278 test_file_for/2. 279
285
286begin_tests(Unit) :-
287 begin_tests(Unit, []).
288
289begin_tests(Unit, Options) :-
290 must_be(atom, Unit),
291 map_sto_option(Options, Options1),
292 valid_options(test_set_option, Options1),
293 make_unit_module(Unit, Name),
294 source_location(File, Line),
295 begin_tests(Unit, Name, File:Line, Options1).
296
297map_sto_option(Options0, Options) :-
298 select_option(sto(Mode), Options0, Options1),
299 !,
300 map_sto(Mode, Flag),
301 Options = [occurs_check(Flag)|Options1].
302map_sto_option(Options, Options).
303
304map_sto(rational_trees, Flag) => Flag = false.
305map_sto(finite_trees, Flag) => Flag = true.
306map_sto(Mode, _) => domain_error(sto, Mode).
307
308
309:- if(swi). 310begin_tests(Unit, Name, File:Line, Options) :-
311 loading_tests,
312 !,
313 '$set_source_module'(Context, Context),
314 ( current_unit(Unit, Name, Context, Options)
315 -> true
316 ; retractall(current_unit(Unit, Name, _, _)),
317 assert(current_unit(Unit, Name, Context, Options))
318 ),
319 '$set_source_module'(Old, Name),
320 '$declare_module'(Name, test, Context, File, Line, false),
321 discontiguous(Name:'unit test'/4),
322 '$set_predicate_attribute'(Name:'unit test'/4, trace, false),
323 discontiguous(Name:'unit body'/2),
324 asserta(loading_unit(Unit, Name, File, Old)).
325begin_tests(Unit, Name, File:_Line, _Options) :-
326 '$set_source_module'(Old, Old),
327 asserta(loading_unit(Unit, Name, File, Old)).
328
329:- else. 330
332
333user:term_expansion((:- begin_tests(Set)),
334 [ (:- begin_tests(Set)),
335 (:- discontiguous(test/2)),
336 (:- discontiguous('unit body'/2)),
337 (:- discontiguous('unit test'/4))
338 ]).
339
340begin_tests(Unit, Name, File:_Line, Options) :-
341 loading_tests,
342 !,
343 ( current_unit(Unit, Name, _, Options)
344 -> true
345 ; retractall(current_unit(Unit, Name, _, _)),
346 assert(current_unit(Unit, Name, -, Options))
347 ),
348 asserta(loading_unit(Unit, Name, File, -)).
349begin_tests(Unit, Name, File:_Line, _Options) :-
350 asserta(loading_unit(Unit, Name, File, -)).
351
352:- endif. 353
360
361end_tests(Unit) :-
362 loading_unit(StartUnit, _, _, _),
363 !,
364 ( Unit == StartUnit
365 -> once(retract(loading_unit(StartUnit, _, _, Old))),
366 '$set_source_module'(_, Old)
367 ; throw_error(context_error(plunit_close(Unit, StartUnit)), _)
368 ).
369end_tests(Unit) :-
370 throw_error(context_error(plunit_close(Unit, -)), _).
371
374
375:- if(swi). 376
377unit_module(Unit, Module) :-
378 atom_concat('plunit_', Unit, Module).
379
380make_unit_module(Unit, Module) :-
381 unit_module(Unit, Module),
382 ( current_module(Module),
383 \+ current_unit(_, Module, _, _),
384 predicate_property(Module:H, _P),
385 \+ predicate_property(Module:H, imported_from(_M))
386 -> throw_error(permission_error(create, plunit, Unit),
387 'Existing module')
388 ; true
389 ).
390
391:- else. 392
393:- dynamic
394 unit_module_store/2. 395
396unit_module(Unit, Module) :-
397 unit_module_store(Unit, Module),
398 !.
399
400make_unit_module(Unit, Module) :-
401 prolog_load_context(module, Module),
402 assert(unit_module_store(Unit, Module)).
403
404:- endif. 405
406 409
414
415expand_test(Name, Options0, Body,
416 [ 'unit test'(Name, Line, Options, Module:'unit body'(Id, Vars)),
417 ('unit body'(Id, Vars) :- !, Body)
418 ]) :-
419 source_location(_File, Line),
420 prolog_load_context(module, Module),
421 ( prolog_load_context(variable_names, Bindings)
422 -> true
423 ; Bindings = []
424 ),
425 atomic_list_concat([Name, '@line ', Line], Id),
426 term_variables(Options0, OptionVars0), sort(OptionVars0, OptionVars),
427 term_variables(Body, BodyVars0), sort(BodyVars0, BodyVars),
428 ord_intersection(OptionVars, BodyVars, VarList),
429 Vars =.. [vars|VarList],
430 ( is_list(Options0) 431 -> Options1 = Options0
432 ; Options1 = [Options0]
433 ),
434 maplist(expand_option(Bindings), Options1, Options2),
435 join_true_options(Options2, Options3),
436 map_sto_option(Options3, Options4),
437 valid_options(test_option, Options4),
438 valid_test_mode(Options4, Options).
439
440expand_option(_, Var, _) :-
441 var(Var),
442 !,
443 throw_error(instantiation_error,_).
444expand_option(Bindings, Cmp, true(Cond)) :-
445 cmp(Cmp),
446 !,
447 var_cmp(Bindings, Cmp, Cond).
448expand_option(_, error(X), throws(error(X, _))) :- !.
449expand_option(_, exception(X), throws(X)) :- !. 450expand_option(_, error(F,C), throws(error(F,C))) :- !. 451expand_option(_, true, true(true)) :- !.
452expand_option(_, O, O).
453
454cmp(_ == _).
455cmp(_ = _).
456cmp(_ =@= _).
457cmp(_ =:= _).
458
459var_cmp(Bindings, Expr, cmp(Name, Expr)) :-
460 arg(_, Expr, Var),
461 var(Var),
462 member(Name=V, Bindings),
463 V == Var,
464 !.
465var_cmp(_, Expr, Expr).
466
467join_true_options(Options0, Options) :-
468 partition(true_option, Options0, True, Rest),
469 True \== [],
470 !,
471 maplist(arg(1), True, Conds0),
472 flatten(Conds0, Conds),
473 Options = [true(Conds)|Rest].
474join_true_options(Options, Options).
475
476true_option(true(_)).
477
478valid_test_mode(Options0, Options) :-
479 include(test_mode, Options0, Tests),
480 ( Tests == []
481 -> Options = [true([true])|Options0]
482 ; Tests = [_]
483 -> Options = Options0
484 ; throw_error(plunit(incompatible_options, Tests), _)
485 ).
486
487test_mode(true(_)).
488test_mode(all(_)).
489test_mode(set(_)).
490test_mode(fail).
491test_mode(throws(_)).
492
493
495
496expand(end_of_file, _) :-
497 loading_unit(Unit, _, _, _),
498 !,
499 end_tests(Unit), 500 fail.
501expand((:-end_tests(_)), _) :-
502 !,
503 fail.
504expand(_Term, []) :-
505 \+ loading_tests.
506expand((test(Name) :- Body), Clauses) :-
507 !,
508 expand_test(Name, [], Body, Clauses).
509expand((test(Name, Options) :- Body), Clauses) :-
510 !,
511 expand_test(Name, Options, Body, Clauses).
512expand(test(Name), _) :-
513 !,
514 throw_error(existence_error(body, test(Name)), _).
515expand(test(Name, _Options), _) :-
516 !,
517 throw_error(existence_error(body, test(Name)), _).
518
519:- multifile
520 system:term_expansion/2. 521
522system:term_expansion(Term, Expanded) :-
523 ( loading_unit(_, _, File, _)
524 -> source_location(ThisFile, _),
525 ( File == ThisFile
526 -> true
527 ; source_file_property(ThisFile, included_in(File, _))
528 ),
529 expand(Term, Expanded)
530 ).
531
532
533 536
543
544valid_options(Pred, Options) :-
545 must_be(list, Options),
546 verify_options(Options, Pred).
547
548verify_options([], _).
549verify_options([H|T], Pred) :-
550 ( call(Pred, H)
551 -> verify_options(T, Pred)
552 ; throw_error(domain_error(Pred, H), _)
553 ).
554
555valid_options(Pred, Options0, Options, Rest) :-
556 must_be(list, Options0),
557 partition(Pred, Options0, Options, Rest).
558
562
563test_option(Option) :-
564 test_set_option(Option),
565 !.
566test_option(true(_)).
567test_option(fail).
568test_option(throws(_)).
569test_option(all(_)).
570test_option(set(_)).
571test_option(nondet).
572test_option(fixme(_)).
573test_option(forall(X)) :-
574 must_be(callable, X).
575test_option(timeout(Seconds)) :-
576 must_be(number, Seconds).
577
582
583test_set_option(blocked(X)) :-
584 must_be(ground, X).
585test_set_option(condition(X)) :-
586 must_be(callable, X).
587test_set_option(setup(X)) :-
588 must_be(callable, X).
589test_set_option(cleanup(X)) :-
590 must_be(callable, X).
591test_set_option(occurs_check(V)) :-
592 must_be(oneof([false,true,error]), V).
593test_set_option(concurrent(V)) :-
594 must_be(boolean, V).
595test_set_option(timeout(Seconds)) :-
596 must_be(number, Seconds).
597
598 601
602:- meta_predicate
603 reify_tmo(0, -, +),
604 reify(0, -),
605 capture_output(0,-,+). 606
608
609reify_tmo(Goal, Result, Options) :-
610 option(timeout(Time), Options),
611 !,
612 reify(call_with_time_limit(Time, Goal), Result0),
613 ( Result0 = throw(time_limit_exceeded)
614 -> Result = throw(time_limit_exceeded(Time))
615 ; Result = Result0
616 ).
617reify_tmo(Goal, Result, _Options) :-
618 reify(Goal, Result).
619
624
625reify(Goal, Result) :-
626 ( catch(Goal, E, true)
627 -> ( var(E)
628 -> Result = true
629 ; Result = throw(E)
630 )
631 ; Result = false
632 ).
633
634capture_output(Goal, Output, Options) :-
635 option(output(How), Options, always),
636 ( How == always
637 -> call(Goal)
638 ; with_output_to(string(Output), Goal,
639 [ capture([user_output, user_error]),
640 color(true)
641 ])
642 ).
643
644
645 648
649:- dynamic
650 test_count/1, 651 passed/5, 652 failed/5, 653 timeout/5, 654 failed_assertion/7, 655 blocked/4, 656 fixme/5, 657 running/5, 658 forall_failures/2. 659
689
690run_tests :-
691 run_tests(all).
692
693run_tests(Set) :-
694 run_tests(Set, []).
695
696run_tests(all, Options) :-
697 !,
698 findall(Unit, current_test_unit(Unit,_), Units),
699 run_tests(Units, Options).
700run_tests(Set, Options) :-
701 valid_options(global_test_option, Options, Global, Rest),
702 current_test_flag(test_options, Old),
703 setup_call_cleanup(
704 set_test_options(Global),
705 ( flatten([Set], List),
706 maplist(runnable_tests, List, Units),
707 with_mutex(plunit, run_tests_sync(Units, Rest))
708 ),
709 set_test_flag(test_options, Old)).
710
711run_tests_sync(Units, Options) :-
712 cleanup,
713 count_tests(Units, Count),
714 asserta(test_count(Count)),
715 setup_call_cleanup(
716 setup_jobs(Count),
717 setup_call_cleanup(
718 setup_trap_assertions(Ref),
719 run_units_and_check_errors(Units, Options),
720 report_and_cleanup(Ref, Options)),
721 cleanup_jobs).
722
727
728report_and_cleanup(Ref, _Options) :-
729 cleanup_trap_assertions(Ref),
730 report,
731 cleanup_after_test.
732
736
737run_units_and_check_errors(Units, Options) :-
738 maplist(schedule_unit, Units),
739 job_wait,
740 test_summary(_All, Summary),
741 ( option(summary(Summary), Options)
742 -> true
743 ; test_summary_passed(Summary)
744 ).
745
752
753:- det(runnable_tests/2). 754runnable_tests(Spec, Unit:RunnableTests) :-
755 unit_from_spec(Spec, Unit, Tests, Module, UnitOptions),
756 ( option(blocked(Reason), UnitOptions)
757 -> info(plunit(blocked(unit(Unit, Reason)))),
758 RunnableTests = []
759 ; \+ condition(Module, unit(Unit), UnitOptions)
760 -> RunnableTests = []
761 ; var(Tests)
762 -> findall(TestID,
763 runnable_test(Unit, _Test, Module, TestID),
764 RunnableTests)
765 ; flatten([Tests], TestList),
766 findall(TestID,
767 ( member(Test, TestList),
768 runnable_test(Unit,Test,Module, TestID)
769 ),
770 RunnableTests)
771 ).
772
773runnable_test(Unit, Test, Module, @(Test,Line)) :-
774 current_test(Unit, Test, Line, _Body, TestOptions),
775 ( option(blocked(Reason), TestOptions)
776 -> assert(blocked(Unit, Test, Line, Reason)),
777 fail
778 ; condition(Module, test(Unit,Test,Line), TestOptions)
779 ).
780
781unit_from_spec(Unit0:Tests0, Unit, Tests, Module, Options), atom(Unit0) =>
782 Unit = Unit0,
783 Tests = Tests0,
784 ( current_unit(Unit, Module, _Supers, Options)
785 -> true
786 ; throw_error(existence_error(unit_test, Unit), _)
787 ).
788unit_from_spec(Unit0, Unit, _, Module, Options), atom(Unit0) =>
789 Unit = Unit0,
790 ( current_unit(Unit, Module, _Supers, Options)
791 -> true
792 ; throw_error(existence_error(unit_test, Unit), _)
793 ).
794
800
801count_tests(Units, Count) :-
802 foldl(count_tests_in_unit, Units, 0, Count).
803
804count_tests_in_unit(_Unit:Tests, Count0, Count) :-
805 length(Tests, N),
806 Count is Count0+N.
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
835:- if(current_prolog_flag(threads, true)). 836run_unit_2(Unit, Tests) :-
837 unit_options(Unit, UnitOptions),
838 option(concurrent(true), UnitOptions, false),
839 current_test_flag(test_options, GlobalOptions),
840 option(concurrent(true), GlobalOptions),
841 !,
842 concurrent_forall(member(Test, Tests),
843 run_test(Unit, Test)).
844:- endif. 845run_unit_2(Unit, Tests) :-
846 forall(member(Test, Tests),
847 run_test(Unit, Test)).
848
849
850unit_options(Unit, Options) :-
851 current_unit(Unit, _Module, _Supers, Options).
852
853
854cleanup :-
855 set_flag(plunit_test, 1),
856 retractall(test_count(_)),
857 retractall(passed(_, _, _, _, _)),
858 retractall(failed(_, _, _, _, _)),
859 retractall(timeout(_, _, _, _, _)),
860 retractall(failed_assertion(_, _, _, _, _, _, _)),
861 retractall(blocked(_, _, _, _)),
862 retractall(fixme(_, _, _, _, _)),
863 retractall(running(_,_,_,_,_)),
864 retractall(forall_failures(_,_)).
865
866cleanup_after_test :-
867 current_test_flag(test_options, Options),
868 option(cleanup(Cleanup), Options, false),
869 ( Cleanup == true
870 -> cleanup
871 ; true
872 ).
873
874
878
879run_tests_in_files(Files) :-
880 findall(Unit, unit_in_files(Files, Unit), Units),
881 ( Units == []
882 -> true
883 ; run_tests(Units)
884 ).
885
886unit_in_files(Files, Unit) :-
887 is_list(Files),
888 !,
889 member(F, Files),
890 absolute_file_name(F, Source,
891 [ file_type(prolog),
892 access(read),
893 file_errors(fail)
894 ]),
895 unit_file(Unit, Source).
896
897
898 901
905
906make_run_tests(Files) :-
907 current_test_flag(test_options, Options),
908 option(run(When), Options, manual),
909 ( When == make
910 -> run_tests_in_files(Files)
911 ; When == make(all)
912 -> run_tests
913 ; true
914 ).
915
916 919
920:- if(swi). 921
922:- dynamic prolog:assertion_failed/2. 923
924setup_trap_assertions(Ref) :-
925 asserta((prolog:assertion_failed(Reason, Goal) :-
926 test_assertion_failed(Reason, Goal)),
927 Ref).
928
929cleanup_trap_assertions(Ref) :-
930 erase(Ref).
931
932test_assertion_failed(Reason, Goal) :-
933 thread_self(Me),
934 running(Unit, Test, Line, Progress, Me),
935 ( catch(get_prolog_backtrace(10, Stack), _, fail),
936 assertion_location(Stack, AssertLoc)
937 -> true
938 ; AssertLoc = unknown
939 ),
940 current_test_flag(test_options, Options),
941 report_failed_assertion(Unit:Test, Line, AssertLoc,
942 Progress, Reason, Goal, Options),
943 assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc,
944 Progress, Reason, Goal)).
945
946assertion_location(Stack, File:Line) :-
947 append(_, [AssertFrame,CallerFrame|_], Stack),
948 prolog_stack_frame_property(AssertFrame,
949 predicate(prolog_debug:assertion/1)),
950 !,
951 prolog_stack_frame_property(CallerFrame, location(File:Line)).
952
953report_failed_assertion(UnitTest, Line, AssertLoc,
954 Progress, Reason, Goal, _Options) :-
955 print_message(
956 error,
957 plunit(failed_assertion(UnitTest, Line, AssertLoc,
958 Progress, Reason, Goal))).
959
960:- else. 961
962setup_trap_assertions(_).
963cleanup_trap_assertions(_).
964
965:- endif. 966
967
968 971
975
976run_test(Unit, @(Test,Line)) :-
977 unit_module(Unit, Module),
978 Module:'unit test'(Test, Line, TestOptions, Body),
979 unit_options(Unit, UnitOptions),
980 run_test(Unit, Test, Line, UnitOptions, TestOptions, Body).
981
985
986run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
987 option(forall(Generator), Options),
988 !,
989 unit_module(Unit, Module),
990 term_variables(Generator, Vars),
991 start_test(Unit, @(Name,Line), Nth),
992 State = state(0),
993 call_time(forall(Module:Generator, 994 ( incr_forall(State, I),
995 run_test_once6(Unit, Name, forall(Vars, Nth-I), Line,
996 UnitOptions, Options, Body)
997 )),
998 Time),
999 arg(1, State, Generated),
1000 progress(Unit:Name, Nth, forall(end, Nth, Generated), Time).
1001run_test(Unit, Name, Line, UnitOptions, Options, Body) :-
1002 start_test(Unit, @(Name,Line), Nth),
1003 run_test_once6(Unit, Name, Nth, Line, UnitOptions, Options, Body).
1004
1005start_test(_Unit, _TestID, Nth) :-
1006 flag(plunit_test, Nth, Nth+1).
1007
1008incr_forall(State, I) :-
1009 arg(1, State, I0),
1010 I is I0+1,
1011 nb_setarg(1, State, I).
1012
1017
1018run_test_once6(Unit, Name, Progress, Line, UnitOptions, Options, Body) :-
1019 current_test_flag(test_options, GlobalOptions),
1020 inherit_option(timeout, Options, [UnitOptions, GlobalOptions], Options1),
1021 inherit_option(occurs_check, Options1, [UnitOptions, GlobalOptions], Options2),
1022 run_test_once(Unit, Name, Progress, Line, Options2, Body).
1023
1024inherit_option(Name, Options0, Chain, Options) :-
1025 Term =.. [Name,_Value],
1026 ( option(Term, Options0)
1027 -> Options = Options0
1028 ; member(Opts, Chain),
1029 option(Term, Opts)
1030 -> Options = [Term|Options0]
1031 ; Options = Options0
1032 ).
1033
1038
1039run_test_once(Unit, Name, Progress, Line, Options, Body) :-
1040 option(occurs_check(Mode), Options),
1041 !,
1042 current_test_flag(test_options, GlobalOptions),
1043 begin_test(Unit, Name, Line, Progress),
1044 current_prolog_flag(occurs_check, Old),
1045 setup_call_cleanup(
1046 set_prolog_flag(occurs_check, Mode),
1047 capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
1048 Output, GlobalOptions),
1049 set_prolog_flag(occurs_check, Old)),
1050 end_test(Unit, Name, Line, Progress),
1051 report_result(Result, Progress, Output, Options).
1052run_test_once(Unit, Name, Progress, Line, Options, Body) :-
1053 current_test_flag(test_options, GlobalOptions),
1054 begin_test(Unit, Name, Line, Progress),
1055 capture_output(run_test_6(Unit, Name, Line, Options, Body, Result),
1056 Output, GlobalOptions),
1057 end_test(Unit, Name, Line, Progress),
1058 report_result(Result, Progress, Output, Options).
1059
1061
1062:- det(report_result/4). 1063report_result(failure(Unit, Name, Line, How, Time),
1064 Progress, Output, Options) :-
1065 !,
1066 failure(Unit, Name, Progress, Line, How, Time, Output, Options).
1067report_result(success(Unit, Name, Line, Determinism, Time),
1068 Progress, Output, Options) :-
1069 !,
1070 success(Unit, Name, Progress, Line, Determinism, Time, Output, Options).
1071report_result(setup_failed(_Unit, _Name, _Line),
1072 _Progress, _Output, _Options).
1073
1093
1094run_test_6(Unit, Name, Line, Options, Body, Result) :-
1095 option(setup(_Setup), Options),
1096 !,
1097 ( unit_module(Unit, Module),
1098 setup(Module, test(Unit,Name,Line), Options)
1099 -> run_test_7(Unit, Name, Line, Options, Body, Result),
1100 cleanup(Module, Options)
1101 ; Result = setup_failed(Unit, Name, Line)
1102 ).
1103run_test_6(Unit, Name, Line, Options, Body, Result) :-
1104 unit_module(Unit, Module),
1105 run_test_7(Unit, Name, Line, Options, Body, Result),
1106 cleanup(Module, Options).
1107
1114
1115run_test_7(Unit, Name, Line, Options, Body, Result) :-
1116 option(true(Cmp), Options), 1117 !,
1118 unit_module(Unit, Module),
1119 call_time(reify_tmo(call_det(Module:Body, Det), Result0, Options), Time),
1120 ( Result0 == true
1121 -> cmp_true(Cmp, Module, CmpResult),
1122 ( CmpResult == []
1123 -> Result = success(Unit, Name, Line, Det, Time)
1124 ; Result = failure(Unit, Name, Line, CmpResult, Time)
1125 )
1126 ; Result0 == false
1127 -> Result = failure(Unit, Name, Line, failed, Time)
1128 ; Result0 = throw(E2)
1129 -> Result = failure(Unit, Name, Line, throw(E2), Time)
1130 ).
1131run_test_7(Unit, Name, Line, Options, Body, Result) :-
1132 option(fail, Options), 1133 !,
1134 unit_module(Unit, Module),
1135 call_time(reify_tmo(Module:Body, Result0, Options), Time),
1136 ( Result0 == true
1137 -> Result = failure(Unit, Name, Line, succeeded, Time)
1138 ; Result0 == false
1139 -> Result = success(Unit, Name, Line, true, Time)
1140 ; Result0 = throw(E)
1141 -> Result = failure(Unit, Name, Line, throw(E), Time)
1142 ).
1143run_test_7(Unit, Name, Line, Options, Body, Result) :-
1144 option(throws(Expect), Options), 1145 !,
1146 unit_module(Unit, Module),
1147 call_time(reify_tmo(Module:Body, Result0, Options), Time),
1148 ( Result0 == true
1149 -> Result = failure(Unit, Name, Line, no_exception, Time)
1150 ; Result0 == false
1151 -> Result = failure(Unit, Name, Line, failed, Time)
1152 ; Result0 = throw(E)
1153 -> ( match_error(Expect, E)
1154 -> Result = success(Unit, Name, Line, true, Time)
1155 ; Result = failure(Unit, Name, Line, wrong_error(Expect, E), Time)
1156 )
1157 ).
1158run_test_7(Unit, Name, Line, Options, Body, Result) :-
1159 option(all(Answer), Options), 1160 !,
1161 nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result).
1162run_test_7(Unit, Name, Line, Options, Body, Result) :-
1163 option(set(Answer), Options), 1164 !,
1165 nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
1166
1170
1171nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :-
1172 unit_module(Unit, Module),
1173 result_vars(Expected, Vars),
1174 ( call_time(reify_tmo(findall(Vars, Module:Body, Bindings),
1175 Result0, Options), Time)
1176 -> ( Result0 == true
1177 -> ( nondet_compare(Expected, Bindings, Unit, Name, Line)
1178 -> Result = success(Unit, Name, Line, true, Time)
1179 ; Result = failure(Unit, Name, Line,
1180 [wrong_answer(Expected, Bindings)], Time)
1181 )
1182 ; Result0 = throw(E)
1183 -> Result = failure(Unit, Name, Line, throw(E), Time)
1184 )
1185 ).
1186
1187cmp_true([], _, L) =>
1188 L = [].
1189cmp_true([Cmp|T], Module, L) =>
1190 E = error(Formal,_),
1191 cmp_goal(Cmp, Goal),
1192 ( catch(Module:Goal, E, true)
1193 -> ( var(Formal)
1194 -> cmp_true(T, Module, L)
1195 ; L = [cmp_error(Cmp,E)|L1],
1196 cmp_true(T, Module, L1)
1197 )
1198 ; L = [wrong_answer(Cmp)|L1],
1199 cmp_true(T, Module, L1)
1200 ).
1201
1202cmp_goal(cmp(_Var, Expr), Goal) => Goal = Expr.
1203cmp_goal(Expr, Goal) => Goal = Expr.
1204
1205
1210
1211result_vars(Expected, Vars) :-
1212 arg(1, Expected, CmpOp),
1213 arg(1, CmpOp, Vars).
1214
1222
1223nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :-
1224 cmp(Cmp, _Vars, Op, Values),
1225 cmp_list(Values, Bindings, Op).
1226nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :-
1227 cmp(Cmp, _Vars, Op, Values0),
1228 sort(Bindings0, Bindings),
1229 sort(Values0, Values),
1230 cmp_list(Values, Bindings, Op).
1231
1232cmp_list([], [], _Op).
1233cmp_list([E0|ET], [V0|VT], Op) :-
1234 call(Op, E0, V0),
1235 cmp_list(ET, VT, Op).
1236
1238
1239cmp(Var == Value, Var, ==, Value).
1240cmp(Var =:= Value, Var, =:=, Value).
1241cmp(Var = Value, Var, =, Value).
1242:- if(swi). 1243cmp(Var =@= Value, Var, =@=, Value).
1244:- else. 1245:- if(sicstus). 1246cmp(Var =@= Value, Var, variant, Value). 1247:- endif. 1248:- endif. 1249
1250
1255
1256:- if((swi;sicstus)). 1257call_det(Goal, Det) :-
1258 call_cleanup(Goal,Det0=true),
1259 ( var(Det0) -> Det = false ; Det = true ).
1260:- else. 1261call_det(Goal, true) :-
1262 call(Goal).
1263:- endif. 1264
1269
1270match_error(Expect, Rec) :-
1271 subsumes_term(Expect, Rec).
1272
1283
1284setup(Module, Context, Options) :-
1285 option(setup(Setup), Options),
1286 !,
1287 current_test_flag(test_options, GlobalOptions),
1288 capture_output(reify(call_ex(Module, Setup), Result),
1289 Output, GlobalOptions),
1290 ( Result == true
1291 -> true
1292 ; print_message(error,
1293 plunit(error(setup, Context, Output, Result))),
1294 fail
1295 ).
1296setup(_,_,_).
1297
1301
1302condition(Module, Context, Options) :-
1303 option(condition(Cond), Options),
1304 !,
1305 current_test_flag(test_options, GlobalOptions),
1306 capture_output(reify(call_ex(Module, Cond), Result),
1307 Output, GlobalOptions),
1308 ( Result == true
1309 -> true
1310 ; Result == false
1311 -> fail
1312 ; print_message(error,
1313 plunit(error(condition, Context, Output, Result))),
1314 fail
1315 ).
1316condition(_, _, _).
1317
1318
1322
1323call_ex(Module, Goal) :-
1324 Module:(expand_goal(Goal, GoalEx),
1325 GoalEx).
1326
1331
1332cleanup(Module, Options) :-
1333 option(cleanup(Cleanup), Options, true),
1334 ( catch(call_ex(Module, Cleanup), E, true)
1335 -> ( var(E)
1336 -> true
1337 ; print_message(warning, E)
1338 )
1339 ; print_message(warning, goal_failed(Cleanup, '(cleanup handler)'))
1340 ).
1341
1342success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
1343 memberchk(fixme(Reason), Options),
1344 !,
1345 ( ( Det == true
1346 ; memberchk(nondet, Options)
1347 )
1348 -> progress(Unit:Name, Progress, fixme(passed), Time),
1349 Ok = passed
1350 ; progress(Unit:Name, Progress, fixme(nondet), Time),
1351 Ok = nondet
1352 ),
1353 flush_output(user_error),
1354 assert(fixme(Unit, Name, Line, Reason, Ok)).
1355success(Unit, Name, Progress, Line, _, Time, Output, Options) :-
1356 failed_assertion(Unit, Name, Line, _,_,_,_),
1357 !,
1358 failure(Unit, Name, Progress, Line, assertion, Time, Output, Options).
1359success(Unit, Name, Progress, Line, Det, Time, _Output, Options) :-
1360 assert(passed(Unit, Name, Line, Det, Time)),
1361 ( ( Det == true
1362 ; memberchk(nondet, Options)
1363 )
1364 -> progress(Unit:Name, Progress, passed, Time)
1365 ; unit_file(Unit, File),
1366 print_message(warning, plunit(nondet(File, Line, Name)))
1367 ).
1368
1373
1374failure(Unit, Name, Progress, Line, _, Time, _Output, Options),
1375 memberchk(fixme(Reason), Options) =>
1376 assert(fixme(Unit, Name, Line, Reason, failed)),
1377 progress(Unit:Name, Progress, fixme(failed), Time).
1378failure(Unit, Name, Progress, Line, time_limit_exceeded(Limit), Time,
1379 Output, Options) =>
1380 assert_cyclic(timeout(Unit, Name, Line, Limit, Time)),
1381 progress(Unit:Name, Progress, timeout(Limit), Time),
1382 report_failure(Unit, Name, Progress, Line, timeout(Limit), Time, Output, Options).
1383failure(Unit, Name, Progress, Line, E, Time, Output, Options) =>
1384 assert_cyclic(failed(Unit, Name, Line, E, Time)),
1385 progress(Unit:Name, Progress, failed, Time),
1386 report_failure(Unit, Name, Progress, Line, E, Time, Output, Options).
1387
1395
1396:- if(swi). 1397assert_cyclic(Term) :-
1398 acyclic_term(Term),
1399 !,
1400 assert(Term).
1401assert_cyclic(Term) :-
1402 Term =.. [Functor|Args],
1403 recorda(cyclic, Args, Id),
1404 functor(Term, _, Arity),
1405 length(NewArgs, Arity),
1406 Head =.. [Functor|NewArgs],
1407 assert((Head :- recorded(_, Var, Id), Var = NewArgs)).
1408:- else. 1409:- if(sicstus). 1410:- endif. 1411assert_cyclic(Term) :-
1412 assert(Term).
1413:- endif. 1414
1415
1416 1419
1420:- if(current_prolog_flag(threads, true)). 1421
1422:- dynamic
1423 job_data/2, 1424 scheduled_unit/1. 1425
1426schedule_unit(_:[]) :-
1427 !.
1428schedule_unit(UnitAndTests) :-
1429 UnitAndTests = Unit:_Tests,
1430 job_data(Queue, _),
1431 !,
1432 assertz(scheduled_unit(Unit)),
1433 thread_send_message(Queue, unit(UnitAndTests)).
1434schedule_unit(Unit) :-
1435 run_unit(Unit).
1436
1440
1441setup_jobs(Count) :-
1442 current_prolog_flag(cpu_count, Cores),
1443 current_test_flag(test_options, Options),
1444 option(concurrent(true), Options),
1445 option(jobs(Jobs0), Options, Cores),
1446 Jobs is min(Count, Jobs0),
1447 Jobs > 1,
1448 !,
1449 message_queue_create(Q, [alias(plunit_jobs)]),
1450 length(TIDs, Jobs),
1451 foldl(create_plunit_job(Q), TIDs, 1, _),
1452 asserta(job_data(Q, TIDs)),
1453 job_feedback(informational, jobs(Jobs)).
1454setup_jobs(_) :-
1455 job_feedback(informational, jobs(1)).
1456
1457create_plunit_job(Q, TID, N, N1) :-
1458 N1 is N + 1,
1459 atom_concat(plunit_job_, N, Alias),
1460 thread_create(plunit_job(Q), TID, [alias(Alias)]).
1461
1462plunit_job(Queue) :-
1463 repeat,
1464 ( catch(thread_get_message(Queue, Job,
1465 [ timeout(10)
1466 ]),
1467 error(_,_), fail)
1468 -> job(Job),
1469 fail
1470 ; !
1471 ).
1472
1473job(unit(Unit:Tests)) =>
1474 run_unit(Unit:Tests).
1475
1476cleanup_jobs :-
1477 retract(job_data(Queue, TIDSs)),
1478 !,
1479 message_queue_destroy(Queue),
1480 maplist(thread_join, TIDSs).
1481cleanup_jobs.
1482
1486
1487job_wait :-
1488 thread_wait(\+ scheduled_unit(_),
1489 [ wait_preds([scheduled_unit/1]),
1490 timeout(1)
1491 ]),
1492 !.
1493job_wait :-
1494 job_data(_Queue, TIDs),
1495 member(TID, TIDs),
1496 thread_property(TID, status(running)),
1497 !,
1498 job_wait.
1499job_wait.
1500
1501
1502
1503job_info(begin(unit(_Unit))) =>
1504 true.
1505job_info(end(unit(Unit, _Summary))) =>
1506 retractall(scheduled_unit(Unit)).
1507
1508:- else. 1509
1510schedule_unit(Unit) :-
1511 run_unit(Unit).
1512
1513setup_jobs(_) :-
1514 print_message(silent, plunit(jobs(1))).
1515cleanup_jobs.
1516job_wait.
1517job_info(_).
1518
1519:- endif. 1520
1521
1522
1523 1526
1537
1538begin_test(Unit, Test, Line, Progress) :-
1539 thread_self(Me),
1540 assert(running(Unit, Test, Line, Progress, Me)),
1541 unit_file(Unit, File),
1542 test_count(Total),
1543 job_feedback(information, begin(Unit:Test, File:Line, Progress/Total)).
1544
1545end_test(Unit, Test, Line, Progress) :-
1546 thread_self(Me),
1547 retractall(running(_,_,_,_,Me)),
1548 unit_file(Unit, File),
1549 test_count(Total),
1550 job_feedback(information, end(Unit:Test, File:Line, Progress/Total)).
1551
1555
1556running_tests :-
1557 running_tests(Running),
1558 print_message(informational, plunit(running(Running))).
1559
1560running_tests(Running) :-
1561 test_count(Total),
1562 findall(running(Unit:Test, File:Line, Progress/Total, Thread),
1563 ( running(Unit, Test, Line, Progress, Thread),
1564 unit_file(Unit, File)
1565 ), Running).
1566
1567
1571
1572current_test(Unit, Test, Line, Body, Options) :-
1573 current_unit(Unit, Module, _Supers, _UnitOptions),
1574 Module:'unit test'(Test, Line, Options, Body).
1575
1579
1580current_test_unit(Unit, UnitOptions) :-
1581 current_unit(Unit, _Module, _Supers, UnitOptions).
1582
1583
1584count(Goal, Count) :-
1585 aggregate_all(count, Goal, Count).
1586
1591
1592test_summary(Unit, Summary) :-
1593 count(failed(Unit, _0Test, _0Line, _Reason, _0Time), Failed),
1594 count(timeout(Unit, _0Test, _0Line, _Limit, _0Time), Timeout),
1595 count(passed(Unit, _0Test, _0Line, _Det, _0Time), Passed),
1596 count(blocked(Unit, _0Test, _0Line, _0Reason), Blocked),
1597 test_count(Total),
1598 Summary = plunit{total:Total,
1599 passed:Passed,
1600 failed:Failed,
1601 timeout:Timeout,
1602 blocked:Blocked}.
1603
1604test_summary_passed(Summary) :-
1605 _{failed: 0} :< Summary.
1606
1610
1611report :-
1612 test_summary(_, Summary),
1613 print_message(silent, plunit(Summary)),
1614 _{ passed:Passed,
1615 failed:Failed,
1616 timeout:Timeout,
1617 blocked:Blocked
1618 } :< Summary,
1619 ( Passed+Failed+Timeout+Blocked =:= 0
1620 -> info(plunit(no_tests))
1621 ; Failed+Timeout+Blocked =:= 0
1622 -> report_fixme,
1623 test_count(Total),
1624 info(plunit(all_passed(Total, Passed)))
1625 ; report_blocked(Blocked),
1626 report_fixme,
1627 report_failed(Failed),
1628 report_timeout(Timeout),
1629 info(plunit(passed(Passed)))
1630 ).
1631
1632report_blocked(0) =>
1633 true.
1634report_blocked(Blocked) =>
1635 info(plunit(blocked(Blocked))),
1636 ( blocked(Unit, Name, Line, Reason),
1637 unit_file(Unit, File),
1638 print_message(informational,
1639 plunit(blocked(File:Line, Name, Reason))),
1640 fail ; true
1641 ).
1642
1643report_failed(Failed) :-
1644 print_message(error, plunit(failed(Failed))).
1645
1646report_timeout(Count) :-
1647 print_message(warning, plunit(timeout(Count))).
1648
1649report_fixme :-
1650 report_fixme(_,_,_).
1651
1652report_fixme(TuplesF, TuplesP, TuplesN) :-
1653 fixme(failed, TuplesF, Failed),
1654 fixme(passed, TuplesP, Passed),
1655 fixme(nondet, TuplesN, Nondet),
1656 print_message(informational, plunit(fixme(Failed, Passed, Nondet))).
1657
1658
1659fixme(How, Tuples, Count) :-
1660 findall(fixme(Unit, Name, Line, Reason, How),
1661 fixme(Unit, Name, Line, Reason, How), Tuples),
1662 length(Tuples, Count).
1663
1664report_failure(Unit, Name, Progress, Line, Error,
1665 Time, Output, _Options) =>
1666 test_count(Total),
1667 job_feedback(error, failed(Unit:Name, Progress/Total, Line,
1668 Error, Time, Output)).
1669
1670
1675
1676test_report(fixme) :-
1677 !,
1678 report_fixme(TuplesF, TuplesP, TuplesN),
1679 append([TuplesF, TuplesP, TuplesN], Tuples),
1680 print_message(informational, plunit(fixme(Tuples))).
1681test_report(What) :-
1682 throw_error(domain_error(report_class, What), _).
1683
1684
1685 1688
1691
1692unit_file(Unit, File) :-
1693 current_unit(Unit, Module, _Context, _Options),
1694 current_module(Module, File),
1695 !.
1696unit_file(Unit, PlFile) :-
1697 nonvar(PlFile),
1698 test_file_for(TestFile, PlFile),
1699 current_module(Module, TestFile),
1700 current_unit(Unit, Module, _Context, _Options).
1701
1702
1703 1706
1710
1711load_test_files(_Options) :-
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 ( test_file_for(TestFile, File)
1718 -> true
1719 ; load_files(TestFile,
1720 [ if(changed),
1721 imports([])
1722 ]),
1723 asserta(test_file_for(TestFile, File))
1724 ),
1725 fail ; true
1726 ).
1727
1728
1729
1730 1733
1738
1739info(Term) :-
1740 message_level(Level),
1741 print_message(Level, Term).
1742
1757
1758progress(UnitTest, _Progress, forall(end, Nth, FTotal), Time) =>
1759 ( retract(forall_failures(Nth, FFailed))
1760 -> true
1761 ; FFailed = 0
1762 ),
1763 test_count(Total),
1764 job_feedback(information, progress(UnitTest, forall(FTotal,FFailed), Nth/Total, Time)).
1765progress(UnitTest, Progress, Result, Time), Progress = forall(_Vars, Nth-_I) =>
1766 with_mutex(plunit_forall_counter,
1767 update_forall_failures(Nth, Result)),
1768 test_count(Total),
1769 job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)).
1770progress(UnitTest, Progress, Result, Time) =>
1771 test_count(Total),
1772 job_feedback(information, progress(UnitTest, Result, Progress/Total, Time)).
1773
1774update_forall_failures(_Nth, passed) =>
1775 true.
1776update_forall_failures(Nth, _) =>
1777 ( retract(forall_failures(Nth, Failed0))
1778 -> true
1779 ; Failed0 = 0
1780 ),
1781 Failed is Failed0+1,
1782 asserta(forall_failures(Nth, Failed)).
1783
1784message_level(Level) :-
1785 current_test_flag(test_options, Options),
1786 option(silent(Silent), Options, false),
1787 ( Silent == false
1788 -> Level = informational
1789 ; Level = silent
1790 ).
1791
1792locationprefix(File:Line) -->
1793 !,
1794 [ url(File:Line), ':\n\t' ].
1795locationprefix(test(Unit,_Test,Line)) -->
1796 !,
1797 { unit_file(Unit, File) },
1798 locationprefix(File:Line).
1799locationprefix(unit(Unit)) -->
1800 !,
1801 [ 'PL-Unit: unit ~w: '-[Unit] ].
1802locationprefix(FileLine) -->
1803 { throw_error(type_error(locationprefix,FileLine), _) }.
1804
1805:- discontiguous
1806 message//1. 1807:- '$hide'(message//1). 1808
1809message(error(context_error(plunit_close(Name, -)), _)) -->
1810 [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ].
1811message(error(context_error(plunit_close(Name, Start)), _)) -->
1812 [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ].
1813message(plunit(nondet(File, Line, Name))) -->
1814 locationprefix(File:Line),
1815 [ 'PL-Unit: Test ~w: Test succeeded with choicepoint'- [Name] ].
1816message(error(plunit(incompatible_options, Tests), _)) -->
1817 [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ].
1818message(plunit(sto(true))) -->
1819 [ 'Option sto(true) is ignored. See `occurs_check` option.'-[] ].
1820
1821 1822message(plunit(jobs(1))) -->
1823 !.
1824message(plunit(jobs(N))) -->
1825 [ 'Tesing with ~D parallel jobs'-[N] ].
1826message(plunit(begin(_Unit))) -->
1827 { tty_feedback },
1828 !.
1829message(plunit(begin(Unit))) -->
1830 [ 'Start unit: ~w~n'-[Unit], flush ].
1831message(plunit(end(_Unit, _Summary))) -->
1832 { tty_feedback },
1833 !.
1834message(plunit(end(Unit, Summary))) -->
1835 ( {test_summary_passed(Summary)}
1836 -> [ 'End unit ~w: passed (~3f sec CPU)'-[Unit, Summary.time.cpu] ]
1837 ; [ ansi(error, 'End unit ~w: **FAILED (~3f sec CPU)', [Unit, Summary.time.cpu]) ]
1838 ).
1839message(plunit(blocked(unit(Unit, Reason)))) -->
1840 [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ].
1841message(plunit(running([]))) -->
1842 !,
1843 [ 'PL-Unit: no tests running' ].
1844message(plunit(running([One]))) -->
1845 !,
1846 [ 'PL-Unit: running ' ],
1847 running(One).
1848message(plunit(running(More))) -->
1849 !,
1850 [ 'PL-Unit: running tests:', nl ],
1851 running(More).
1852message(plunit(fixme([]))) --> !.
1853message(plunit(fixme(Tuples))) -->
1854 !,
1855 fixme_message(Tuples).
1856
1857 1858message(plunit(blocked(1))) -->
1859 !,
1860 [ 'one test is blocked:'-[] ].
1861message(plunit(blocked(N))) -->
1862 [ '~D tests are blocked:'-[N] ].
1863message(plunit(blocked(Pos, Name, Reason))) -->
1864 locationprefix(Pos),
1865 test_name(Name, -),
1866 [ ': ~w'-[Reason] ].
1867
1868 1869message(plunit(no_tests)) -->
1870 !,
1871 [ 'No tests to run' ].
1872message(plunit(all_passed(1, 1))) -->
1873 !,
1874 [ 'test passed' ].
1875message(plunit(all_passed(Total, Total))) -->
1876 !,
1877 [ 'All ~D tests passed'-[Total] ].
1878message(plunit(all_passed(Total, Count))) -->
1879 !,
1880 { SubTests is Count-Total },
1881 [ 'All ~D (+~D sub-tests) tests passed'-[Total, SubTests] ].
1882message(plunit(passed(Count))) -->
1883 !,
1884 [ '~D tests passed'-[Count] ].
1885message(plunit(failed(0))) -->
1886 !,
1887 [].
1888message(plunit(failed(1))) -->
1889 !,
1890 [ '1 test failed'-[] ].
1891message(plunit(failed(N))) -->
1892 [ '~D tests failed'-[N] ].
1893message(plunit(timeout(0))) -->
1894 !,
1895 [].
1896message(plunit(timeout(N))) -->
1897 [ '~D tests timed out'-[N] ].
1898message(plunit(fixme(0,0,0))) -->
1899 [].
1900message(plunit(fixme(Failed,0,0))) -->
1901 !,
1902 [ 'all ~D tests flagged FIXME failed'-[Failed] ].
1903message(plunit(fixme(Failed,Passed,0))) -->
1904 [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ].
1905message(plunit(fixme(Failed,Passed,Nondet))) -->
1906 { TotalPassed is Passed+Nondet },
1907 [ 'FIXME: ~D failed; ~D passed; (~D nondet)'-
1908 [Failed, TotalPassed, Nondet] ].
1909
1910message(plunit(begin(Unit:Test, _Location, Progress))) -->
1911 { tty_columns(SummaryWidth, _Margin),
1912 test_name_summary(Test, SummaryWidth, NameS),
1913 progress_string(Progress, ProgressS)
1914 },
1915 ( { tty_feedback,
1916 tty_clear_to_eol(CE)
1917 }
1918 -> [ at_same_line, '\r[~w] ~w:~w ..~w'-[ProgressS, Unit, NameS,
1919 CE], flush ]
1920 ; { jobs(_) }
1921 -> [ '[~w] ~w:~w ..'-[ProgressS, Unit, NameS] ]
1922 ; [ '[~w] ~w:~w ..'-[ProgressS, Unit, NameS], flush ]
1923 ).
1924message(plunit(end(_UnitTest, _Location, _Progress))) -->
1925 [].
1926message(plunit(progress(_UnitTest, Status, _Progress, _Time))) -->
1927 { Status = forall(_,_)
1928 ; Status == assertion
1929 },
1930 !.
1931message(plunit(progress(Unit:Test, Status, Progress, Time))) -->
1932 { jobs(_),
1933 !,
1934 tty_columns(SummaryWidth, Margin),
1935 test_name_summary(Test, SummaryWidth, NameS),
1936 progress_string(Progress, ProgressS),
1937 progress_tag(Status, Tag, _Keep, Style)
1938 },
1939 [ ansi(Style, '[~w] ~w:~w ~`.t ~w (~3f sec)~*|',
1940 [ProgressS, Unit, NameS, Tag, Time.wall, Margin]) ].
1941message(plunit(progress(_UnitTest, Status, _Progress, Time))) -->
1942 { tty_columns(_SummaryWidth, Margin),
1943 progress_tag(Status, Tag, _Keep, Style)
1944 },
1945 [ at_same_line, ansi(Style, '~`.t ~w (~3f sec)~*|',
1946 [Tag, Time.wall, Margin]) ],
1947 ( { tty_feedback }
1948 -> [flush]
1949 ; []
1950 ).
1951message(plunit(failed(Unit:Test, Progress, Line, Failure, _Time, Output))) -->
1952 { unit_file(Unit, File) },
1953 locationprefix(File:Line),
1954 test_name(Test, Progress),
1955 [': '-[] ],
1956 failure(Failure),
1957 test_output(Output).
1958message(plunit(timeout(Unit:Test, Progress, Line, Limit, Output))) -->
1959 { unit_file(Unit, File) },
1960 locationprefix(File:Line),
1961 test_name(Test, Progress),
1962 [': '-[] ],
1963 timeout(Limit),
1964 test_output(Output).
1965:- if(swi). 1966message(plunit(failed_assertion(Unit:Test, Line, AssertLoc,
1967 Progress, Reason, Goal))) -->
1968 { unit_file(Unit, File) },
1969 locationprefix(File:Line),
1970 test_name(Test, Progress),
1971 [ ': assertion'-[] ],
1972 assertion_location(AssertLoc, File),
1973 assertion_reason(Reason), ['\n\t'],
1974 assertion_goal(Unit, Goal).
1975
1976assertion_location(File:Line, File) -->
1977 [ ' at line ~w'-[Line] ].
1978assertion_location(File:Line, _) -->
1979 [ ' at ', url(File:Line) ].
1980assertion_location(unknown, _) -->
1981 [].
1982
1983assertion_reason(fail) -->
1984 !,
1985 [ ' failed'-[] ].
1986assertion_reason(Error) -->
1987 { message_to_string(Error, String) },
1988 [ ' raised "~w"'-[String] ].
1989
1990assertion_goal(Unit, Goal) -->
1991 { unit_module(Unit, Module),
1992 unqualify(Goal, Module, Plain)
1993 },
1994 [ 'Assertion: ~p'-[Plain] ].
1995
1996unqualify(Var, _, Var) :-
1997 var(Var),
1998 !.
1999unqualify(M:Goal, Unit, Goal) :-
2000 nonvar(M),
2001 unit_module(Unit, M),
2002 !.
2003unqualify(M:Goal, _, Goal) :-
2004 callable(Goal),
2005 predicate_property(M:Goal, imported_from(system)),
2006 !.
2007unqualify(Goal, _, Goal).
2008
2009test_output("") --> [].
2010test_output(Output) -->
2011 [ ansi(code, '~s', [Output]) ].
2012
2013:- endif. 2014 2015message(plunit(error(Where, Context, _Output, throw(Exception)))) -->
2016 locationprefix(Context),
2017 { message_to_string(Exception, String) },
2018 [ 'error in ~w: ~w'-[Where, String] ].
2019message(plunit(error(Where, Context, _Output, false))) -->
2020 locationprefix(Context),
2021 [ 'setup failed in ~w'-[Where] ].
2022
2023 2024message(plunit(test_output(_, Output))) -->
2025 [ '~s'-[Output] ].
2026 2027:- if(swi). 2028message(interrupt(begin)) -->
2029 { thread_self(Me),
2030 running(Unit, Test, Line, STO, Me),
2031 !,
2032 unit_file(Unit, File)
2033 },
2034 [ 'Interrupted test '-[] ],
2035 running(running(Unit:Test, File:Line, STO, Me)),
2036 [nl],
2037 '$messages':prolog_message(interrupt(begin)).
2038message(interrupt(begin)) -->
2039 '$messages':prolog_message(interrupt(begin)).
2040:- endif. 2041
2042test_name(Name, forall(Bindings, _Nth-I)) -->
2043 !,
2044 [ 'test ~w (~d-th forall bindings = ~p)'-[Name, I, Bindings] ].
2045test_name(Name, _) -->
2046 !,
2047 [ 'test ~w'-[Name] ].
2048
2049det(true) -->
2050 [ 'deterministic' ].
2051det(false) -->
2052 [ 'non-deterministic' ].
2053
2054running(running(Unit:Test, File:Line, Thread)) -->
2055 thread(Thread),
2056 [ '~q:~q at '-[Unit, Test], url(File:Line) ].
2057running([H|T]) -->
2058 ['\t'], running(H),
2059 ( {T == []}
2060 -> []
2061 ; [nl], running(T)
2062 ).
2063
2064thread(main) --> !.
2065thread(Other) -->
2066 [' [~w] '-[Other] ].
2067
2068:- if(swi). 2069write_term(T, OPS) -->
2070 ['~W'-[T,OPS] ].
2071:- else. 2072write_term(T, _OPS) -->
2073 ['~q'-[T]].
2074:- endif. 2075
2076expected_got_ops_(Ex, E, OPS, Goals) -->
2077 [' Expected: '-[]], write_term(Ex, OPS), [nl],
2078 [' Got: '-[]], write_term(E, OPS), [],
2079 ( { Goals = [] } -> []
2080 ; [nl, ' with: '-[]], write_term(Goals, OPS), []
2081 ).
2082
2083
2084failure(List) -->
2085 { is_list(List) },
2086 !,
2087 [ nl ],
2088 failures(List).
2089failure(Var) -->
2090 { var(Var) },
2091 !,
2092 [ 'Unknown failure?' ].
2093failure(succeeded(Time)) -->
2094 !,
2095 [ 'must fail but succeeded in ~2f seconds~n'-[Time] ].
2096failure(wrong_error(Expected, Error)) -->
2097 !,
2098 { copy_term(Expected-Error, Ex-E, Goals),
2099 numbervars(Ex-E-Goals, 0, _),
2100 write_options(OPS)
2101 },
2102 [ 'wrong error'-[], nl ],
2103 expected_got_ops_(Ex, E, OPS, Goals).
2104failure(wrong_answer(cmp(Var, Cmp))) -->
2105 { Cmp =.. [Op,Answer,Expected],
2106 !,
2107 copy_term(Expected-Answer, Ex-A, Goals),
2108 numbervars(Ex-A-Goals, 0, _),
2109 write_options(OPS)
2110 },
2111 [ 'wrong answer for ', ansi(code, '~w', [Var]),
2112 ' (compared using ~w)'-[Op], nl ],
2113 expected_got_ops_(Ex, A, OPS, Goals).
2114failure(wrong_answer(Cmp)) -->
2115 { Cmp =.. [Op,Answer,Expected],
2116 !,
2117 copy_term(Expected-Answer, Ex-A, Goals),
2118 numbervars(Ex-A-Goals, 0, _),
2119 write_options(OPS)
2120 },
2121 [ 'wrong answer (compared using ~w)'-[Op], nl ],
2122 expected_got_ops_(Ex, A, OPS, Goals).
2123failure(wrong_answer(CmpExpected, Bindings)) -->
2124 { ( CmpExpected = all(Cmp)
2125 -> Cmp =.. [_Op1,_,Expected],
2126 Got = Bindings,
2127 Type = all
2128 ; CmpExpected = set(Cmp),
2129 Cmp =.. [_Op2,_,Expected0],
2130 sort(Expected0, Expected),
2131 sort(Bindings, Got),
2132 Type = set
2133 )
2134 },
2135 [ 'wrong "~w" answer:'-[Type] ],
2136 [ nl, ' Expected: ~q'-[Expected] ],
2137 [ nl, ' Found: ~q'-[Got] ].
2138:- if(swi). 2139failure(cmp_error(_Cmp, Error)) -->
2140 { message_to_string(Error, Message) },
2141 [ 'Comparison error: ~w'-[Message] ].
2142failure(throw(Error)) -->
2143 { Error = error(_,_),
2144 !,
2145 message_to_string(Error, Message)
2146 },
2147 [ 'received error: ~w'-[Message] ].
2148:- endif. 2149failure(Why) -->
2150 [ '~p'-[Why] ].
2151
2152failures([]) -->
2153 !.
2154failures([H|T]) -->
2155 !,
2156 failure(H), [nl],
2157 failures(T).
2158
2159timeout(Limit) -->
2160 [ 'Timeout exceeeded (~2f sec)'-[Limit] ].
2161
2162fixme_message([]) --> [].
2163fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) -->
2164 { unit_file(Unit, File) },
2165 fixme_message(File:Line, Reason, How),
2166 ( {T == []}
2167 -> []
2168 ; [nl],
2169 fixme_message(T)
2170 ).
2171
2172fixme_message(Location, Reason, failed) -->
2173 [ 'FIXME: ~w: ~w'-[Location, Reason] ].
2174fixme_message(Location, Reason, passed) -->
2175 [ 'FIXME: ~w: passed ~w'-[Location, Reason] ].
2176fixme_message(Location, Reason, nondet) -->
2177 [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ].
2178
2179
2180write_options([ numbervars(true),
2181 quoted(true),
2182 portray(true),
2183 max_depth(100),
2184 attributes(portray)
2185 ]).
2186
2191
2192test_name_summary(Term, MaxLen, Summary) :-
2193 summary_string(Term, Text),
2194 atom_length(Text, Len),
2195 ( Len =< MaxLen
2196 -> Summary = Text
2197 ; Pre is MaxLen - 8,
2198 sub_string(Text, 0, Pre, _, PreText),
2199 sub_string(Text, _, 5, 0, PostText),
2200 format(string(Summary), '~w...~w', [PreText,PostText])
2201 ).
2202
2203summary_string(@(Name,Vars), String) =>
2204 format(string(String), '~W (using ~W)',
2205 [ Name, [numbervars(true), quoted(false)],
2206 Vars, [numbervars(true), portray(true), quoted(true)]
2207 ]).
2208summary_string(Name, String) =>
2209 term_string(Name, String, [numbervars(true), quoted(false)]).
2210
2214
2215progress_string(forall(_Vars, N-I)/Total, S) =>
2216 format(string(S), '~w-~w/~w', [N,I,Total]).
2217progress_string(Progress, S) =>
2218 term_string(Progress, S).
2219
2225
2226progress_tag(passed, Tag, Keep, Style) =>
2227 Tag = passed, Keep = false, Style = comment.
2228progress_tag(fixme(passed), Tag, Keep, Style) =>
2229 Tag = passed, Keep = false, Style = comment.
2230progress_tag(fixme(_), Tag, Keep, Style) =>
2231 Tag = fixme, Keep = true, Style = warning.
2232progress_tag(nondet, Tag, Keep, Style) =>
2233 Tag = '**NONDET', Keep = true, Style = warning.
2234progress_tag(timeout(_Limit), Tag, Keep, Style) =>
2235 Tag = '**TIMEOUT', Keep = true, Style = warning.
2236progress_tag(assertion, Tag, Keep, Style) =>
2237 Tag = '**FAILED', Keep = true, Style = error.
2238progress_tag(failed, Tag, Keep, Style) =>
2239 Tag = '**FAILED', Keep = true, Style = error.
2240progress_tag(forall(_,0), Tag, Keep, Style) =>
2241 Tag = passed, Keep = false, Style = comment.
2242progress_tag(forall(_,_), Tag, Keep, Style) =>
2243 Tag = '**FAILED', Keep = true, Style = error.
2244
2245
2246 2249
2259
2260:- dynamic
2261 jobs/1, 2262 job_window/1, 2263 job_status_line/3. 2264
2265job_feedback(_, jobs(Jobs)) :-
2266 retractall(jobs(_)),
2267 Jobs > 1,
2268 asserta(jobs(Jobs)),
2269 tty_feedback,
2270 !,
2271 retractall(job_window(_)),
2272 asserta(job_window(Jobs)),
2273 retractall(job_status_line(_,_,_)),
2274 jobs_redraw.
2275job_feedback(_, jobs(Jobs)) :-
2276 !,
2277 retractall(job_window(_)),
2278 info(plunit(jobs(Jobs))).
2279job_feedback(_, Msg) :-
2280 job_window(_),
2281 !,
2282 with_mutex(plunit_feedback, job_feedback(Msg)).
2283job_feedback(Level, Msg) :-
2284 print_message(Level, plunit(Msg)).
2285
2286job_feedback(begin(Unit:Test, _Location, Progress)) =>
2287 tty_columns(SummaryWidth, _Margin),
2288 test_name_summary(Test, SummaryWidth, NameS),
2289 progress_string(Progress, ProgressS),
2290 tty_clear_to_eol(CE),
2291 job_format(comment, '\r[~w] ~w:~w ..~w',
2292 [ProgressS, Unit, NameS, CE]),
2293 flush_output.
2294job_feedback(end(_UnitTest, _Location, _Progress)) =>
2295 true.
2296job_feedback(progress(_UnitTest, Status, _Progress, Time)) =>
2297 ( hide_progress(Status)
2298 -> true
2299 ; tty_columns(_SummaryWidth, Margin),
2300 progress_tag(Status, Tag, _Keep, Style),
2301 job_finish(Style, '~`.t ~w (~3f sec)~*|',
2302 [Tag, Time.wall, Margin])
2303 ).
2304job_feedback(failed(UnitTest, Progress, Line, Error, Time, Output)) =>
2305 tty_columns(_SummaryWidth, Margin),
2306 progress_tag(failed, Tag, _Keep, Style),
2307 job_finish(Style, '~`.t ~w (~3f sec)~*|',
2308 [Tag, Time.wall, Margin]),
2309 print_test_output(Error, Output),
2310 ( ( Error = timeout(_) 2311 ; Error == assertion 2312 )
2313 -> true
2314 ; print_message(Style, plunit(failed(UnitTest, Progress, Line,
2315 Error, Time, "")))
2316 ),
2317 jobs_redraw.
2318job_feedback(begin(_Unit)) => true.
2319job_feedback(end(_Unit, _Summary)) => true.
2320
2321hide_progress(assertion).
2322hide_progress(forall(_,_)).
2323hide_progress(failed).
2324hide_progress(timeout(_)).
2325
2326print_test_output(_, "") => true.
2327print_test_output(assertion, Output) =>
2328 print_message(debug, plunit(test_output(error, Output))).
2329print_test_output(_, Output) =>
2330 print_message(debug, plunit(test_output(informational, Output))).
2331
2335
2336jobs_redraw :-
2337 job_window(N),
2338 !,
2339 tty_columns(_, Width),
2340 tty_header_line(Width),
2341 forall(between(1,N,Line), job_redraw_worker(Line)),
2342 tty_header_line(Width).
2343jobs_redraw.
2344
2345job_redraw_worker(Line) :-
2346 ( job_status_line(Line, Fmt, Args)
2347 -> ansi_format(comment, Fmt, Args)
2348 ; true
2349 ),
2350 nl.
2351
2357
2358job_format(Style, Fmt, Args) :-
2359 job_self(Job),
2360 job_format(Job, Style, Fmt, Args, true).
2361
2367
2368job_finish(Style, Fmt, Args) :-
2369 job_self(Job),
2370 job_finish(Job, Style, Fmt, Args).
2371
2372:- det(job_finish/4). 2373job_finish(Job, Style, Fmt, Args) :-
2374 retract(job_status_line(Job, Fmt0, Args0)),
2375 !,
2376 string_concat(Fmt0, Fmt, Fmt1),
2377 append(Args0, Args, Args1),
2378 job_format(Job, Style, Fmt1, Args1, false).
2379
2380:- det(job_format/5). 2381job_format(Job, Style, Fmt, Args, Save) :-
2382 job_window(Jobs),
2383 Up is Jobs+2-Job,
2384 flush_output(user_output),
2385 tty_up_and_clear(Up),
2386 ansi_format(Style, Fmt, Args),
2387 ( Save == true
2388 -> retractall(job_status_line(Job, _, _)),
2389 asserta(job_status_line(Job, Fmt, Args))
2390 ; true
2391 ),
2392 tty_down_and_home(Up),
2393 flush_output(user_output).
2394
2395:- det(job_self/1). 2396job_self(Job) :-
2397 job_window(N),
2398 N > 1,
2399 thread_self(Me),
2400 split_string(Me, '_', '', [_,_,S]),
2401 number_string(Job, S).
2402
2407
2408tty_feedback :-
2409 has_tty,
2410 current_test_flag(test_options, Options),
2411 option(format(tty), Options, tty).
2412
2413has_tty :-
2414 stream_property(user_output, tty(true)).
2415
2416tty_columns(SummaryWidth, Margin) :-
2417 tty_width(W),
2418 Margin is W-8,
2419 SummaryWidth = max(20,Margin-50).
2420
2421tty_width(W) :-
2422 current_predicate(tty_size/2),
2423 catch(tty_size(_Rows, Cols), error(_,_), fail),
2424 !,
2425 W = Cols.
2426tty_width(80).
2427
(Width) :-
2429 ansi_format(comment, '~N~`\u2015t~*|~n', [Width]).
2430
2431tty_clear_to_eol(S) :-
2432 tty_get_capability(ce, string, S),
2433 !.
2434tty_clear_to_eol('\e[K').
2435
2436tty_up_and_clear(Lines) :-
2437 format(user_output, '\e[~dA\r\e[K', [Lines]).
2438
2439tty_down_and_home(Lines) :-
2440 format(user_output, '\e[~dB\r', [Lines]).
2441
2442:- if(swi). 2443
2444:- multifile
2445 prolog:message/3,
2446 user:message_hook/3. 2447
2448prolog:message(Term) -->
2449 message(Term).
2450
2452
2453user:message_hook(make(done(Files)), _, _) :-
2454 make_run_tests(Files),
2455 fail. 2456
2457:- endif. 2458
2459:- if(sicstus). 2460
2461user:generate_message_hook(Message) -->
2462 message(Message),
2463 [nl]. 2464
2471
2472user:message_hook(informational, plunit(begin(Unit)), _Lines) :-
2473 format(user_error, '% PL-Unit: ~w ', [Unit]),
2474 flush_output(user_error).
2475user:message_hook(informational, plunit(end(_Unit)), _Lines) :-
2476 format(user, ' done~n', []).
2477
2478:- endif.