36
37:- module(plunit,
38 [ set_test_options/1, 39 begin_tests/1, 40 begin_tests/2, 41 end_tests/1, 42 run_tests/0, 43 run_tests/1, 44 load_test_files/1, 45 running_tests/0, 46 current_test/5, 47 test_report/1 48 ]).
56:- autoload(library(apply),[maplist/3,include/3]). 57:- autoload(library(lists),[member/2,append/2]). 58:- autoload(library(option),[option/3,option/2]). 59:- autoload(library(ordsets),[ord_intersection/3]). 60:- autoload(library(pairs),[group_pairs_by_key/2,pairs_values/2]). 61:- autoload(library(error),[must_be/2]). 62
63:- meta_predicate valid_options(+, 1). 64
65
66 69
70:- discontiguous
71 user:term_expansion/2. 72
73:- dynamic
74 include_code/1. 75
76including :-
77 include_code(X),
78 !,
79 X == true.
80including.
81
82if_expansion((:- if(G)), []) :-
83 ( including
84 -> ( catch(G, E, (print_message(error, E), fail))
85 -> asserta(include_code(true))
86 ; asserta(include_code(false))
87 )
88 ; asserta(include_code(else_false))
89 ).
90if_expansion((:- else), []) :-
91 ( retract(include_code(X))
92 -> ( X == true
93 -> X2 = false
94 ; X == false
95 -> X2 = true
96 ; X2 = X
97 ),
98 asserta(include_code(X2))
99 ; throw_error(context_error(no_if),_)
100 ).
101if_expansion((:- endif), []) :-
102 retract(include_code(_)),
103 !.
104
105if_expansion(_, []) :-
106 \+ including.
107
108user:term_expansion(In, Out) :-
109 prolog_load_context(module, plunit),
110 if_expansion(In, Out).
111
112swi :- catch(current_prolog_flag(dialect, swi), _, fail), !.
113swi :- catch(current_prolog_flag(dialect, yap), _, fail).
114sicstus :- catch(current_prolog_flag(system_type, _), _, fail).
115
116
117:- if(swi). 118throw_error(Error_term,Impldef) :-
119 throw(error(Error_term,context(Impldef,_))).
120
121:- set_prolog_flag(generate_debug_info, false). 122current_test_flag(Name, Value) :-
123 current_prolog_flag(Name, Value).
124
125set_test_flag(Name, Value) :-
126 create_prolog_flag(Name, Value, []).
127
129goal_expansion(forall(C,A),
130 \+ (C, \+ A)).
131goal_expansion(current_module(Module,File),
132 module_property(Module, file(File))).
133
134:- if(current_prolog_flag(dialect, yap)). 135
136'$set_predicate_attribute'(_, _, _).
137
138:- endif. 139:- endif. 140
141:- if(sicstus). 142throw_error(Error_term,Impldef) :-
143 throw(error(Error_term,i(Impldef))). 144
146:- op(700, xfx, =@=). 147
148'$set_source_module'(_, _).
155:- dynamic test_flag/2. 156
157current_test_flag(optimise, Val) :-
158 current_prolog_flag(compiling, Compiling),
159 ( Compiling == debugcode ; true 160 -> Val = false
161 ; Val = true
162 ).
163current_test_flag(Name, Val) :-
164 test_flag(Name, Val).
169set_test_flag(Name, Val) :-
170 var(Name),
171 !,
172 throw_error(instantiation_error, set_test_flag(Name,Val)).
173set_test_flag( Name, Val ) :-
174 retractall(test_flag(Name,_)),
175 asserta(test_flag(Name, Val)).
176
177:- op(1150, fx, thread_local). 178
179user:term_expansion((:- thread_local(PI)), (:- dynamic(PI))) :-
180 prolog_load_context(module, plunit).
181
182:- endif. 183
184 187
188:- initialization
189 ( current_test_flag(test_options, _)
190 -> true
191 ; set_test_flag(test_options,
192 [ run(make), 193 sto(false)
194 ])
195 ).
226set_test_options(Options) :-
227 valid_options(Options, global_test_option),
228 set_test_flag(test_options, Options).
229
230global_test_option(load(Load)) :-
231 must_be(oneof([never,always,normal]), Load).
232global_test_option(run(When)) :-
233 must_be(oneof([manual,make,make(all)]), When).
234global_test_option(silent(Bool)) :-
235 must_be(boolean, Bool).
236global_test_option(sto(Bool)) :-
237 must_be(boolean, Bool).
238global_test_option(cleanup(Bool)) :-
239 must_be(boolean, Bool).
246loading_tests :-
247 current_test_flag(test_options, Options),
248 option(load(Load), Options, normal),
249 ( Load == always
250 -> true
251 ; Load == normal,
252 \+ current_test_flag(optimise, true)
253 ).
254
255 258
259:- dynamic
260 loading_unit/4, 261 current_unit/4, 262 test_file_for/2.
270begin_tests(Unit) :-
271 begin_tests(Unit, []).
272
273begin_tests(Unit, Options) :-
274 valid_options(Options, test_set_option),
275 make_unit_module(Unit, Name),
276 source_location(File, Line),
277 begin_tests(Unit, Name, File:Line, Options).
278
279:- if(swi). 280begin_tests(Unit, Name, File:Line, Options) :-
281 loading_tests,
282 !,
283 '$set_source_module'(Context, Context),
284 ( current_unit(Unit, Name, Context, Options)
285 -> true
286 ; retractall(current_unit(Unit, Name, _, _)),
287 assert(current_unit(Unit, Name, Context, Options))
288 ),
289 '$set_source_module'(Old, Name),
290 '$declare_module'(Name, test, Context, File, Line, false),
291 discontiguous(Name:'unit test'/4),
292 '$set_predicate_attribute'(Name:'unit test'/4, trace, false),
293 discontiguous(Name:'unit body'/2),
294 asserta(loading_unit(Unit, Name, File, Old)).
295begin_tests(Unit, Name, File:_Line, _Options) :-
296 '$set_source_module'(Old, Old),
297 asserta(loading_unit(Unit, Name, File, Old)).
298
299:- else. 300
302
303user:term_expansion((:- begin_tests(Set)),
304 [ (:- begin_tests(Set)),
305 (:- discontiguous(test/2)),
306 (:- discontiguous('unit body'/2)),
307 (:- discontiguous('unit test'/4))
308 ]).
309
310begin_tests(Unit, Name, File:_Line, Options) :-
311 loading_tests,
312 !,
313 ( current_unit(Unit, Name, _, Options)
314 -> true
315 ; retractall(current_unit(Unit, Name, _, _)),
316 assert(current_unit(Unit, Name, -, Options))
317 ),
318 asserta(loading_unit(Unit, Name, File, -)).
319begin_tests(Unit, Name, File:_Line, _Options) :-
320 asserta(loading_unit(Unit, Name, File, -)).
321
322:- endif.
331end_tests(Unit) :-
332 loading_unit(StartUnit, _, _, _),
333 !,
334 ( Unit == StartUnit
335 -> once(retract(loading_unit(StartUnit, _, _, Old))),
336 '$set_source_module'(_, Old)
337 ; throw_error(context_error(plunit_close(Unit, StartUnit)), _)
338 ).
339end_tests(Unit) :-
340 throw_error(context_error(plunit_close(Unit, -)), _).
345:- if(swi). 346
347unit_module(Unit, Module) :-
348 atom_concat('plunit_', Unit, Module).
349
350make_unit_module(Unit, Module) :-
351 unit_module(Unit, Module),
352 ( current_module(Module),
353 \+ current_unit(_, Module, _, _),
354 predicate_property(Module:H, _P),
355 \+ predicate_property(Module:H, imported_from(_M))
356 -> throw_error(permission_error(create, plunit, Unit),
357 'Existing module')
358 ; true
359 ).
360
361:- else. 362
363:- dynamic
364 unit_module_store/2. 365
366unit_module(Unit, Module) :-
367 unit_module_store(Unit, Module),
368 !.
369
370make_unit_module(Unit, Module) :-
371 prolog_load_context(module, Module),
372 assert(unit_module_store(Unit, Module)).
373
374:- endif. 375
376
385expand_test(Name, Options0, Body,
386 [ 'unit test'(Name, Line, Options, Module:'unit body'(Id, Vars)),
387 ('unit body'(Id, Vars) :- !, Body)
388 ]) :-
389 source_location(_File, Line),
390 prolog_load_context(module, Module),
391 atomic_list_concat([Name, '@line ', Line], Id),
392 term_variables(Options0, OptionVars0), sort(OptionVars0, OptionVars),
393 term_variables(Body, BodyVars0), sort(BodyVars0, BodyVars),
394 ord_intersection(OptionVars, BodyVars, VarList),
395 Vars =.. [vars|VarList],
396 ( is_list(Options0) 397 -> Options1 = Options0
398 ; Options1 = [Options0]
399 ),
400 maplist(expand_option, Options1, Options2),
401 valid_options(Options2, test_option),
402 valid_test_mode(Options2, Options).
403
404expand_option(Var, _) :-
405 var(Var),
406 !,
407 throw_error(instantiation_error,_).
408expand_option(A == B, true(A==B)) :- !.
409expand_option(A = B, true(A=B)) :- !.
410expand_option(A =@= B, true(A=@=B)) :- !.
411expand_option(A =:= B, true(A=:=B)) :- !.
412expand_option(error(X), throws(error(X, _))) :- !.
413expand_option(exception(X), throws(X)) :- !. 414expand_option(error(F,C), throws(error(F,C))) :- !. 415expand_option(true, true(true)) :- !.
416expand_option(O, O).
417
418valid_test_mode(Options0, Options) :-
419 include(test_mode, Options0, Tests),
420 ( Tests == []
421 -> Options = [true(true)|Options0]
422 ; Tests = [_]
423 -> Options = Options0
424 ; throw_error(plunit(incompatible_options, Tests), _)
425 ).
426
427test_mode(true(_)).
428test_mode(all(_)).
429test_mode(set(_)).
430test_mode(fail).
431test_mode(throws(_)).
436expand(end_of_file, _) :-
437 loading_unit(Unit, _, _, _),
438 !,
439 end_tests(Unit), 440 fail.
441expand((:-end_tests(_)), _) :-
442 !,
443 fail.
444expand(_Term, []) :-
445 \+ loading_tests.
446expand((test(Name) :- Body), Clauses) :-
447 !,
448 expand_test(Name, [], Body, Clauses).
449expand((test(Name, Options) :- Body), Clauses) :-
450 !,
451 expand_test(Name, Options, Body, Clauses).
452expand(test(Name), _) :-
453 !,
454 throw_error(existence_error(body, test(Name)), _).
455expand(test(Name, _Options), _) :-
456 !,
457 throw_error(existence_error(body, test(Name)), _).
458
459:- if(swi). 460:- multifile
461 system:term_expansion/2. 462:- endif. 463
464system:term_expansion(Term, Expanded) :-
465 ( loading_unit(_, _, File, _)
466 -> source_location(File, _),
467 expand(Term, Expanded)
468 ).
469
470
471 474
475:- if(swi). 476:- else. 477must_be(list, X) :-
478 !,
479 ( is_list(X)
480 -> true
481 ; is_not(list, X)
482 ).
483must_be(Type, X) :-
484 ( call(Type, X)
485 -> true
486 ; is_not(Type, X)
487 ).
488
489is_not(Type, X) :-
490 ( ground(X)
491 -> throw_error(type_error(Type, X), _)
492 ; throw_error(instantiation_error, _)
493 ).
494:- endif.
503valid_options(Options, Pred) :-
504 must_be(list, Options),
505 verify_options(Options, Pred).
506
507verify_options([], _).
508verify_options([H|T], Pred) :-
509 ( call(Pred, H)
510 -> verify_options(T, Pred)
511 ; throw_error(domain_error(Pred, H), _)
512 ).
519test_option(Option) :-
520 test_set_option(Option),
521 !.
522test_option(true(_)).
523test_option(fail).
524test_option(throws(_)).
525test_option(all(_)).
526test_option(set(_)).
527test_option(nondet).
528test_option(fixme(_)).
529test_option(forall(X)) :-
530 must_be(callable, X).
537test_set_option(blocked(X)) :-
538 must_be(ground, X).
539test_set_option(condition(X)) :-
540 must_be(callable, X).
541test_set_option(setup(X)) :-
542 must_be(callable, X).
543test_set_option(cleanup(X)) :-
544 must_be(callable, X).
545test_set_option(sto(V)) :-
546 nonvar(V), member(V, [finite_trees, rational_trees]).
547
548
549 552
553:- thread_local
554 passed/5, 555 failed/4, 556 failed_assertion/7, 557 blocked/4, 558 sto/4, 559 fixme/5. 560
561:- dynamic
562 running/5.
575run_tests :-
576 cleanup,
577 setup_call_cleanup(
578 setup_trap_assertions(Ref),
579 run_current_units,
580 report_and_cleanup(Ref)).
581
582run_current_units :-
583 forall(current_test_set(Set),
584 run_unit(Set)),
585 check_for_test_errors.
586
587report_and_cleanup(Ref) :-
588 cleanup_trap_assertions(Ref),
589 report,
590 cleanup_after_test.
591
592run_tests(Set) :-
593 cleanup,
594 setup_call_cleanup(
595 setup_trap_assertions(Ref),
596 run_unit_and_check_errors(Set),
597 report_and_cleanup(Ref)).
598
599run_unit_and_check_errors(Set) :-
600 run_unit(Set),
601 check_for_test_errors.
602
603run_unit([]) :- !.
604run_unit([H|T]) :-
605 !,
606 run_unit(H),
607 run_unit(T).
608run_unit(Spec) :-
609 unit_from_spec(Spec, Unit, Tests, Module, UnitOptions),
610 ( option(blocked(Reason), UnitOptions)
611 -> info(plunit(blocked(unit(Unit, Reason))))
612 ; setup(Module, unit(Unit), UnitOptions)
613 -> info(plunit(begin(Spec))),
614 forall((Module:'unit test'(Name, Line, Options, Body),
615 matching_test(Name, Tests)),
616 run_test(Unit, Name, Line, Options, Body)),
617 info(plunit(end(Spec))),
618 ( message_level(silent)
619 -> true
620 ; format(user_error, '~N', [])
621 ),
622 cleanup(Module, UnitOptions)
623 ; true
624 ).
625
626unit_from_spec(Unit, Unit, _, Module, Options) :-
627 atom(Unit),
628 !,
629 ( current_unit(Unit, Module, _Supers, Options)
630 -> true
631 ; throw_error(existence_error(unit_test, Unit), _)
632 ).
633unit_from_spec(Unit:Tests, Unit, Tests, Module, Options) :-
634 atom(Unit),
635 !,
636 ( current_unit(Unit, Module, _Supers, Options)
637 -> true
638 ; throw_error(existence_error(unit_test, Unit), _)
639 ).
640
641
642matching_test(X, X) :- !.
643matching_test(Name, Set) :-
644 is_list(Set),
645 memberchk(Name, Set).
646
647cleanup :-
648 thread_self(Me),
649 retractall(passed(_, _, _, _, _)),
650 retractall(failed(_, _, _, _)),
651 retractall(failed_assertion(_, _, _, _, _, _, _)),
652 retractall(blocked(_, _, _, _)),
653 retractall(sto(_, _, _, _)),
654 retractall(fixme(_, _, _, _, _)),
655 retractall(running(_,_,_,_,Me)).
656
657cleanup_after_test :-
658 current_test_flag(test_options, Options),
659 option(cleanup(Cleanup), Options, false),
660 ( Cleanup == true
661 -> cleanup
662 ; true
663 ).
670run_tests_in_files(Files) :-
671 findall(Unit, unit_in_files(Files, Unit), Units),
672 ( Units == []
673 -> true
674 ; run_tests(Units)
675 ).
676
677unit_in_files(Files, Unit) :-
678 is_list(Files),
679 !,
680 member(F, Files),
681 absolute_file_name(F, Source,
682 [ file_type(prolog),
683 access(read),
684 file_errors(fail)
685 ]),
686 unit_file(Unit, Source).
687
688
689
697make_run_tests(Files) :-
698 current_test_flag(test_options, Options),
699 option(run(When), Options, manual),
700 ( When == make
701 -> run_tests_in_files(Files)
702 ; When == make(all)
703 -> run_tests
704 ; true
705 ).
706
707:- if(swi). 708
709unification_capability(sto_error_incomplete).
711unification_capability(rational_trees).
712unification_capability(finite_trees).
713
714set_unification_capability(Cap) :-
715 cap_to_flag(Cap, Flag),
716 set_prolog_flag(occurs_check, Flag).
717
718current_unification_capability(Cap) :-
719 current_prolog_flag(occurs_check, Flag),
720 cap_to_flag(Cap, Flag),
721 !.
722
723cap_to_flag(sto_error_incomplete, error).
724cap_to_flag(rational_trees, false).
725cap_to_flag(finite_trees, true).
726
727:- else. 728:- if(sicstus). 729
730unification_capability(rational_trees).
731set_unification_capability(rational_trees).
732current_unification_capability(rational_trees).
733
734:- else. 735
736unification_capability(_) :-
737 fail.
738
739:- endif. 740:- endif. 741
742 745
746:- if(swi). 747
748:- dynamic prolog:assertion_failed/2. 749
750setup_trap_assertions(Ref) :-
751 asserta((prolog:assertion_failed(Reason, Goal) :-
752 test_assertion_failed(Reason, Goal)),
753 Ref).
754
755cleanup_trap_assertions(Ref) :-
756 erase(Ref).
757
758test_assertion_failed(Reason, Goal) :-
759 thread_self(Me),
760 running(Unit, Test, Line, STO, Me),
761 ( catch(get_prolog_backtrace(10, Stack), _, fail),
762 assertion_location(Stack, AssertLoc)
763 -> true
764 ; AssertLoc = unknown
765 ),
766 current_test_flag(test_options, Options),
767 report_failed_assertion(Unit, Test, Line, AssertLoc,
768 STO, Reason, Goal, Options),
769 assert_cyclic(failed_assertion(Unit, Test, Line, AssertLoc,
770 STO, Reason, Goal)).
771
772assertion_location(Stack, File:Line) :-
773 append(_, [AssertFrame,CallerFrame|_], Stack),
774 prolog_stack_frame_property(AssertFrame,
775 predicate(prolog_debug:assertion/1)),
776 !,
777 prolog_stack_frame_property(CallerFrame, location(File:Line)).
778
779report_failed_assertion(Unit, Test, Line, AssertLoc,
780 STO, Reason, Goal, _Options) :-
781 print_message(
782 error,
783 plunit(failed_assertion(Unit, Test, Line, AssertLoc,
784 STO, Reason, Goal))).
785
786:- else. 787
788setup_trap_assertions(_).
789cleanup_trap_assertions(_).
790
791:- endif. 792
793
794
802run_test(Unit, Name, Line, Options, Body) :-
803 option(forall(Generator), Options),
804 !,
805 unit_module(Unit, Module),
806 term_variables(Generator, Vars),
807 forall(Module:Generator,
808 run_test_once(Unit, @(Name,Vars), Line, Options, Body)).
809run_test(Unit, Name, Line, Options, Body) :-
810 run_test_once(Unit, Name, Line, Options, Body).
811
812run_test_once(Unit, Name, Line, Options, Body) :-
813 current_test_flag(test_options, GlobalOptions),
814 option(sto(false), GlobalOptions, false),
815 !,
816 current_unification_capability(Type),
817 begin_test(Unit, Name, Line, Type),
818 run_test_6(Unit, Name, Line, Options, Body, Result),
819 end_test(Unit, Name, Line, Type),
820 report_result(Result, Options).
821run_test_once(Unit, Name, Line, Options, Body) :-
822 current_unit(Unit, _Module, _Supers, UnitOptions),
823 option(sto(Type), UnitOptions),
824 \+ option(sto(_), Options),
825 !,
826 current_unification_capability(Cap0),
827 call_cleanup(run_test_cap(Unit, Name, Line, [sto(Type)|Options], Body),
828 set_unification_capability(Cap0)).
829run_test_once(Unit, Name, Line, Options, Body) :-
830 current_unification_capability(Cap0),
831 call_cleanup(run_test_cap(Unit, Name, Line, Options, Body),
832 set_unification_capability(Cap0)).
833
834run_test_cap(Unit, Name, Line, Options, Body) :-
835 ( option(sto(Type), Options)
836 -> unification_capability(Type),
837 set_unification_capability(Type),
838 begin_test(Unit, Name, Line, Type),
839 run_test_6(Unit, Name, Line, Options, Body, Result),
840 end_test(Unit, Name, Line, Type),
841 report_result(Result, Options)
842 ; findall(Key-(Type+Result),
843 test_caps(Type, Unit, Name, Line, Options, Body, Result, Key),
844 Pairs),
845 group_pairs_by_key(Pairs, Keyed),
846 ( Keyed == []
847 -> true
848 ; Keyed = [_-Results]
849 -> Results = [_Type+Result|_],
850 report_result(Result, Options) 851 ; pairs_values(Pairs, ResultByType),
852 report_result(sto(Unit, Name, Line, ResultByType), Options)
853 )
854 ).
858test_caps(Type, Unit, Name, Line, Options, Body, Result, Key) :-
859 unification_capability(Type),
860 set_unification_capability(Type),
861 begin_test(Unit, Name, Line, Type),
862 run_test_6(Unit, Name, Line, Options, Body, Result),
863 end_test(Unit, Name, Line, Type),
864 result_to_key(Result, Key),
865 Key \== setup_failed.
866
867result_to_key(blocked(_, _, _, _), blocked).
868result_to_key(failure(_, _, _, How0), failure(How1)) :-
869 ( How0 = succeeded(_T) -> How1 = succeeded ; How0 = How1 ).
870result_to_key(success(_, _, _, Determinism, _), success(Determinism)).
871result_to_key(setup_failed(_,_,_), setup_failed).
872
873report_result(blocked(Unit, Name, Line, Reason), _) :-
874 !,
875 assert(blocked(Unit, Name, Line, Reason)).
876report_result(failure(Unit, Name, Line, How), Options) :-
877 !,
878 failure(Unit, Name, Line, How, Options).
879report_result(success(Unit, Name, Line, Determinism, Time), Options) :-
880 !,
881 success(Unit, Name, Line, Determinism, Time, Options).
882report_result(setup_failed(_Unit, _Name, _Line), _Options).
883report_result(sto(Unit, Name, Line, ResultByType), Options) :-
884 assert(sto(Unit, Name, Line, ResultByType)),
885 print_message(error, plunit(sto(Unit, Name, Line))),
886 report_sto_results(ResultByType, Options).
887
888report_sto_results([], _).
889report_sto_results([Type+Result|T], Options) :-
890 print_message(error, plunit(sto(Type, Result))),
891 report_sto_results(T, Options).
903run_test_6(Unit, Name, Line, Options, _Body,
904 blocked(Unit, Name, Line, Reason)) :-
905 option(blocked(Reason), Options),
906 !.
907run_test_6(Unit, Name, Line, Options, Body, Result) :-
908 option(all(Answer), Options), 909 !,
910 nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result).
911run_test_6(Unit, Name, Line, Options, Body, Result) :-
912 option(set(Answer), Options), 913 !,
914 nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result).
915run_test_6(Unit, Name, Line, Options, Body, Result) :-
916 option(fail, Options), 917 !,
918 unit_module(Unit, Module),
919 ( setup(Module, test(Unit,Name,Line), Options)
920 -> statistics(runtime, [T0,_]),
921 ( catch(Module:Body, E, true)
922 -> ( var(E)
923 -> statistics(runtime, [T1,_]),
924 Time is (T1 - T0)/1000.0,
925 Result = failure(Unit, Name, Line, succeeded(Time)),
926 cleanup(Module, Options)
927 ; Result = failure(Unit, Name, Line, E),
928 cleanup(Module, Options)
929 )
930 ; statistics(runtime, [T1,_]),
931 Time is (T1 - T0)/1000.0,
932 Result = success(Unit, Name, Line, true, Time),
933 cleanup(Module, Options)
934 )
935 ; Result = setup_failed(Unit, Name, Line)
936 ).
937run_test_6(Unit, Name, Line, Options, Body, Result) :-
938 option(true(Cmp), Options),
939 !,
940 unit_module(Unit, Module),
941 ( setup(Module, test(Unit,Name,Line), Options) 942 -> statistics(runtime, [T0,_]),
943 ( catch(call_det(Module:Body, Det), E, true)
944 -> ( var(E)
945 -> statistics(runtime, [T1,_]),
946 Time is (T1 - T0)/1000.0,
947 ( catch(Module:Cmp, E, true)
948 -> ( var(E)
949 -> Result = success(Unit, Name, Line, Det, Time)
950 ; Result = failure(Unit, Name, Line, cmp_error(Cmp, E))
951 )
952 ; Result = failure(Unit, Name, Line, wrong_answer(Cmp))
953 ),
954 cleanup(Module, Options)
955 ; Result = failure(Unit, Name, Line, E),
956 cleanup(Module, Options)
957 )
958 ; Result = failure(Unit, Name, Line, failed),
959 cleanup(Module, Options)
960 )
961 ; Result = setup_failed(Unit, Name, Line)
962 ).
963run_test_6(Unit, Name, Line, Options, Body, Result) :-
964 option(throws(Expect), Options),
965 !,
966 unit_module(Unit, Module),
967 ( setup(Module, test(Unit,Name,Line), Options)
968 -> statistics(runtime, [T0,_]),
969 ( catch(Module:Body, E, true)
970 -> ( var(E)
971 -> Result = failure(Unit, Name, Line, no_exception),
972 cleanup(Module, Options)
973 ; statistics(runtime, [T1,_]),
974 Time is (T1 - T0)/1000.0,
975 ( match_error(Expect, E)
976 -> Result = success(Unit, Name, Line, true, Time)
977 ; Result = failure(Unit, Name, Line, wrong_error(Expect, E))
978 ),
979 cleanup(Module, Options)
980 )
981 ; Result = failure(Unit, Name, Line, failed),
982 cleanup(Module, Options)
983 )
984 ; Result = setup_failed(Unit, Name, Line)
985 ).
992nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :-
993 unit_module(Unit, Module),
994 result_vars(Expected, Vars),
995 statistics(runtime, [T0,_]),
996 ( setup(Module, test(Unit,Name,Line), Options)
997 -> ( catch(findall(Vars, Module:Body, Bindings), E, true)
998 -> ( var(E)
999 -> statistics(runtime, [T1,_]),
1000 Time is (T1 - T0)/1000.0,
1001 ( nondet_compare(Expected, Bindings, Unit, Name, Line)
1002 -> Result = success(Unit, Name, Line, true, Time)
1003 ; Result = failure(Unit, Name, Line, wrong_answer(Expected, Bindings))
1004 ),
1005 cleanup(Module, Options)
1006 ; Result = failure(Unit, Name, Line, E),
1007 cleanup(Module, Options)
1008 )
1009 )
1010 ; Result = setup_failed(Unit, Name, Line)
1011 ).
1019result_vars(Expected, Vars) :-
1020 arg(1, Expected, CmpOp),
1021 arg(1, CmpOp, Vars).
1031nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :-
1032 cmp(Cmp, _Vars, Op, Values),
1033 cmp_list(Values, Bindings, Op).
1034nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :-
1035 cmp(Cmp, _Vars, Op, Values0),
1036 sort(Bindings0, Bindings),
1037 sort(Values0, Values),
1038 cmp_list(Values, Bindings, Op).
1039
1040cmp_list([], [], _Op).
1041cmp_list([E0|ET], [V0|VT], Op) :-
1042 call(Op, E0, V0),
1043 cmp_list(ET, VT, Op).
1047cmp(Var == Value, Var, ==, Value).
1048cmp(Var =:= Value, Var, =:=, Value).
1049cmp(Var = Value, Var, =, Value).
1050:- if(swi). 1051cmp(Var =@= Value, Var, =@=, Value).
1052:- else. 1053:- if(sicstus). 1054cmp(Var =@= Value, Var, variant, Value). 1055:- endif. 1056:- endif.
1064:- if((swi|sicstus)). 1065call_det(Goal, Det) :-
1066 call_cleanup(Goal,Det0=true),
1067 ( var(Det0) -> Det = false ; Det = true ).
1068:- else. 1069call_det(Goal, true) :-
1070 call(Goal).
1071:- endif.
1078match_error(Expect, Rec) :-
1079 subsumes_term(Expect, Rec).
1092setup(Module, Context, Options) :-
1093 option(condition(Condition), Options),
1094 option(setup(Setup), Options),
1095 !,
1096 setup(Module, Context, [condition(Condition)]),
1097 setup(Module, Context, [setup(Setup)]).
1098setup(Module, Context, Options) :-
1099 option(setup(Setup), Options),
1100 !,
1101 ( catch(call_ex(Module, Setup), E, true)
1102 -> ( var(E)
1103 -> true
1104 ; print_message(error, plunit(error(setup, Context, E))),
1105 fail
1106 )
1107 ; print_message(error, error(goal_failed(Setup), _)),
1108 fail
1109 ).
1110setup(Module, Context, Options) :-
1111 option(condition(Setup), Options),
1112 !,
1113 ( catch(call_ex(Module, Setup), E, true)
1114 -> ( var(E)
1115 -> true
1116 ; print_message(error, plunit(error(condition, Context, E))),
1117 fail
1118 )
1119 ; fail
1120 ).
1121setup(_,_,_).
1127call_ex(Module, Goal) :-
1128 Module:(expand_goal(Goal, GoalEx),
1129 GoalEx).
1136cleanup(Module, Options) :-
1137 option(cleanup(Cleanup), Options, true),
1138 ( catch(call_ex(Module, Cleanup), E, true)
1139 -> ( var(E)
1140 -> true
1141 ; print_message(warning, E)
1142 )
1143 ; print_message(warning, goal_failed(Cleanup, '(cleanup handler)'))
1144 ).
1145
1146success(Unit, Name, Line, Det, _Time, Options) :-
1147 memberchk(fixme(Reason), Options),
1148 !,
1149 ( ( Det == true
1150 ; memberchk(nondet, Options)
1151 )
1152 -> put_char(user_error, +),
1153 Ok = passed
1154 ; put_char(user_error, !),
1155 Ok = nondet
1156 ),
1157 flush_output(user_error),
1158 assert(fixme(Unit, Name, Line, Reason, Ok)).
1159success(Unit, Name, Line, _, _, Options) :-
1160 failed_assertion(Unit, Name, Line, _,_,_,_),
1161 !,
1162 failure(Unit, Name, Line, assertion, Options).
1163success(Unit, Name, Line, Det, Time, Options) :-
1164 assert(passed(Unit, Name, Line, Det, Time)),
1165 ( ( Det == true
1166 ; memberchk(nondet, Options)
1167 )
1168 -> put_char(user_error, .)
1169 ; unit_file(Unit, File),
1170 print_message(warning, plunit(nondet(File, Line, Name)))
1171 ),
1172 flush_output(user_error).
1173
1174failure(Unit, Name, Line, _, Options) :-
1175 memberchk(fixme(Reason), Options),
1176 !,
1177 put_char(user_error, -),
1178 flush_output(user_error),
1179 assert(fixme(Unit, Name, Line, Reason, failed)).
1180failure(Unit, Name, Line, E, Options) :-
1181 report_failure(Unit, Name, Line, E, Options),
1182 assert_cyclic(failed(Unit, Name, Line, E)).
1192:- if(swi). 1193assert_cyclic(Term) :-
1194 acyclic_term(Term),
1195 !,
1196 assert(Term).
1197assert_cyclic(Term) :-
1198 Term =.. [Functor|Args],
1199 recorda(cyclic, Args, Id),
1200 functor(Term, _, Arity),
1201 length(NewArgs, Arity),
1202 Head =.. [Functor|NewArgs],
1203 assert((Head :- recorded(_, Var, Id), Var = NewArgs)).
1204:- else. 1205:- if(sicstus). 1206:- endif. 1207assert_cyclic(Term) :-
1208 assert(Term).
1209:- endif. 1210
1211
1212
1227begin_test(Unit, Test, Line, STO) :-
1228 thread_self(Me),
1229 assert(running(Unit, Test, Line, STO, Me)),
1230 unit_file(Unit, File),
1231 print_message(silent, plunit(begin(Unit:Test, File:Line, STO))).
1232
1233end_test(Unit, Test, Line, STO) :-
1234 thread_self(Me),
1235 retractall(running(_,_,_,_,Me)),
1236 unit_file(Unit, File),
1237 print_message(silent, plunit(end(Unit:Test, File:Line, STO))).
1243running_tests :-
1244 running_tests(Running),
1245 print_message(informational, plunit(running(Running))).
1246
1247running_tests(Running) :-
1248 findall(running(Unit:Test, File:Line, STO, Thread),
1249 ( running(Unit, Test, Line, STO, Thread),
1250 unit_file(Unit, File)
1251 ), Running).
1258current_test(Unit, Test, Line, Body, Options) :-
1259 current_unit(Unit, Module, _Supers, _UnitOptions),
1260 Module:'unit test'(Test, Line, Options, Body).
1266check_for_test_errors :-
1267 number_of_clauses(failed/4, Failed),
1268 number_of_clauses(failed_assertion/7, FailedAssertion),
1269 number_of_clauses(sto/4, STO),
1270 Failed+FailedAssertion+STO =:= 0.
1277report :-
1278 number_of_clauses(passed/5, Passed),
1279 number_of_clauses(failed/4, Failed),
1280 number_of_clauses(failed_assertion/7, FailedAssertion),
1281 number_of_clauses(blocked/4, Blocked),
1282 number_of_clauses(sto/4, STO),
1283 ( Passed+Failed+FailedAssertion+Blocked+STO =:= 0
1284 -> info(plunit(no_tests))
1285 ; Failed+FailedAssertion+Blocked+STO =:= 0
1286 -> report_fixme,
1287 info(plunit(all_passed(Passed)))
1288 ; report_blocked,
1289 report_fixme,
1290 report_failed_assertions,
1291 report_failed,
1292 report_sto,
1293 info(plunit(passed(Passed)))
1294 ).
1295
1296number_of_clauses(F/A,N) :-
1297 ( current_predicate(F/A)
1298 -> functor(G,F,A),
1299 findall(t, G, Ts),
1300 length(Ts, N)
1301 ; N = 0
1302 ).
1303
1304report_blocked :-
1305 number_of_clauses(blocked/4,N),
1306 N > 0,
1307 !,
1308 info(plunit(blocked(N))),
1309 ( blocked(Unit, Name, Line, Reason),
1310 unit_file(Unit, File),
1311 print_message(informational,
1312 plunit(blocked(File:Line, Name, Reason))),
1313 fail ; true
1314 ).
1315report_blocked.
1316
1317report_failed :-
1318 number_of_clauses(failed/4, N),
1319 info(plunit(failed(N))).
1320
1321report_failed_assertions :-
1322 number_of_clauses(failed_assertion/7, N),
1323 info(plunit(failed_assertions(N))).
1324
1325report_sto :-
1326 number_of_clauses(sto/4, N),
1327 info(plunit(sto(N))).
1328
1329report_fixme :-
1330 report_fixme(_,_,_).
1331
1332report_fixme(TuplesF, TuplesP, TuplesN) :-
1333 fixme(failed, TuplesF, Failed),
1334 fixme(passed, TuplesP, Passed),
1335 fixme(nondet, TuplesN, Nondet),
1336 print_message(informational, plunit(fixme(Failed, Passed, Nondet))).
1337
1338
1339fixme(How, Tuples, Count) :-
1340 findall(fixme(Unit, Name, Line, Reason, How),
1341 fixme(Unit, Name, Line, Reason, How), Tuples),
1342 length(Tuples, Count).
1343
1344
1345report_failure(_, _, _, assertion, _) :-
1346 !,
1347 put_char(user_error, 'A').
1348report_failure(Unit, Name, Line, Error, _Options) :-
1349 print_message(error, plunit(failed(Unit, Name, Line, Error))).
1356test_report(fixme) :-
1357 !,
1358 report_fixme(TuplesF, TuplesP, TuplesN),
1359 append([TuplesF, TuplesP, TuplesN], Tuples),
1360 print_message(informational, plunit(fixme(Tuples))).
1361test_report(What) :-
1362 throw_error(domain_error(report_class, What), _).
1363
1364
1365
1373current_test_set(Unit) :-
1374 current_unit(Unit, _Module, _Context, _Options).
1379unit_file(Unit, File) :-
1380 current_unit(Unit, Module, _Context, _Options),
1381 current_module(Module, File).
1382unit_file(Unit, PlFile) :-
1383 nonvar(PlFile),
1384 test_file_for(TestFile, PlFile),
1385 current_module(Module, TestFile),
1386 current_unit(Unit, Module, _Context, _Options).
1387
1388
1389
1397load_test_files(_Options) :-
1398 ( source_file(File),
1399 file_name_extension(Base, Old, File),
1400 Old \== plt,
1401 file_name_extension(Base, plt, TestFile),
1402 exists_file(TestFile),
1403 ( test_file_for(TestFile, File)
1404 -> true
1405 ; load_files(TestFile,
1406 [ if(changed),
1407 imports([])
1408 ]),
1409 asserta(test_file_for(TestFile, File))
1410 ),
1411 fail ; true
1412 ).
1413
1414
1415
1416
1425info(Term) :-
1426 message_level(Level),
1427 print_message(Level, Term).
1428
1429message_level(Level) :-
1430 current_test_flag(test_options, Options),
1431 option(silent(Silent), Options, false),
1432 ( Silent == false
1433 -> Level = informational
1434 ; Level = silent
1435 ).
1436
1437locationprefix(File:Line) -->
1438 !,
1439 [ '~w:~d:\n\t'-[File,Line]].
1440locationprefix(test(Unit,_Test,Line)) -->
1441 !,
1442 { unit_file(Unit, File) },
1443 locationprefix(File:Line).
1444locationprefix(unit(Unit)) -->
1445 !,
1446 [ 'PL-Unit: unit ~w: '-[Unit] ].
1447locationprefix(FileLine) -->
1448 { throw_error(type_error(locationprefix,FileLine), _) }.
1449
1450:- discontiguous
1451 message//1. 1452
1453message(error(context_error(plunit_close(Name, -)), _)) -->
1454 [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ].
1455message(error(context_error(plunit_close(Name, Start)), _)) -->
1456 [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ].
1457message(plunit(nondet(File, Line, Name))) -->
1458 locationprefix(File:Line),
1459 [ 'PL-Unit: Test ~w: Test succeeded with choicepoint'- [Name] ].
1460message(error(plunit(incompatible_options, Tests), _)) -->
1461 [ 'PL-Unit: incompatible test-options: ~p'-[Tests] ].
1462
1463 1464:- if(swi). 1465message(plunit(begin(Unit))) -->
1466 [ 'PL-Unit: ~w '-[Unit], flush ].
1467message(plunit(end(_Unit))) -->
1468 [ at_same_line, ' done' ].
1469:- else. 1470message(plunit(begin(Unit))) -->
1471 [ 'PL-Unit: ~w '-[Unit]].
1472message(plunit(end(_Unit))) -->
1473 [ ' done'-[] ].
1474:- endif. 1475message(plunit(blocked(unit(Unit, Reason)))) -->
1476 [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ].
1477message(plunit(running([]))) -->
1478 !,
1479 [ 'PL-Unit: no tests running' ].
1480message(plunit(running([One]))) -->
1481 !,
1482 [ 'PL-Unit: running ' ],
1483 running(One).
1484message(plunit(running(More))) -->
1485 !,
1486 [ 'PL-Unit: running tests:', nl ],
1487 running(More).
1488message(plunit(fixme([]))) --> !.
1489message(plunit(fixme(Tuples))) -->
1490 !,
1491 fixme_message(Tuples).
1492
1493 1494message(plunit(blocked(1))) -->
1495 !,
1496 [ 'one test is blocked:'-[] ].
1497message(plunit(blocked(N))) -->
1498 [ '~D tests are blocked:'-[N] ].
1499message(plunit(blocked(Pos, Name, Reason))) -->
1500 locationprefix(Pos),
1501 test_name(Name),
1502 [ ': ~w'-[Reason] ].
1503
1504 1505message(plunit(no_tests)) -->
1506 !,
1507 [ 'No tests to run' ].
1508message(plunit(all_passed(1))) -->
1509 !,
1510 [ 'test passed' ].
1511message(plunit(all_passed(Count))) -->
1512 !,
1513 [ 'All ~D tests passed'-[Count] ].
1514message(plunit(passed(Count))) -->
1515 !,
1516 [ '~D tests passed'-[Count] ].
1517message(plunit(failed(0))) -->
1518 !,
1519 [].
1520message(plunit(failed(1))) -->
1521 !,
1522 [ '1 test failed'-[] ].
1523message(plunit(failed(N))) -->
1524 [ '~D tests failed'-[N] ].
1525message(plunit(failed_assertions(0))) -->
1526 !,
1527 [].
1528message(plunit(failed_assertions(1))) -->
1529 !,
1530 [ '1 assertion failed'-[] ].
1531message(plunit(failed_assertions(N))) -->
1532 [ '~D assertions failed'-[N] ].
1533message(plunit(sto(0))) -->
1534 !,
1535 [].
1536message(plunit(sto(N))) -->
1537 [ '~D test results depend on unification mode'-[N] ].
1538message(plunit(fixme(0,0,0))) -->
1539 [].
1540message(plunit(fixme(Failed,0,0))) -->
1541 !,
1542 [ 'all ~D tests flagged FIXME failed'-[Failed] ].
1543message(plunit(fixme(Failed,Passed,0))) -->
1544 [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ].
1545message(plunit(fixme(Failed,Passed,Nondet))) -->
1546 { TotalPassed is Passed+Nondet },
1547 [ 'FIXME: ~D failed; ~D passed; (~D nondet)'-
1548 [Failed, TotalPassed, Nondet] ].
1549message(plunit(failed(Unit, Name, Line, Failure))) -->
1550 { unit_file(Unit, File) },
1551 locationprefix(File:Line),
1552 test_name(Name),
1553 [': '-[] ],
1554 failure(Failure).
1555:- if(swi). 1556message(plunit(failed_assertion(Unit, Name, Line, AssertLoc,
1557 _STO, Reason, Goal))) -->
1558 { unit_file(Unit, File) },
1559 locationprefix(File:Line),
1560 test_name(Name),
1561 [ ': assertion'-[] ],
1562 assertion_location(AssertLoc, File),
1563 assertion_reason(Reason), ['\n\t'],
1564 assertion_goal(Unit, Goal).
1565
1566assertion_location(File:Line, File) -->
1567 [ ' at line ~w'-[Line] ].
1568assertion_location(File:Line, _) -->
1569 [ ' at ~w:~w'-[File, Line] ].
1570assertion_location(unknown, _) -->
1571 [].
1572
1573assertion_reason(fail) -->
1574 !,
1575 [ ' failed'-[] ].
1576assertion_reason(Error) -->
1577 { message_to_string(Error, String) },
1578 [ ' raised "~w"'-[String] ].
1579
1580assertion_goal(Unit, Goal) -->
1581 { unit_module(Unit, Module),
1582 unqualify(Goal, Module, Plain)
1583 },
1584 [ 'Assertion: ~p'-[Plain] ].
1585
1586unqualify(Var, _, Var) :-
1587 var(Var),
1588 !.
1589unqualify(M:Goal, Unit, Goal) :-
1590 nonvar(M),
1591 unit_module(Unit, M),
1592 !.
1593unqualify(M:Goal, _, Goal) :-
1594 callable(Goal),
1595 predicate_property(M:Goal, imported_from(system)),
1596 !.
1597unqualify(Goal, _, Goal).
1598
1599:- endif. 1600 1601message(plunit(error(Where, Context, Exception))) -->
1602 locationprefix(Context),
1603 { message_to_string(Exception, String) },
1604 [ 'error in ~w: ~w'-[Where, String] ].
1605
1606 1607message(plunit(sto(Unit, Name, Line))) -->
1608 { unit_file(Unit, File) },
1609 locationprefix(File:Line),
1610 test_name(Name),
1611 [' is subject to occurs check (STO): '-[] ].
1612message(plunit(sto(Type, Result))) -->
1613 sto_type(Type),
1614 sto_result(Result).
1615
1616 1617:- if(swi). 1618message(interrupt(begin)) -->
1619 { thread_self(Me),
1620 running(Unit, Test, Line, STO, Me),
1621 !,
1622 unit_file(Unit, File)
1623 },
1624 [ 'Interrupted test '-[] ],
1625 running(running(Unit:Test, File:Line, STO, Me)),
1626 [nl],
1627 '$messages':prolog_message(interrupt(begin)).
1628message(interrupt(begin)) -->
1629 '$messages':prolog_message(interrupt(begin)).
1630:- endif. 1631
1632test_name(@(Name,Bindings)) -->
1633 !,
1634 [ 'test ~w (forall bindings = ~p)'-[Name, Bindings] ].
1635test_name(Name) -->
1636 !,
1637 [ 'test ~w'-[Name] ].
1638
1639sto_type(sto_error_incomplete) -->
1640 [ 'Finite trees (error checking): ' ].
1641sto_type(rational_trees) -->
1642 [ 'Rational trees: ' ].
1643sto_type(finite_trees) -->
1644 [ 'Finite trees: ' ].
1645
1646sto_result(success(_Unit, _Name, _Line, Det, Time)) -->
1647 det(Det),
1648 [ ' success in ~2f seconds'-[Time] ].
1649sto_result(failure(_Unit, _Name, _Line, How)) -->
1650 failure(How).
1651
1652det(true) -->
1653 [ 'deterministic' ].
1654det(false) -->
1655 [ 'non-deterministic' ].
1656
1657running(running(Unit:Test, File:Line, STO, Thread)) -->
1658 thread(Thread),
1659 [ '~q:~q at ~w:~d'-[Unit, Test, File, Line] ],
1660 current_sto(STO).
1661running([H|T]) -->
1662 ['\t'], running(H),
1663 ( {T == []}
1664 -> []
1665 ; [nl], running(T)
1666 ).
1667
1668thread(main) --> !.
1669thread(Other) -->
1670 [' [~w] '-[Other] ].
1671
1672current_sto(sto_error_incomplete) -->
1673 [ ' (STO: error checking)' ].
1674current_sto(rational_trees) -->
1675 [].
1676current_sto(finite_trees) -->
1677 [ ' (STO: occurs check enabled)' ].
1678
1679:- if(swi). 1680write_term(T, OPS) -->
1681 ['~@'-[write_term(T,OPS)]].
1682:- else. 1683write_term(T, _OPS) -->
1684 ['~q'-[T]].
1685:- endif. 1686
1687expected_got_ops_(Ex, E, OPS, Goals) -->
1688 [' Expected: '-[]], write_term(Ex, OPS), [nl],
1689 [' Got: '-[]], write_term(E, OPS), [nl],
1690 ( { Goals = [] } -> []
1691 ; [' with: '-[]], write_term(Goals, OPS), [nl]
1692 ).
1693
1694
1695failure(Var) -->
1696 { var(Var) },
1697 !,
1698 [ 'Unknown failure?' ].
1699failure(succeeded(Time)) -->
1700 !,
1701 [ 'must fail but succeeded in ~2f seconds~n'-[Time] ].
1702failure(wrong_error(Expected, Error)) -->
1703 !,
1704 { copy_term(Expected-Error, Ex-E, Goals),
1705 numbervars(Ex-E-Goals, 0, _),
1706 write_options(OPS)
1707 },
1708 [ 'wrong error'-[], nl ],
1709 expected_got_ops_(Ex, E, OPS, Goals).
1710failure(wrong_answer(Cmp)) -->
1711 { Cmp =.. [Op,Answer,Expected],
1712 !,
1713 copy_term(Expected-Answer, Ex-A, Goals),
1714 numbervars(Ex-A-Goals, 0, _),
1715 write_options(OPS)
1716 },
1717 [ 'wrong answer (compared using ~w)'-[Op], nl ],
1718 expected_got_ops_(Ex, A, OPS, Goals).
1719failure(wrong_answer(CmpExpected, Bindings)) -->
1720 { ( CmpExpected = all(Cmp)
1721 -> Cmp =.. [_Op1,_,Expected],
1722 Got = Bindings,
1723 Type = all
1724 ; CmpExpected = set(Cmp),
1725 Cmp =.. [_Op2,_,Expected0],
1726 sort(Expected0, Expected),
1727 sort(Bindings, Got),
1728 Type = set
1729 )
1730 },
1731 [ 'wrong "~w" answer:'-[Type] ],
1732 [ nl, ' Expected: ~q'-[Expected] ],
1733 [ nl, ' Found: ~q'-[Got] ].
1734:- if(swi). 1735failure(cmp_error(_Cmp, Error)) -->
1736 { message_to_string(Error, Message) },
1737 [ 'Comparison error: ~w'-[Message] ].
1738failure(Error) -->
1739 { Error = error(_,_),
1740 !,
1741 message_to_string(Error, Message)
1742 },
1743 [ 'received error: ~w'-[Message] ].
1744:- endif. 1745failure(Why) -->
1746 [ '~p~n'-[Why] ].
1747
1748fixme_message([]) --> [].
1749fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) -->
1750 { unit_file(Unit, File) },
1751 fixme_message(File:Line, Reason, How),
1752 ( {T == []}
1753 -> []
1754 ; [nl],
1755 fixme_message(T)
1756 ).
1757
1758fixme_message(Location, Reason, failed) -->
1759 [ 'FIXME: ~w: ~w'-[Location, Reason] ].
1760fixme_message(Location, Reason, passed) -->
1761 [ 'FIXME: ~w: passed ~w'-[Location, Reason] ].
1762fixme_message(Location, Reason, nondet) -->
1763 [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ].
1764
1765
1766write_options([ numbervars(true),
1767 quoted(true),
1768 portray(true),
1769 max_depth(100),
1770 attributes(portray)
1771 ]).
1772
1773:- if(swi). 1774
1775:- multifile
1776 prolog:message/3,
1777 user:message_hook/3. 1778
1779prolog:message(Term) -->
1780 message(Term).
1781
1783
1784user:message_hook(make(done(Files)), _, _) :-
1785 make_run_tests(Files),
1786 fail. 1787
1788:- endif. 1789
1790:- if(sicstus). 1791
1792user:generate_message_hook(Message) -->
1793 message(Message),
1794 [nl].
1803user:message_hook(informational, plunit(begin(Unit)), _Lines) :-
1804 format(user_error, '% PL-Unit: ~w ', [Unit]),
1805 flush_output(user_error).
1806user:message_hook(informational, plunit(end(_Unit)), _Lines) :-
1807 format(user, ' done~n', []).
1808
1809:- endif.
Unit Testing
Unit testing environment for SWI-Prolog and SICStus Prolog. For usage, please visit http://www.swi-prolog.org/pldoc/package/plunit. */