Tests are written in normal Prolog. A unit test is a named collection of individual tests, enclosed within the directives:
:- begin_tests(
Unit[,
Options]).
and:
:- end_tests(
Unit).
They can be embedded inside a normal source module, or be placed in a separate test-file that loads the files to be tested. The individual tests are defined by rules of the form:
test(
Name[,
Options]) :-
test-body.
where Name is a ground term and Options is a list describing additional properties of the test. Here is a very simple example:
:- begin_tests(lists). :- use_module(library(lists)). test(reverse) :- reverse([a,b], [b,a]). :- end_tests(lists).
The optional second argument of the unit test declaration as well as of the individual test-heads defines additional processing options. The following options are available:
blocked(
Reason)
fixme(
Fixme)
. Reason should be an atom.
fixme(
Reason)
blocked(
Fixme)
, but the test it executed anyway.
A summary is printed at the end of the test run.
Reason should be an atom.
condition(
Goal)
setup
option. The only difference is that failure
of a condition skips the test and is considered an error when using
the setup
option.
Goal should be a callable.
nondet
forall(
Generator)
setup
and cleanup
handlers. This can be used to run
the same test with different inputs. If an error occurs, the test is
reported as ‘name (forall bindings = vars)’, where vars
indicates the bindings of variables in Generator, which should be
a callable.
setup(
Goal)
cleanup
option to create and destroy the required execution
environment.
Goal should be a callable.
cleanup(
Goal)
:- use_module(library(file_systems)). create_file(Tmp) :- open(temp(plunit), write, Out, [if_exists(generate_unique_name)]), current_stream(Tmp, write, Out), portray_clause(Out, hello(_World)), close(Out). test(read, [setup(create_file(Tmp)), cleanup(delete_file(Tmp))]) :- see(Tmp), read(Term), seen, Term = hello(_).
The following options specify how to verify the result of the test-body, and are only available for individual test rules. It is not meaningful to specify more than one of them:
true
true(
Test)
true
and should be a callable that typically shares
variables with the test-body. This is the same as inserting the test at
the end of the conjunction, but makes the test harness print a “wrong
answer” message as opposed to a general failure message:
test(badadd, [true(A =:= 4)]) :- A is 1 + 2.
will yield the error message:
! /home/matsc/sicstus4/doc/foo.pl:11: ! test badadd: wrong answer (compared using =:=) ! Expected: 4 ! Got: 3
all(
AnswerTerm Cmp Instances)
true(
AnswerTerm Cmp Instances)
, but
used if you want to collect all solutions to a nondeterminate test.
AnswerTerm should share variables with the test-body. Let
All be the list of instances of AnswerTerm for each
solution. Then the goal Cmp(
All,
Instances)
must succeed. The tests in the example below are equivalent:
test(all1, all(X == [1,2])) :- (X = 1 ; X = 2). test(all2, true(Xs == [1,2])) :- findall(X, (X = 1 ; X = 2), Xs).
set(
AnswerTerm Cmp Instances)
all(
AnswerTerm Cmp Instances)
, but
sorts the AnswerTerm instances before the comparison. The tests
in the example below are equivalent:
test(set1, set(X == [1,2])) :- (X = 2 ; X = 1 ; X = 1). test(set2, true(Ys == [1,2])) :- findall(X, (X = 2 ; X = 1 ; X = 1), Xs), sort(Xs, Ys).
fail
exception(
Expected)
throws(
Expected)
terms:subsumeschk(
Expected,
Raised)
. I.e. the raised exception must be more specific than
the specified Expected.
error(
ISO)
error(
ISO,
Info)
exception(error(
ISO,
Info))
.
Info defaults to an anonymous variable.
The test-body is ordinary Prolog code. Without any options, the test-body
must be designed to succeed determinately. Any other result is
considered a failure. One of the options fail
, true
,
exception
or error
can be used to specify a different
expected result. In this subsection we illustrate typical test-scenarios
by testing built-in and library predicates.