1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2% Test module for Bousi-Prolog predicates
    3
    4:- module(test_bousiprolog, [
    5		run_all_bousiprolog_tests/3 % +BasePath, -Passed, -Failed
    6	]).    7
    8:- use_module(library(lists)).    9
   10%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   11
   12
   13
   14%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   15% Main predicates for testing Prolog predicates
   16%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 run_all_bousiprolog_tests(+BasePath, -Passed, -Failed)
Loads all the files for testing Bousi-Prolog predicates (which must be under the BasePath directory) and runs all their tests using run_bousiprolog_test_files/5.

The total number of tests passed and failed will be returned in Passed and Failed, respectively.

See also
- run_bousiprolog_test_files/5
   31run_all_bousiprolog_tests(BasePath, Passed, Failed) :-
   32	bousiprolog_test_files(Files),
   33	add_path_to_files(Files, FullFiles, BasePath),
   34	run_bousiprolog_test_files(FullFiles, 0, Passed, 0, Failed).
 run_bousiprolog_test_files(+Files, +Passed, -FinalPassed, +Failed, -FinalFailed)
Loads each of the Bousi-Prolog source code files of the Files list, and runs all their test predicates using run_bousiprolog_tests/5.

Passed/FinalPassed and Failed/FinalFailed are two accumulator pairs: FinalPassed will be unified with Passed plus the number of tests passed, whereas FinalFailed will be unified with Failed plus the number of tests failed.

See also
- run_bousiprolog_tests/5
   50run_bousiprolog_test_files([], Passed, Passed, Failed, Failed).
   51
   52run_bousiprolog_test_files([File|MoreFiles], Passed, FinalPassed, Failed, FinalFailed) :-
   53	file_base_name(File, BaseFile),
   54	write('------------------------------------------------------------------------------'), nl,
   55	writef('Running Bousi-Prolog test file %w', [BaseFile]), nl,
   56	write('------------------------------------------------------------------------------'), nl,
   57	(
   58		% Loads the Bousi-Prolog file (each Bousi-Prolog file
   59		% contains a single test suite)
   60		catch((
   61			bplShell:ld(File, [f]),
   62			bplShell:last_program_loaded(LoadedFile, ''),
   63			file_base_name(LoadedFile, BaseFile),
   64			!
   65		% (catcher)
   66		), _Error1, (
   67			fail
   68		)),
   69		% Gets the name of the predicates that belong to the test
   70		% suite of the loaded Bousi-Prolog file
   71		evaluator:solve_goal(bpl_call(test_suite(Tests))),
   72		% Runs the tests of this file
   73		run_bousiprolog_tests(Tests, Passed, NewPassed, Failed, NewFailed),
   74		% Gets the additional queries that must be solved
   75		catch((
   76			(
   77				evaluator:solve_goal(bpl_call(additional_queries(AdQueries)))
   78			;
   79				AdQueries = []
   80			)
   81		% (catcher)
   82		), _Error2, (
   83			AdQueries = []
   84		)),
   85		(AdQueries \== [] ->
   86			write('Testing additional queries... '),
   87			(
   88				% Runs all the additional queries
   89				catch((
   90					forall(member(AdQuery, AdQueries), (
   91						translator:translate_query(AdQuery, AdExQuery, _Bindings, _Degree),
   92						evaluator:solve_goal(AdExQuery)
   93					))
   94				), _Error3, (
   95					fail
   96				)),
   97				!,
   98				% Additional queries passed
   99				write('OK'), nl
  100			;
  101				% Additional queries failed
  102				write('failed'), nl,
  103				write('Press any key to continue '),
  104				get_single_char(_),
  105				nl
  106			)
  107		;
  108			% No additional queries found
  109			true
  110		)
  111	;
  112		% Bousi-Prolog file couldn't be loaded
  113		writef('Test file %w couldn\'t be loaded.', [BaseFile]), nl,
  114		write('Press any key to continue '),
  115		get_single_char(_),
  116		nl,
  117		NewPassed is Passed,
  118		NewFailed is Failed + 1
  119	),
  120	!,
  121	% Proceeds to the next file
  122	run_bousiprolog_test_files(MoreFiles, NewPassed, FinalPassed, NewFailed, FinalFailed).
 run_bousiprolog_tests(+Tests, +Passed, -FinalPassed, +Failed, -FinalFailed)
Runs each of the predicates of the Tests list under Bousi-Prolog and checks the approximation degree of the result. A test will pass only if it succeeds and its approximation degree is exactly the same as the expected one for that test.

Passed/FinalPassed and Failed/FinalFailed are two accumulator pairs: FinalPassed will be unified with Passed plus the number of tests passed, whereas FinalFailed will be unified with Failed plus the number of tests failed.

See also
- execute_test/2
  140run_bousiprolog_tests([], Passed, Passed, Failed, Failed).
  141
  142run_bousiprolog_tests([Test|MoreTests], Passed, FinalPassed, Failed, FinalFailed) :-
  143	writef('Testing %w... ', [Test]),
  144	% Translates the test name into an executable query
  145	translator:translate_query(Test, Query, _Bindings, Degree),
  146	% Executes the test under Bousi-Prolog
  147	execute_test(Query, Degree),
  148	% Gets the expected approximation degree of the solution
  149	% (if no expected degree is specified, 1 is assummed)
  150	catch((
  151		(
  152			evaluator:solve_goal(bpl_call(approximation_degree(Test, ExpectedDegree)))
  153		;
  154			ExpectedDegree is 1
  155		)
  156	% (catcher)
  157	), _Error, (
  158		ExpectedDegree is 1
  159	)),
  160	(
  161		% Compares the approximation degree of the solution with the
  162		% expected approximation degree (if the latter is a free variable,
  163		% any approximation degree less than 1 will be considered OK)
  164		(
  165			var(ExpectedDegree), Degree < 1
  166		;
  167			nonvar(ExpectedDegree), Degree =:= ExpectedDegree
  168		),
  169		% Test passed
  170		writef('OK with %w', [Degree]), nl,
  171		NewPassed is Passed + 1,
  172		NewFailed is Failed
  173	;
  174		% Test failed
  175		write('failed'), nl,
  176		NewPassed is Passed,
  177		NewFailed is Failed + 1,
  178		% Shows the results of the test
  179		writef('> Approximation degree . %w', [Degree]), nl,
  180		(var(ExpectedDegree) ->
  181			write('> Expected degree ...... < 1'), nl
  182		;
  183			writef('> Expected degree ...... %w', [ExpectedDegree]), nl
  184		)
  185		,
  186		write('Press any key to continue '),
  187		get_single_char(_),
  188		nl
  189	),
  190	!,
  191	% Proceeds to the next test
  192	run_bousiprolog_tests(MoreTests, NewPassed, FinalPassed, NewFailed, FinalFailed).
  193
  194
  195
  196%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  197% Helper predicates
  198%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 execute_test(+Goal, -Degree)
Executes Goal under the evaluator module. Degree must be the variable where the approximation degree of the result will be stored after executing Goal. If Goal fails or throws an unhandled exception Degree will be unified with 0.
  209execute_test(Goal, Degree) :-
  210	catch((
  211		(evaluator:solve_goal(Goal) ->
  212			true
  213		;
  214			Degree = 0
  215		)
  216	% (catcher)
  217	), _Error, (
  218		Degree = 0
  219	)).
 add_path_to_files(+Files, -FullPaths, +BasePath)
Concatenates BasePath with each of the filenames in Files and returns the resulting paths in FullPaths.
  228add_path_to_files([], [], _BasePath).
  229
  230add_path_to_files([File|MoreFiles], [FullPath|MoreFullPaths], BasePath) :-
  231	(concat_atom([_, '/'], BasePath) ->
  232		concat_atom([BasePath, File], FullPath)
  233	;
  234		concat_atom([BasePath, '/', File], FullPath)
  235	),
  236	add_path_to_files(MoreFiles, MoreFullPaths, BasePath).
  237
  238
  239
  240%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  241% Constant predicates
  242%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 bousiprolog_test_files(?Files)
Returns the list of Bousi-Prolog source code files that contain the test suites used by this module.
  251bousiprolog_test_files(['bpl_relations_1.bpl', 'bpl_relations_2.bpl',
  252                        'bpl_relations_3.bpl', 'bpl_fuzzysets.bpl',
  253                        'bpl_lambdacut.bpl', 'bpl_tnorms.bpl',
  254                        'bpl_wsld.bpl', 'bpl_unif_algorithm_a1.bpl',
  255                        'bpl_unif_algorithm_a2.bpl', 'bpl_unif_algorithm_a3.bpl'])