Next: PlUnit Running the Test-Suite, Previous: PlUnit Introduction, Up: lib-plunit [Contents][Index]
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:
:- use_module(library(lists)). :- begin_tests(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)
The test is currently disabled. Tests are flagged as blocked if they
cannot be run for some reason. E.g. they crash Prolog, they rely on
some service that is not available, they take too much resources, etc.
Tests that fail but do not crash, etc. should be flagged using
fixme(Fixme)
. Reason should be an atom.
If this option appears more than once in a list of options, all but one of the occurrences are silently ignored.
fixme(Reason)
Similar to blocked(Fixme)
, but the test is executed anyway.
A summary is printed at the end of the test run.
Reason should be an atom.
If this option appears more than once in a list of options, all but one of the occurrences are silently ignored.
condition(Goal)
Precondition for running the test. If the condition fails, then
the test is skipped. The condition can be used as an alternative
to the 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.
If this option appears more than once in a list of options, the occurrences are combined into a conjunction, in the order they appear.
nondet
Available for individual test rules only. Unless this keyword appears in the option list, nondeterminate success of the test-body is considered an error.
It is an error to specify this more than once in a list of options.
forall(Generator)
Available for individual test rules only.
Runs the same test for each solution of Generator. Each run invokes
the setup
and cleanup
handlers. This can be used to run
the same test with different inputs. If an error occurs, then the test is
reported as ‘name (forall bindings = vars)’, where vars
indicates the bindings of variables in Generator, which should be
a callable.
It is an error to specify this more than once in a list of options.
setup(Goal)
Goal is run before the test-body. Typically used together with
the cleanup
option to create and destroy the required execution
environment.
Goal should be a callable.
If this option appears more than once in a list of options, the occurrences are combined into a conjunction, in the order they appear.
cleanup(Goal)
Goal is always called after completion of the test-body,
regardless of whether it fails, succeeds or raises an exception. This
option or call_cleanup/2
must be used by tests that require
side effects that must be reverted after the test completes. Goal
may share variables with a setup option and should be a callable.
If this option appears more than once in a list of options, the occurrences are combined into a conjunction, in the order they appear.
:- use_module(library(file_systems)). :- begin_tests(hello). 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(_). :- end_tests(hello).
Please note: Do not place directives that load source code between
:- begin_tests(Unit[,Options])
and:- end_tests(Unit)
. Loading source files in this context can cause spurious error messages.
The following options specify how to verify the result of the test-body, and are only available for individual test rules. Unless stated otherwise, it is an error if more than one of them appears in a list of options. In some cases there are additional restrictions on which options can appear together.
true
true(Test)
The test-body as well as the goal Test must succeed. Test
defaults to 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.
If this option appears more than once in a list of options, the occurrences are combined into a conjunction, in the order they appear.
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)
Similar to 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.
It is an error to specify this together with nondet
.
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)
Similar to all(AnswerTerm Cmp Instances)
, but
sorts the AnswerTerm instances before the comparison. The tests
in the example below are equivalent.
It is an error to specify this together with nondet
.
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
The test-body must fail.
It is an error to specify this together with nondet
.
exception(Expected)
throws(Expected)
The test-body must raise an exception Raised that is checked
wrt. Expected using subsumes_term(Expected, Raised)
.
I.e. the raised exception must be more specific than
the specified Expected.
It is an error to specify this together with nondet
.
error(ISO)
error(ISO,Info)
A shorthand for exception(error(ISO,Info))
.
Info defaults to an anonymous variable.
It is an error to specify this together with nondet
.
• PlUnit Determinate Tests | Determinate Tests | |
• PlUnit Nondeterminate Tests | Nondeterminate Tests | |
• PlUnit Tests Expected to Fail | Tests Expected to Fail | |
• PlUnit Tests Expected to Raise Exceptions | Tests Expected to Raise Exceptions |
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
, throws
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.