:- ensure_loaded(common).
cvs_id('$Id: qtest.pl,v 1.3 2006/03/28 19:42:27 sandro Exp $').
/*

   A testing framework, suitable for both unit testing and regression
   testing.

   This obsoletes unit_test.pl, but I may not cut out unit_test.pl for
   a while; it's fine for what it does.  This is needed for more complex
   feature testing, like UI testing.

   Each test is a clause of the prolog qtest/0 or qtest/1 rule.  The
   argument is ignored by this module, but must be unique; it will
   typically contain a test identifier, documentation, and features for
   which the test may be filtered.  For the truly lazy, qtest/0 is
   rewritten at prolog-load time (by code in qtest_header.pl) into qtest/1
   with an argument anon(G) (where G is gensym'd.

   Examples:

      % simplest form
      qtest :-
         % see if /etc/passwd is writtable
         open('/etc/passwd', append, Stream),
         close(Stream).

      % with a simple atomic name
      qtest(etc_shadow_must_be writable) :-
         open('/etc/shadow', append, Stream),
         close(Stream).
  
      % with more features, given in a list  
      qtest([filesystem, title('See if /etc/group is writable')]) :-
         open('/etc/group', append, Stream),
         close(Stream).

*/

:- ensure_loaded(library(debug)).
:- ensure_loaded(qtest_header).

qtest_argument(Argument) :-
	clause(qtest(Argument), _Body, _Reference).


%%  run_qtests
%%
%%  Run 'em all, print stats, succeed if they all do.

run_qtests :-
	run_qtests(_, true).

%%  run_qtests(+Argument)
%%
%%  Run all the qtest clauses whose argument unifies with Argument
%%  and print print statistics; succeeds only if all tests succeeds.
%%
%%  example:  run_qtests(_)
%%
%%  example:  run_qtests(quick(_)).
%%

run_qtests(Argument) :-
	run_qtests(Argument, true).

%%  run_qtests(+Argument, :Restriction)
%%
%%  Like run_qtests, but allows an addition restriction clause
%%  to select among matches.
%%
%%  example:  run_qtests(Arg, memberchk(quick, Arg))
%%
%%

run_qtests(Argument, Restriction) :-
	flag(qtest_pass, _, 0),
	flag(qtest_fail, _, 0),
	(   qtest_argument(Argument),
	    debug(qtest, 'Found a clause, argument: ~q', [Argument]),
	    Restriction,
	    debug(qtest, '... and it passes the restriction.', []),
	    run_single_qtest(Argument),
	    fail
	;   true
	),
	flag(qtest_pass, Passed, Passed),
	flag(qtest_fail, Failed, Failed),
	print_message(informational, qtest_results(Passed, Failed)),
	!, 
	Failed = 0.

prolog:message(qtest_results(Passed, Failed)) -->
	[ 'qtests: ~a passed, ~a failed' - [Passed, Failed] ].
prolog:message(qtest_failed(Argument, File, Line)) -->
	[ 'qtest failed: ~a:~d, qtest(~q)' - [File, Line, Argument] ].

%%  run_single_qtest(Argument)
%%
%%  Call qtest(Argument) and record stats, and maybe print messages,
%%  based on whether it succeeds for fails.

run_single_qtest(Argument) :-
	(   debug(qtest, 'qtest calling ~q', [Argument]),
	    qtest(Argument)
	->  flag(qtest_pass, N, N+1),
	    debug(qtest, '... passed!', [])
	;   flag(qtest_fail, N, N+1),
	    debug(qtest, '... faild!', []),
	    clause(qtest(Argument), _Body, Reference),
	    clause_property(Reference, file(File)),
	    clause_property(Reference, line_count(Line)),
	    print_message(error,
			  qtest_failed(Argument, File, Line))
	).
