1:- module(tap_raw, [ tap_call/1
2 , tap_call/3
3 , tap_header/1
4 , tap_footer/3
5 , tap_state/1
6 , diag/2
7 , is_test_running/0
8 , term_wants_tap_expansion/0
9 , register_test/1
10 ]).
16tap_header(TestCount) :-
17 format('TAP version 13~n'),
18 format('1..~d~n', [TestCount]).
25tap_footer(TestCount, state(_,_,Time0), state(_,PassedCount1,Time1)) :-
26 format('~n'),
27 Duration is (Time1-Time0)*1000,
28 format('# time=~1fms~n', [Duration]),
29 format('# tests ~d~n', [TestCount]),
30 format('# pass ~d~n', [PassedCount1]),
31 ( PassedCount1 < TestCount ->
32 FailedCount is TestCount-PassedCount1,
33 format('# fail ~d~n', [FailedCount])
34 ; % otherwise ->
35 true
36 ).
See tap_state/1 and tap_call/1
46tap_call(Head, State0, State) :- 47 Head =.. [_|Options0], 48 test_expectation(Options0, Expectation, _Options), 49 setup_call_cleanup( 50 assertz(is_test_running,Ref), 51 run_test(Expectation, Head, State0, State), 52 erase(Ref) 53 ). 54 55% Call Goal and bind Ending to explain how it turned out. 56% The predicate always succeeds. 57% `Ending=fail` if Goal failed. 58% `Ending=det` if Goal succeeded without choicepoints. 59% `Ending=choicepoints` if Goal succeeded and left choicepoints. 60% `Ending=exception(E)` if threw an exception. 61call_ending(Goal, Ending) :- 62 catch( call_cleanup(Goal,Cleanup=det) 63 , Exception 64 , Cleanup=exception(Exception) 65 ), 66 ( var(Cleanup) -> Ending=choicepoints ; Ending=Cleanup ), 67 68 % cut any choicepoints left by Goal, after checking Cleanup. 69 % also cut second clause of call_ending/2 70 !. 71call_ending(_, fail).
79tap_call(Head) :-
80 tap_state(State),
81 tap_call(Head, State, _).
88tap_state(state(1,0,Time)) :- 89 get_time(Time). 90 91% Run a single test, generating TAP output based on results 92% and expectations. 93run_test(ok, Test, State0, State) :- 94 call_ending(Test, Ending), 95 ( Ending = det -> 96 test_result(ok, Test, State0, State) 97 ; Ending = choicepoints -> 98 test_result('not ok', Test, 'left unexpected choice points', State0, State) 99 ; % otherwise -> 100 test_result('not ok', Test, Ending, State0, State) 101 ). 102run_test(fail, Test, State0, State) :- 103 call_ending(Test, Ending), 104 ( Ending = fail -> 105 test_result(ok, Test, State0, State) 106 ; % otherwise -> 107 test_result('not ok', Test, State0, State) 108 ). 109run_test(todo(Reason), Test, State0, State) :- 110 format(atom(Todo), 'TODO ~w', [Reason]), 111 call_ending(Test, Ending), 112 ( Ending=det -> 113 test_result(ok, Test, Todo, State0, State) 114 ; % otherwise -> 115 test_result('not ok', Test, Todo, State0, State) 116 ). 117run_test(throws(E), Test, State0, State) :- 118 call_ending(Test,Ending), 119 ( Ending = exception(E) -> 120 test_result(ok, Test, State0, State) 121 ; % otherwise -> 122 test_result('not ok', Test, State0, State) 123 ). 124 125% Helper for generating a single TAP result line 126test_result(Status,Test,State0,State) :- 127 test_result(Status,Test,_,State0,State). 128test_result(Status, Test, Comment, State0, State) :- 129 State0 = state(Count0,Passed0,_Time0), 130 succ(Count0,Count), 131 State = state(Count,Passed,Time), 132 get_time(Time), 133 ( Status = ok -> 134 succ(Passed0, Passed) 135 ; % otherwise -> 136 Passed0 = Passed 137 ), 138 Test =.. [Name|_Options], 139 ( var(Comment) -> 140 format('~w ~w - ~w~n', [Status, Count0, Name]) 141 ; % otherwise -> 142 format('~w ~w - ~w # ~w~n', [Status, Count0, Name, Comment]) 143 ). 144 145% Determine the expected result based on a test predicate's arguments 146test_expectation([], ok, []). 147test_expectation([fail|Options], fail, Options) :- !. 148test_expectation([todo|Options], todo(''), Options) :- !. 149test_expectation([todo(Reason)|Options], todo(Reason), Options) :- !. 150test_expectation([fixme(Reason)|Options], todo(Reason), Options) :- !. 151test_expectation([throws(E)|Options], throws(E), Options) :- !. 152test_expectation([error(E)|Options], throws(E), Options) :- !. 153test_expectation([_|Options], Type) :- 154 test_expectation(Options, Type). 155 156 157% True if the current context implies that the user wants this 158% term to be expanded as a test predicate. 159term_wants_tap_expansion :- 160 prolog_load_context(module, user).
167:- dynamic is_test_running/0.
176diag(Format,Args) :- 177 is_test_running, 178 !, 179 with_output_to(user_error, ( 180 write('# '), 181 format(Format,Args), 182 nl 183 )). 184diag(_,_). 185 186 187register_test(Head) :- 188 tap:assertz(test_case(Head))