root/tags/lgt2310/library/lgtunit.lgt

Revision 3825, 3.9 KB (checked in by pmoura, 17 months ago)

Corrected a bug in the library object "lgtunit" (wrong arity on two failed_test/2 predicate calls).

  • Property svn:eol-style set to native
Line 
1
2:- object(lgtunit).
3
4    :- info([
5        version is 0.2,
6        author is 'Paulo Moura',
7        date is 2007/08/27,
8        comment is 'Logtalk unit test framework.']).
9
10    :- public(succeeds/2).
11    :- mode(succeeds(+atom, @callable), zero_or_more).
12    :- info(succeeds/2, [
13        comment is 'Defines a test goal which is expected to succeed.',
14        argnames is ['Test', 'Goal']]).
15
16    :- public(fails/2).
17    :- mode(fails(+atom, @callable), zero_or_more).
18    :- info(fails/2, [
19        comment is 'Defines a test goal which is expected to fail.',
20        argnames is ['Test', 'Goal']]).
21
22    :- public(throws/3).
23    :- mode(throws(+atom, @callable, @nonvar), zero_or_more).
24    :- info(throws/3, [
25        comment is 'Defines a test goal which is expected to throw an error.',
26        argnames is ['Test', 'Goal', 'Error']]).
27
28    :- public(run/2).
29    :- mode(run(+atom, +atom), zero_or_one).
30    :- info(run/2, [
31        comment is 'Runs the unit tests, writing the results to the specified file. Mode can be either "write" (to create a new file) or "append" (to add results to an existing file).',
32        argnames is ['File', 'Mode']]).
33
34    :- public(run/0).
35    :- mode(run, zero_or_one).
36    :- info(run/0, [
37        comment is 'Runs the unit tests, writing the results to the current output stream.']).
38
39    :- protected(setup/0).
40    :- mode(setup, zero_or_one).
41    :- info(setup/0, [
42        comment is 'Setup environment before running the test. Defaults to the goal true.']).
43
44    :- protected(test/0).
45    :- mode(test, zero_or_one).
46    :- info(test/0, [
47        comment is 'Executes the tests. By default, starts with the "succeeds" tests, followed by the "fails" tests, and than the "throws" tests.']).
48
49    :- protected(cleanup/0).
50    :- mode(cleanup, zero_or_one).
51    :- info(cleanup/0, [
52        comment is 'Cleanup environment after running the test. Defaults to the goal true.']).
53
54    % by default, no test setup is needed:
55    setup.
56
57    % by default, run all "succeeds", "fails", and "throws" tests:
58    test :-
59        test_succeeds,
60        test_fails,
61        test_throws.
62
63    test_succeeds :-
64        forall(::succeeds(Test, Goal), test_succeeds(Test, Goal)).
65
66    test_succeeds(Test, Goal) :-
67        (   catch({Goal}, _, fail) ->
68            passed_test(Test, Goal)
69        ;   failed_test(Test, Goal)
70        ).
71
72    test_fails :-
73        forall(::fails(Test, Goal), test_fail(Test, Goal)).
74
75    test_fail(Test, Goal) :-
76        (   catch(\+ {Goal}, _, fail) ->
77            passed_test(Test, Goal)
78        ;   failed_test(Test, Goal)
79        ).
80
81    test_throws :-
82        forall(::throws(Test, Goal, Error), test_throws(Test, Goal, Error)).
83
84    test_throws(Test, Goal, Error) :-
85        (   catch({Goal}, Ball, ((Ball = Error -> passed_test(Test, Goal); failed_test(Test, Goal)), Flag = error)) ->
86            (   var(Flag) ->
87                failed_test(Test, Goal)
88            ;   true
89            )
90        ;   failed_test(Test, Goal)
91        ).
92
93    passed_test(Test, _Goal) :-
94        self(Self),
95        write('= passed test '), writeq(Test), write(' in object '), writeq(Self), nl.
96
97    failed_test(Test, _Goal) :-
98        self(Self),
99        write('= failed test '), writeq(Test), write(' in object '), writeq(Self), nl.
100
101    % by default, no test cleanup is needed:
102    cleanup.
103
104    run(File, Mode) :-
105        open(File, Mode, Stream),
106        current_output(Output),
107        set_output(Stream),
108        ::run,
109        set_output(Output),
110        close(Stream).
111
112    run :-
113        self(Self),
114        write('% running tests from object '), writeq(Self), nl,
115        (   catch(::setup, Error, (broken(setup, Error), fail)) ->
116            (   catch(::test, Error, (broken(test, Error), Flag = error)) ->
117                do_cleanup,
118                (   var(Flag) ->
119                    write('% completed tests from object '), writeq(Self), nl
120                ;   write('% test run failed'), nl
121                )
122            ;   do_cleanup,
123                write('! test run failed for object '), writeq(Self), nl,
124                write('% test run failed'), nl
125            )
126        ;   write('! test setup failed for object '), writeq(Self), nl
127        ).
128
129    do_cleanup :-
130        self(Self),
131        (   catch(::cleanup, Error, (broken(cleanup, Error), fail)) ->
132            true
133        ;   write('! test cleanup failed for object '), writeq(Self), nl
134        ).
135
136    broken(Step, Error) :-
137        self(Self),
138        write('! broken '), write(Step), write(' for object '), writeq(Self), write(': '), write(Error), nl.
139
140:- end_object.
Note: See TracBrowser for help on using the browser.