diff --git a/Makefile.in b/Makefile.in index 2cb1cbd9f..64095cbeb 100644 --- a/Makefile.in +++ b/Makefile.in @@ -471,6 +471,7 @@ all: startup.yss @INSTALL_DLLS@ (cd library/lammpi; $(MAKE)) @INSTALL_DLLS@ (cd library/matrix; $(MAKE)) @INSTALL_DLLS@ (cd packages/sgml; $(MAKE)) + @INSTALL_DLLS@ (cd packages/plunit; $(MAKE)) @INSTALL_DLLS@ (cd packages/swi-minisat2/C; $(MAKE)) @INSTALL_MATLAB@ (cd library/matlab; $(MAKE)) @ENABLE_JPL@ @INSTALL_DLLS@ (cd packages/jpl; $(MAKE)) @@ -506,6 +507,7 @@ install_unix: startup.yss libYap.a mkdir -p $(DESTDIR)$(SHAREDIR)/Yap/pl for f in $(PL_SOURCES); do $(INSTALL) $$f $(DESTDIR)$(SHAREDIR)/Yap/pl; done @INSTALL_DLLS@ (cd packages/PLStream; $(MAKE) install) + @INSTALL_DLLS@ (cd packages/plunit; $(MAKE) install) @INSTALL_DLLS@ (cd packages/sgml; $(MAKE) install) @INSTALL_DLLS@ (cd packages/swi-minisat2/C; $(MAKE) install) @INSTALL_DLLS@ (cd library/random; $(MAKE) install) @@ -544,6 +546,7 @@ install_win32: startup.yss $(INSTALL) config.h $(DESTDIR)$(INCLUDEDIR)/config.h $(INSTALL) parms.h $(DESTDIR)$(INCLUDEDIR)/parms.h (cd packages/PLStream; $(MAKE) install) + (cd packages/plunit; $(MAKE) install) (cd packages/sgml; $(MAKE) install) (cd packages/swi-minisat2/C; $(MAKE) install) (cd library/random; $(MAKE) install) @@ -594,6 +597,7 @@ depend: $(HEADERS) $(C_SOURCES) clean: clean_docs rm -f *.o *~ *.BAK *.a @INSTALL_DLLS@ (cd packages/PLStream; $(MAKE) clean) + @INSTALL_DLLS@ (cd packages/plunit; $(MAKE) clean) @INSTALL_DLLS@ (cd library/matrix; $(MAKE) clean) @INSTALL_DLLS@ (cd library/random; $(MAKE) clean) @INSTALL_DLLS@ (cd library/regex; $(MAKE) clean) diff --git a/configure b/configure index 9af74e5fa..7b78b601c 100755 --- a/configure +++ b/configure @@ -17660,6 +17660,7 @@ mkdir -p packages/jpl/src/java/jpl/test mkdir -p packages/jpl/examples mkdir -p packages/jpl/examples/java mkdir -p packages/PLStream +mkdir -p packages/plunit mkdir -p packages/ProbLog mkdir -p packages/ProbLog/simplecudd mkdir -p packages/sgml @@ -17700,15 +17701,17 @@ ac_config_files="$ac_config_files packages/CLPBN/Makefile" ac_config_files="$ac_config_files packages/cplint/Makefile" -ac_config_files="$ac_config_files packages/sgml/Makefile" - ac_config_files="$ac_config_files packages/PLStream/Makefile" +ac_config_files="$ac_config_files packages/plunit/Makefile" + +ac_config_files="$ac_config_files packages/ProbLog/Makefile" + ac_config_files="$ac_config_files packages/swi-minisat2/Makefile" ac_config_files="$ac_config_files packages/swi-minisat2/C/Makefile" -ac_config_files="$ac_config_files packages/ProbLog/Makefile" +ac_config_files="$ac_config_files packages/sgml/Makefile" if test "$ENABLE_CHR" = ""; then @@ -18345,11 +18348,12 @@ do "LGPL/swi_console/Makefile") CONFIG_FILES="$CONFIG_FILES LGPL/swi_console/Makefile" ;; "packages/CLPBN/Makefile") CONFIG_FILES="$CONFIG_FILES packages/CLPBN/Makefile" ;; "packages/cplint/Makefile") CONFIG_FILES="$CONFIG_FILES packages/cplint/Makefile" ;; - "packages/sgml/Makefile") CONFIG_FILES="$CONFIG_FILES packages/sgml/Makefile" ;; "packages/PLStream/Makefile") CONFIG_FILES="$CONFIG_FILES packages/PLStream/Makefile" ;; + "packages/plunit/Makefile") CONFIG_FILES="$CONFIG_FILES packages/plunit/Makefile" ;; + "packages/ProbLog/Makefile") CONFIG_FILES="$CONFIG_FILES packages/ProbLog/Makefile" ;; "packages/swi-minisat2/Makefile") CONFIG_FILES="$CONFIG_FILES packages/swi-minisat2/Makefile" ;; "packages/swi-minisat2/C/Makefile") CONFIG_FILES="$CONFIG_FILES packages/swi-minisat2/C/Makefile" ;; - "packages/ProbLog/Makefile") CONFIG_FILES="$CONFIG_FILES packages/ProbLog/Makefile" ;; + "packages/sgml/Makefile") CONFIG_FILES="$CONFIG_FILES packages/sgml/Makefile" ;; "packages/chr/Makefile") CONFIG_FILES="$CONFIG_FILES packages/chr/Makefile" ;; "packages/clpqr/Makefile") CONFIG_FILES="$CONFIG_FILES packages/clpqr/Makefile" ;; "packages/jpl/Makefile") CONFIG_FILES="$CONFIG_FILES packages/jpl/Makefile" ;; diff --git a/configure.in b/configure.in index 6f8dd3286..f9dd7cfae 100755 --- a/configure.in +++ b/configure.in @@ -1632,6 +1632,7 @@ mkdir -p packages/jpl/src/java/jpl/test mkdir -p packages/jpl/examples mkdir -p packages/jpl/examples/java mkdir -p packages/PLStream +mkdir -p packages/plunit mkdir -p packages/ProbLog mkdir -p packages/ProbLog/simplecudd mkdir -p packages/sgml @@ -1654,11 +1655,12 @@ AC_CONFIG_FILES([LGPL/clp/Makefile]) AC_CONFIG_FILES([LGPL/swi_console/Makefile]) AC_CONFIG_FILES([packages/CLPBN/Makefile]) AC_CONFIG_FILES([packages/cplint/Makefile]) -AC_CONFIG_FILES([packages/sgml/Makefile]) AC_CONFIG_FILES([packages/PLStream/Makefile]) +AC_CONFIG_FILES([packages/plunit/Makefile]) +AC_CONFIG_FILES([packages/ProbLog/Makefile ]) AC_CONFIG_FILES([packages/swi-minisat2/Makefile]) AC_CONFIG_FILES([packages/swi-minisat2/C/Makefile]) -AC_CONFIG_FILES([packages/ProbLog/Makefile ]) +AC_CONFIG_FILES([packages/sgml/Makefile]) if test "$ENABLE_CHR" = ""; then AC_CONFIG_FILES([packages/chr/Makefile]) diff --git a/packages/plunit/ChangeLog b/packages/plunit/ChangeLog new file mode 100644 index 000000000..f83fb0297 --- /dev/null +++ b/packages/plunit/ChangeLog @@ -0,0 +1,172 @@ +[Jul 29 2009] + + * ENHANCED: System and library modules now use =system= as their parent module rather than =user=. +[Jun 15 2009] + + * DOC: Item#483: Broken link in PlUnit. Ulrich Neumerkel. + +[May 14 2009] + + * DOC: module specifier, typos + +[Mar 19 2009] + + * CLEANUP: Removed all trailing whitespace from all source-files. This avoids many GIT (merge) warnings. +[Mar 12 2009] + + * MODIFIED: Renamed concat_atom/2,3 into atomic_list_concat/2,3 for compatibility. Moved the old predicates into library(backcomp). It is adviced to update your code, but 99% of the code will remain working because the old definitions are autoloaded. +[Feb 11 2009] + + * CLEANUP: Module declaration code +[Sep 11 2008] + + * PORT: Add AC_PREREQ to configure.h for systems that auto-select autoconf + versions. After tip by Ulrich Neumerkel. + +[Aug 11 2008] + + * INSTALL: Remove all configure files from the git repository + +[Jul 10 2008] + + * FIXED: PlUnit: Perform goal_expansion/2 on setup, condition and cleanup options. + Ivo Swartjes. + +[Jun 26 2008] + + * ADDED: forall option to unit tests that allows running the same test on + different data sets. + + * FIXED: wrong handling of gloabl option sto(false) +[May 31 2008] + + * FIXED: Properly support tests with condition and setup + +[May 14 2008] + + * ENHANCED: PlUnit: Test options in set_test_options/1; fix documentation. + +[May 9 2008] + + * ADDED: Allow specifying sto mode for an entire test set + +[May 1 2008] + + * DOC: plunit and non termination + +[Apr 28 2008] + + * ADDED: flag tests using `fixme'. Suggested under the name `desired' by + Ulrich Neumerkel. Let us see how this works out in practice! + +[Apr 24 2008] + + * ENHANCED: When interrupting a thread, indicate which one. + + * ADDED: PlUnit: running_tests/0 to find what test is running. + + * FIXED: wrong dynamic declaration in plunit.pl + +[Mar 11 2008] + + * ENHANCED: Provide file/line info for errors in setup and condition + +[Feb 4 2008] + + * FIXED: STO independent of timings, Item#316 + +[Jan 31 2008] + + * DOC: formatting + +[Jan 30 2008] + + * ENHANCED: PlUnit: run_tests(Unit) raise error on non-existing unit. + Item#305, Ulrich Neumerkel. + + * ENHANCED: PlUnit: reporting STO and setting STO checking options + +[Jan 29 2008] + + * CLEANUP: PlUnit: some reorganisation of the test loop, preparing for further + enhancements. + +[Jan 28 2008] + + * ADDED: subsumes/2 and subsumes_chk/2 as built-in predicates. + + * ENHANCED: Really load no tests if not asked to do and provide better feedback + if no tests where loaded or all tests passed. + + * FIXED: DCG: cut transparency, output unification, preserve erroneous non-terminals + * ENHANCED: DCG: more tests + * FIXED: PlUnit version confusion + +[2008-01-26] + + * FIXED: portability for SICStus 3.12 + * ENHANCED: new option sto + +[Jan 14 2008] + + * FIXED: Non-determinism in run_tests/0 if there are blocked tests. + +[Dec 21 2007] + + * FIXED: PlUnit printing of wrong answers if there are attributes. Ulrich + Neumerkel, item#242 +Oct 30, 2007 + +* ENHANCED: Report error or failure in cleanup handler (Mark van Assem) +* ENHANCED: Do not report '% All tests passed' if no tests are + executed after a make/0. + +Sep 21, 2007 + +* ENHANCED: Verify test-set and test options. + +* ADDED: Allow for Var == Value as shorthand for true(Var == Value). + +Sep 20, 2007 + +* ENHANCED: Message on wrong error + +* DOCS: Fixed typos. Ulrich Neumerkel. + +* FIXED: avoid a loop if a test throws an error holding a cyclic term. + +* MODIFIED: errors are now verified using subsumes_chk/2 instead of =@=. + +* PORT: =@= is now correctly bound to variant/2 for SICStus. + +Aug 1, 2007 + +* FIXED: Ran failing tests twice due to unwanted choicepoint. + +Jul 30, 2007 + +* ADDED: allow for error(Error) as alias for throws(error(Error, _)). + +Mar 28, 2007 + +* ADDED: option silent(Bool) to force completely silent operation. + +Mar 6, 2007 + +* Allow for single option without list + +Nov 23, 2006 + +* Force start of line after .... + +Oct 22, 2006 + +* Allow tracing body of tests. Suggested by Lukas Degener. + +Oct 17, 2006 + +* Portability with SICStus 3.12. + +Oct 13, 2006 + +* Better message for tests that succeeded but should have failed diff --git a/packages/plunit/Makefile.in b/packages/plunit/Makefile.in new file mode 100644 index 000000000..3397a977a --- /dev/null +++ b/packages/plunit/Makefile.in @@ -0,0 +1,132 @@ +################################################################ +# SWI-Prolog `PlDoc' package +# Author: Jan Wielemaker. wielemak@science.uva.nl +# Copyright: GPL (see COPYING or www.gnu.org +################################################################ + +.SUFFIXES: .tex .dvi .doc .pl + +SHELL=@SHELL@ + +ifeq (@PROLOG_SYSTEM@,yap) + +prefix = @prefix@ +ROOTDIR = $(prefix) +EROOTDIR = @exec_prefix@ + +srcdir=@srcdir@ + +BINDIR = $(EROOTDIR)/bin +YAPLIBDIR=$(EROOTDIR)/lib/Yap +# hack for SWI compatibility +LIBDIR=$(EROOTDIR)/share/Yap + +PL=@EXTEND_DYNLOADER_PATH@ $(DESTDIR)$(BINDIR)/yap $(DESTDIR)$(YAPLIBDIR)/startup.yss +LN_S=@LN_S@ +EXDIR=$(LIBDIR)/examples/plunit + +else # SWI + +srcdir=. + +PLBASE=@PLBASE@ +PLARCH=@PLARCH@ +PL=@PL@ +XPCEBASE=$(PLBASE)/xpce +PKGDOC=$(PLBASE)/doc/packages +PCEHOME=../xpce +LIBDIR=$(PLBASE)/library +EXDIR=$(PKGDOC)/examples/plunit + +endif + +DESTDIR= + +DOCTOTEX=$(PCEHOME)/bin/doc2tex +PLTOTEX=$(PCEHOME)/bin/pl2tex +vLATEX=latex +DOC=plunit +TEX=$(DOC).tex +DVI=$(DOC).dvi +PDF=$(DOC).pdf +HTML=$(DOC).html + +INSTALL=@INSTALL@ +INSTALL_PROGRAM=@INSTALL_PROGRAM@ +INSTALL_DATA=@INSTALL_DATA@ + +LIBPL= $(srcdir)/plunit.pl $(srcdir)/test_wizard.pl $(srcdir)/test_cover.pl +LIBALL= $(LIBPL) $(SUPPORT) +EXAMPLES= $(srcdir)/read.pl $(srcdir)/simple.pl + +all: + @echo "Nothing to do for this package" + +install: $(LIBPL) + mkdir -p $(DESTDIR)$(LIBDIR) + $(INSTALL_DATA) $(LIBALL) $(DESTDIR)$(LIBDIR) + $(PL) -f none -g make -t halt + +ln-install: $(LIBPL) + mkdir -p $(DESTDIR)$(LIBDIR) + for f in $(LIBALL); do \ + rm -f $(DESTDIR)$(LIBDIR)/$$f; \ + ln -s `pwd`/$$f $(DESTDIR)$(LIBDIR); \ + done + $(PL) -f none -g make -t halt + +rpm-install: install + +pdf-install: install-examples + $(INSTALL_DATA) $(DOC).pdf $(DESTDIR)$(PKGDOC) + +html-install: install-examples + $(INSTALL_DATA) $(DOC).html $(DESTDIR)$(PKGDOC) + +install-examples:: + mkdir -p $(DESTDIR)$(EXDIR) + (cd examples && $(INSTALL_DATA) $(EXAMPLES) $(DESTDIR)$(EXDIR)) + +uninstall:: + rm -f $(LIBDIR)/plunit.pl + $(PL) -f none -g make -t halt + +check:: + true + +################################################################ +# Documentation +################################################################ + +doc: $(PDF) $(HTML) +pdf: $(PDF) +html: $(HTML) + +$(HTML): $(TEX) + latex2html $(DOC) + mv html/index.html $@ + rmdir html + +$(PDF): $(TEX) + ../../man/runtex --pdf $(DOC) + +$(TEX): $(DOCTOTEX) + +.doc.tex: + $(DOCTOTEX) $*.doc > $*.tex +.pl.tex: + $(PLTOTEX) $*.pl > $*.tex + +################################################################ +# Clean +################################################################ + +clean: + rm -f *~ *% config.log + +# rm -f $(TEX) +# ../../man/runtex --clean $(DOC) +# rm -rf html + +distclean: clean + rm -f $(TARGETS) config.cache config.status Makefile diff --git a/packages/plunit/README b/packages/plunit/README new file mode 100644 index 000000000..d8f2b4a08 --- /dev/null +++ b/packages/plunit/README @@ -0,0 +1,46 @@ +Prolog Unit Tests +================= + + +---++ TBD + + * Add options to test units + - Condition, setup, cleanup, blocked [OK] + * Run the tests on make, etc. [OK] + * Report generation options + +---++ What to do with loaded tests? + + * Keep them around + * Remove them + * Flag module as `volatile', so it is not saved. + +---++ Distinguish user/system/library tests + +---++ Deal with seperate test-files: + + * load_test_files(+Options) + +---++ Volatile modules? + +---++ Conversion of system tests: + + - test.pl internals [OK] + - scripts called from test.pl [OK] + - tests for packages + +---++ Run tests concurrently? + + + Tests applications for concurrent execution + + Saves time, notably on tests doing networking, timeout, etc. + - Might be more complicated to understand + +---++ Test wizard + + * Write tests to .plt files + * Merge with existing content of .plt files + - Read with comments and write back? + +---++ Coverage analysis + + * See cover.pl diff --git a/packages/plunit/examples/read.pl b/packages/plunit/examples/read.pl new file mode 100644 index 000000000..e373407f6 --- /dev/null +++ b/packages/plunit/examples/read.pl @@ -0,0 +1,22 @@ + +:- use_module(library(plunit)). + +:- begin_tests(read). + +:- use_module(library(system)). + +:- use_module(library(readutil)). + +create_file(Tmp) :- + tmp_file(plunit, Tmp), + open(Tmp, write, Out), + write(Out, 'hello(World).\n'), + close(Out). + +test(read, [ setup(create_file(Tmp)), + cleanup(delete_file(Tmp)) + ]) :- + read_file_to_terms(Tmp, Terms, []), + Terms =@= [hello(_)]. + +%:- end_tests(read). diff --git a/packages/plunit/examples/simple.pl b/packages/plunit/examples/simple.pl new file mode 100644 index 000000000..9d45fca95 --- /dev/null +++ b/packages/plunit/examples/simple.pl @@ -0,0 +1,31 @@ +:- module(ex_simple, []). +:- use_module(library(plunit)). + +:- begin_tests(lists). + +test(true) :- + true. + +test(fail) :- + \+ fail. + +test(fail, [fail]) :- + fail. + +test(member) :- + member(a, [a]), !. + +test(member, [nondet]) :- + member(_, [a]). + +test(member, [true(X == a)]) :- + member(X, [a]), !. + +test(member, [all(V == [a,b,c])]) :- + member(V, [a,b,c]). + +test(append) :- + append("aap", "noot", X), + X == "aapnoot". + +:- end_tests(lists). diff --git a/packages/plunit/plunit.doc b/packages/plunit/plunit.doc new file mode 100644 index 000000000..f08c3c618 --- /dev/null +++ b/packages/plunit/plunit.doc @@ -0,0 +1,671 @@ +\documentclass[11pt]{article} +\usepackage{times} +\usepackage{pl} +\usepackage{html} +\usepackage{plpage} +\sloppy +\makeindex + +\onefile +\htmloutput{html} % Output directory +\htmlmainfile{index} % Main document file +\bodycolor{white} % Page colour + +\renewcommand{\runningtitle}{Prolog Unit Tests} + +\begin{document} + +\title{Prolog Unit Tests} +\author{Jan Wielemaker \\ + HCS, \\ + University of Amsterdam \\ + The Netherlands \\ + E-mail: \email{wielemak@science.uva.nl}} + +\maketitle + +\begin{abstract} +This document describes a Prolog unit-test framework. This framework was +initially developed for \url[SWI-Prolog]{http://www.swi-prolog.org}. The +current version also runs on \url[SICStus +Prolog]{http://www.sics.se/sicstus/}, providing a portable testing +framework. See \secref{sicstus}. +\end{abstract} + +\pagebreak +\tableofcontents + +\vfill +\vfill + +\newpage + +\section{Introduction} +\label{sec:intro} + +There is really no excuse not to write tests! + +Automatic testing of software during development is probably the most +important Quality Assurance measure. Tests can validate the final +system, which is nice for your users. However, most (Prolog) developers +forget that it is not just a burden during development. + +\begin{itemize} + \item Tests document how the code is supposed to be used. + \item Tests can validate claims you make on the Prolog + implementation. Writing a test makes the claim + explicit. + \item Tests avoid big applications saying `No' after + modifications. This saves time during development, + and it saves \emph{a lot} of time if you must return + to the application a few years later or you must + modify and debug someone else's application. +\end{itemize} + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{A Unit Test box} +\label{sec:unitbox} + +Tests are written in pure Prolog and enclosed within the directives +begin_tests/1,2 and end_tests/1. They can be embedded inside a normal +source module, or be placed in a separate test-file that loads the files +to be tested. Code inside a test box is normal Prolog code. The +entry points are defined by rules using the head \term{test}{Name} or +\term{test}{Name, Options}, where \arg{Name} is a ground term and +\arg{Options} is a list describing additional properties of the test. +Here is a very simple example: + +\begin{code} +:- begin_tests(lists). +:- use_module(library(lists)). + +test(reverse) :- + reverse([a,b], [b,a]). + +:- end_tests(lists). +\end{code} + +The optional second argument of the test-head defines additional processing +options. Defined options are: + +\begin{description} + \termitem{blocked}{+Reason:atom} +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 +\term{fixme}{Fixme}. + + \termitem{fixme}{+Reason:atom} +Similar to \term{blocked}{Reason}, but the test it executed anyway. If +it fails, a \const{-} is printed instead of the \const{.} character. If +it passes a \const{+} and if it passes with a choicepoint, \const{!}. +A summary is printed at the end of the test run and the goal +\term{test_report}{fixme} can be used to get details. + + \termitem{condition}{:Goal} +Pre-condition for running the test. If the condition fails +the test is skipped. The condition can be used as an alternative +to the \const{setup} option. The only difference is that failure +of a condition skips the test and is considered an error when using +the \const{setup} option. + + \termitem{cleanup}{:Goal} +\arg{Goal} is always called after completion of the test-body, +regardless of whether it fails, succeeds or throws 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. \arg{Goal} may share +variables with the test body. + +\begin{code} +create_file(Tmp) :- + tmp_file(plunit, Tmp), + open(Tmp, write, Out), + write(Out, 'hello(World).\n'), + close(Out). + +test(read, [ setup(create_file(Tmp)), + cleanup(delete_file(Tmp)) + ]) :- + read_file_to_terms(Tmp, Terms, []), + Term = hello(_). +\end{code} + + \termitem{setup}{:Goal} +\arg{Goal} is run before the test-body. Typically used together with +the \const{cleanup} option to create and destroy the required execution +environment. + + \termitem{forall}{:Generator} +Run the same test for each solution of \arg{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, the test is reported as +\mbox{\texttt{name (forall bindings = } \texttt{)}}, where + indicates the bindings of variables in \arg{Generator}. + + \termitem{true}{AnswerTerm Cmp Value} +Body must succeed deterministically. AnswerTerm is compared to Value +using the comparison operator \arg{Cmp}. \arg{Cmp} is typically one of +=/2, ==/2, =:=/2 or =@=/2,% + \footnote{The =@= predicate (denoted \emph{structural equivalence}) + is the same as variant/2 in SICStus.} +but any test can be used. This is the same as inserting the test at the +end of the conjunction, but it allows the test engine to distinguish +between failure of copy_term/2 and producing the wrong value. Multiple +variables must be combined in an arbitrary compound term. E.g.\ +\verb$A1-A2 == v1-v2$ + +\begin{code} +test(copy, [ true(Copy =@= hello(X,X)) + ]) :- + copy_term(hello(Y,Y), Copy). +\end{code} + + \termitem{AnswerTerm Cmp Value} +Equivalent to \term{true}{AnswerTerm Cmp Value} if \arg{Cmp} is one +of the comparison operators given above. + + \termitem{fail}{} +Body must fail. + + \termitem{throws}{Error} +Body must throw \arg{Error}. The error is verified using +\term{subsumes_chk}{Error, Generated}. I.e.\ the generated error +must be more specific than the specified \arg{Error}. + + \termitem{error}{Error} +Body must throw \term{error}{Error, _Context}. See \const{throws} +for details. + + \termitem{all}{AnswerTerm Cmp Instances} +Similar to \term{true}{AnswerTerm Cmp Values}, but used for non-deterministic +predicates. Each element is compared using \arg{Cmp}. Order matters. For +example: + +\begin{code} +test(or, all(X == [1,2])) :- + ( X = 1 ; X = 2 ). +\end{code} + + \termitem{set}{AnswerTerm Cmp Instances} +Similar to \term{all}{AnswerTerm Cmp Instances}, but ignores order and +duplicates with respect to \arg{Cmp} in the comparison. Each element is +compared using \arg{Cmp}. + + \termitem{nondet}{} +If this keyword appears in the option list, non-deterministic success +of the body is not considered an error. + + \termitem{sto}{Terms} +Declares that executing body is subject to occurs-check (STO). The +test is executed with \arg{Terms}. \arg{Terms} is either +\const{rational_trees} or \const{finite_trees}. STO programs are not +portable between different kinds of terms. Only programs \emph{not} +subject to occurs-check (NSTO) are portable\footnote{See 7.3.3 of +ISO/IEC 13211-1 PROLOG: Part 1 - General Core, for a detailed +discussion of STO and NSTO}. Fortunately, most practical programs are +NSTO. Writing tests that are STO is still useful to ensure the +robustness of a predicate. In case sto4 and sto5 below, an infinite +list (a rational tree) is created prior to calling the actual +predicate. Ideally, such cases produce a type error or fail silently. + +\begin{code} +test(sto1, [sto(rational_trees)]) :- + X=s(X). +test(sto2, [sto(finite_trees),fail]) :- + X=s(X). +test(sto3, [sto(rational_trees), fail]) :- + X=s(X), fail. +test(sto4, [sto(rational_trees),error(type_error(list,L))]) :- + L = [_|L], length(L,_). +test(sto5, [sto(rational_trees),fail]) :- + L = [_|L], length(L,3). +\end{code} + +Programs that depend on STO cases tend to be inefficient, even +incorrect, are hard to understand and debug, and terminate poorly. It +is therefore advisable to avoid STO programs whenever possible. + +SWI's Prolog flag \prologflag{occurs_check} must not be modified +within plunit tests. + +\end{description} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\subsection{Test Unit options} +\label{sec:unitoptions} + +\begin{description} + \predicate{begin_tests}{1}{+Name} +Start named test-unit. Same as \verb$begin_tests(Name, [])$. + + \predicate{begin_tests}{2}{+Name, +Options} +Start named test-unit with options. Options provide conditional +processing, setup and cleanup similar to individual tests (second +argument of test/2 rules). + +Defined options are: + \begin{description} + \termitem{blocked}{+Reason} +Test-unit has been blocked for the given \arg{Reason}. + + \termitem{condition}{:Goal} +Executed before executing any of the tests. If \arg{Goal} fails, +the test of this unit is skipped. + + \termitem{setup}{:Goal} +Executed before executing any of the tests. + + \termitem{cleanup}{:Goal} +Executed after completion of all tests in the unit. + + \termitem{sto}{+Terms} +Specify default for subject-to-occurs-check mode. See \secref{unitbox} +for details on the sto option. + \end{description} +\end{description} + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\subsection{Writing the test body} +\label{sec:testbody} + +The test-body is ordinary Prolog code. Without any options, the body +must be designed to succeed \emph{deterministically}. Any other result +is considered a failure. One of the options \const{fail}, \const{true}, +\const{throws}, \const{all} or \const{set} can be used to specify a +different expected result. See \secref{unitbox} for details. In this +section we illustrate typical test-scenarios by testing SWI-Prolog +built-in and library predicates. + +\subsubsection{Testing deterministic predicates} +\label{sec:testdet} + +Deterministic predicates are predicates that must succeed exactly once +and, for well behaved predicates, leave no choicepoints. Typically they +have zero or more input- and zero or more output arguments. The test +goal supplies proper values for the input arguments and verifies the +output arguments. Verification can use test-options or be explicit in +the body. The tests in the example below are equivalent. + +\begin{code} +test(add) :- + A is 1 + 2, + A =:= 3. + +test(add, [true(A =:= 3)]) :- + A is 1 + 2. +\end{code} + +The test engine verifies that the test-body does not leave a +choicepoint. We illustrate that using the test below: + +\begin{code} +test(member) :- + member(b, [a,b,c]). +\end{code} + +Although this test succeeds, member/2 leaves a choicepoint which is +reported by the test subsystem. To make the test silent, use one of +the alternatives below. + +\begin{code} +test(member) :- + member(b, [a,b,c]), !. + +test(member, [nondet]) :- + member(b, [a,b,c]). +\end{code} + +\subsubsection{Testing semi-deterministic predicates} +\label{sec:testsemidet} + +Semi-deterministic predicates are predicates that either fail or succeed +exactly once and, for well behaved predicates, leave no choicepoints. +Testing such predicates is the same as testing deterministic +predicates. Negative tests must be specified using the option +\const{fail} or by negating the body using \verb$\+/1$. + +\begin{code} +test(is_set) :- + \+ is_set([a,a]). + +test(is_set, [fail]) :- + is_set([a,a]). +\end{code} + + +\subsubsection{Testing non-deterministic predicates} +\label{sec:testnondet} + +Non-deterministic predicates succeed zero or more times. Their results +are tested either using findall/3 or setof/3 followed by a value-check +or using the \const{all} or \const{set} options. The following are +equivalent tests: + +\begin{code} +test(member) :- + findall(X, member(X, [a,b,c]), Xs), + Xs == [a,b,c]. + +test(member, all(X == [a,b,c])) :- + member(X, [a,b,c]). +\end{code} + +\subsubsection{Testing error conditions} +\label{sec:testerror} + +Error-conditions are tested using the option \term{throws}{Error} or +by wrapping the test in a catch/3. The following tests are equivalent: + +\begin{code} +test(div0) :- + catch(A is 1/0, error(E, _), true), + E =@= evaluation_error(zero_divisor). + +test(div0, [error(evaluation_error(zero_divisor))]) :- + A is 1/0. +\end{code} + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Using separate test files} +\label{sec:testfiles} + +Test-units can be embedded in normal Prolog source-files. Alternatively, +tests for a source-file can be placed in another file alongside the file +to be tested. Test files use the extension \fileext{plt}. The predicate +load_test_files/1 can load all files that are related to source-files +loaded into the current project. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Running the test-suite} +\label{sec:running} + +At any time, the tests can be executed by loading the program and +running run_tests/0 or run_tests(+Unit). + +\begin{description} + \predicate{run_tests}{0}{} +Run all test-units. + + \predicate{run_tests}{1}{+Spec} +Run only the specified tests. \arg{Spec} can be a list to run multiple +tests. A single specification is either the name of a test unit or +a term :, running only the specified test. is +either the name of a test or a list of names. Running particular +tests is particularly useful for tracing a test:% +\footnote{Unfortunately the body of the test is called through +meta-calling, so it cannot be traced. The called user-code can be traced +normally though.} + +\begin{code} +?- gtrace, run_tests(lists:member). +\end{code} +\end{description} + +To identify nonterminating tests, interrupt the looping process with +\emph{Control-C}. The test name and location will be displayed. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Tests and production systems} +\label{sec:state} + +Most applications do not want the test-suite to end up in the +final application. There are several ways to achieve this. One +is to place all tests in separate files and not to load the tests +when creating the production environment. Alternatively, use the +directive below before loading the application. + +\begin{code} +:- set_test_options([load(never)]). +\end{code} + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Controlling the test suite} +\label{sec:options} + +\begin{description} + \predicate{set_test_options}{1}{+Options} +Defined options are: + +\begin{description} + \termitem{load}{+Load} +Determines whether or not tests are loaded. When \const{never}, +everything between begin_tests/1 and end_tests/1 is simply ignored. +When \const{always}, tests are always loaded. Finally, when using +the default value \const{normal}, tests are loaded if the code is +not compiled with optimisation turned on. + + \termitem{run}{+Run} +Specifies when tests are run. Using \const{manual}, tests can only be +run using run_tests/0 or run_tests/1. Using \const{make}, tests will be +run for reloaded files, but not for files loaded the first time. Using +\const{make(all)} make/0 will run all test-suites, not only those that +belong to files that are reloaded. + + \termitem{silent}{+Bool} +When \const{true} (default is \const{false}), send informational +messages using the `silent' level. In practice this means there +is no output except for errors. + + \termitem{sto}{+Bool} +When \const{true} (default \const{false}), assume tests are not subject +to occurs check (non-STO) and verify this if the Prolog implementation +supports testing this. +\end{description} + + \predicate{load_test_files}{1}{+Options} +Load \fileext{plt} test-files that belong to the currently loaded +sources. + + \predicate{running_tests}{0}{} +Print all currently running tests to the terminal. It can be used +to find running thread in multi-threaded test operation or find the +currently running test if a test appears to be blocking. + + \predicate{test_report}{1}{+What} +Print report on the executed tests. \arg{What} defines the type +of report. Currently this only supports \const{fixme}, providing +details on how the fixme-flagged tests proceeded. +\end{description} + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Auto-generating tests} +\label{sec:wizard} + +Prolog is an interactive environment. Where users of non-interactive +systems tend to write tests as code, Prolog developers tend to run +queries interactively during development. This interactive testing is +generally faster, but the disadvantage is that the tests are lost at the +end of the session. The test-wizard tries to combine the advantages. It +collects toplevel queries and saves them to a specified file. Later, +it extracts these queries from the file and locates the predicates that +are tested by the queries. It runs the query and creates a test clause +from the query. + +Auto-generating test cases is experimentally supported through the +library \pllib{test_wizard}. We briefly introduce the functionality +using examples. First step is to log the queries into a file. This is +accomplished with the commands below. \file{Queries.pl} is the name in +which to store all queries. The user can choose any filename for this +purpose. Multiple Prolog instances can share the same name, as data +is appended to this file and write is properly locked to avoid file +corruption. + +\begin{code} +:- use_module(library(test_wizard)). +:- set_prolog_flag(log_query_file, 'Queries.pl'). +\end{code} + +Next, we will illustrate using the library by testing the predicates +from library \pllib{lists}. To generate test cases we just make calls +on the terminal. Note that all queries are recorded and the system will +select the appropriate ones when generating the test unit for a +particular module. + +\begin{code} +?- member(b, [a,b]). +Yes +?- reverse([a,b], [b|A]). +A = [a] ; +No +\end{code} + +Now we can generate the test-cases for the module list using +make_tests/3: + +\begin{code} +?- make_tests(lists, 'Queries.pl', current_output). +:- begin_tests(lists). + +test(member, [nondet]) :- + member(b, [a, b]). +test(reverse, [true(A==[a])]) :- + reverse([a, b], [b|A]). + +:- end_tests(lists). +\end{code} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Coverage analysis} +\label{sec:cover} + +An important aspect of tests is to know which parts of program +is used (\emph{covered}) by the tests. An experimental analysis +is provided by the library \pllib{test_cover}. + +\begin{description} + \predicate{show_coverage}{1}{:Goal} +Run \arg{Goal} and write a report on which percentage of the clauses in +each file are used by the program and which percentage of the clauses +always fail. +\end{description} + +We illustrate this here using CHAT, a natural language question and +answer application by David H.D. Warren and Fernando C.N. Pereira. + +\begin{code} +1 ?- show_coverage(test_chat). +Chat Natural Language Question Answering Test +... + +================================================================== + Coverage by File +================================================================== +File Clauses %Cov %Fail +================================================================== +/staff/jan/lib/prolog/chat/xgrun.pl 5 100.0 0.0 +/staff/jan/lib/prolog/chat/newg.pl 186 89.2 18.3 +/staff/jan/lib/prolog/chat/clotab.pl 28 89.3 0.0 +/staff/jan/lib/prolog/chat/newdic.pl 275 35.6 0.0 +/staff/jan/lib/prolog/chat/slots.pl 128 74.2 1.6 +/staff/jan/lib/prolog/chat/scopes.pl 132 70.5 3.0 +/staff/jan/lib/prolog/chat/templa.pl 67 55.2 1.5 +/staff/jan/lib/prolog/chat/qplan.pl 106 75.5 0.9 +/staff/jan/lib/prolog/chat/talkr.pl 60 20.0 1.7 +/staff/jan/lib/prolog/chat/ndtabl.pl 42 59.5 0.0 +/staff/jan/lib/prolog/chat/aggreg.pl 47 48.9 2.1 +/staff/jan/lib/prolog/chat/world0.pl 131 71.8 1.5 +/staff/jan/lib/prolog/chat/rivers.pl 41 100.0 0.0 +/staff/jan/lib/prolog/chat/cities.pl 76 43.4 0.0 +/staff/jan/lib/prolog/chat/countr.pl 156 100.0 0.0 +/staff/jan/lib/prolog/chat/contai.pl 334 100.0 0.0 +/staff/jan/lib/prolog/chat/border.pl 857 98.6 0.0 +/staff/jan/lib/prolog/chat/chattop.pl 139 43.9 0.7 +================================================================== +\end{code} + +Using \verb$?- show_coverage(run_tests).$, this library currently only +shows some rough quality measure for test-suite. Later versions should +provide a report to the developer identifying which clauses are covered, +not covered and always failed. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Portability of the test-suite} +\label{sec:porting} + +One of the reasons to have tests is to simplify migrating code between +Prolog implementations. Unfortunately creating a portable test-suite +implies a poor integration into the development environment. Luckily, +the specification of the test-system proposed here can be ported quite +easily to most Prolog systems sufficiently compatible to SWI-Prolog to +consider porting your application. Most important is to have support for +term_expansion/2. + +In the current system, test units are compiled into sub-modules of the +module in which they appear. Few Prolog systems allow for sub-modules +and therefore ports may have to fall-back to inject the code in the +surrounding module. This implies that support predicates used inside +the test unit should not conflict with predicates of the module being +tested. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\subsection{PlUnit on SICStus} +\label{sec:sicstus} + +The directory of \file{plunit.pl} and \file{swi.pl} must be in the +\const{library} search-path. With PLUNITDIR replaced accordingly, +add the following into your \file{.sicstusrc} or \file{sicstus.ini}. + +\begin{code} +:- set_prolog_flag(language, iso). % for maximal compatibility +library_directory('PLUNITDIR'). +\end{code} + +The current version runs under SICStus 3. Open issues: + +\begin{itemize} + + \item Some messages are unformatted because SICStus 3 reports + all ISO errors as instantiation errors. + + \item Only \file{plunit.pl}. Both coverage analysis and the test + generation wizard currently require SWI-Prolog. + + \item The \const{load} option \const{normal} is the same as \const{always}. + Use \exam{set_test_options(load, never)} to avoid loading the + test suites. + + \item The \const{run} option is not supported. + + \item Tests are loaded into the enclosing module instead of a separate + test module. This means that predicates in the test module must + not conflict with the enclosing module, nor with other test + modules loaded into the same module. +\end{itemize} + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{Motivation of choices} +\label{sec:motivation} + +\subsection*{Easy to understand and flexible} + +There are two approaches for testing. In one extreme the tests are +written using declarations dealing with setup, cleanup, running and +testing the result. In the other extreme a test is simply a Prolog goal +that is supposed to succeed. We have chosen to allow for any mixture of +these approaches. Written down as test/1 we opt for the simple +succeeding goal approach. Using options to the test the user can choose +for a more declarative specification. The user can mix both approaches. + +The body of the test appears at the position of a clause-body. This +simplifies identification of the test body and ensures proper layout and +colouring support from the editor without the need for explicit support +of the unit test module. Only clauses of test/1 and test/2 may be marked +as non-called in environments that perform cross-referencing. + +%\subsection*{Well integrated} + +\printindex + +\end{document} + diff --git a/packages/plunit/plunit.pl b/packages/plunit/plunit.pl new file mode 100644 index 000000000..89755c391 --- /dev/null +++ b/packages/plunit/plunit.pl @@ -0,0 +1,1510 @@ +/* $Id$ + + Part of SWI-Prolog + + Author: Jan Wielemaker + E-mail: wielemak@science.uva.nl + WWW: http://www.swi-prolog.org + Copyright (C): 2006-2008, University of Amsterdam + + This file is covered by the `The Artistic License', also in use by + Perl. See http://www.perl.com/pub/a/language/misc/Artistic.html +*/ + +:- module(plunit, + [ set_test_options/1, % +Options + begin_tests/1, % +Name + begin_tests/2, % +Name, +Options + end_tests/1, % +Name + run_tests/0, % Run all tests + run_tests/1, % Run named test-set + load_test_files/1, % +Options + running_tests/0, % Prints currently running test + test_report/1 % +What + ]). + +/** Unit Testing + +Unit testing environment for SWI-Prolog and SICStus Prolog. For usage, +please visit http://www.swi-prolog.org/pldoc/package/plunit.html. + +@author Jan Wielemaker +@license artistic +*/ + + /******************************* + * CONDITIONAL COMPILATION * + *******************************/ + +:- discontiguous + user:term_expansion/2. + +:- dynamic + include_code/1. + +:- expects_dialect(swi). + +including :- + include_code(X), !, + X == true. +including. + +if_expansion((:- if(G)), []) :- + ( including + -> ( catch(G, E, (print_message(error, E), fail)) + -> asserta(include_code(true)) + ; asserta(include_code(false)) + ) + ; asserta(include_code(else_false)) + ). +if_expansion((:- else), []) :- + ( retract(include_code(X)) + -> ( X == true + -> X2 = false + ; X == false + -> X2 = true + ; X2 = X + ), + asserta(include_code(X2)) + ; throw_error(context_error(no_if),_) + ). +if_expansion((:- endif), []) :- + retract(include_code(_)), !. + +if_expansion(_, []) :- + \+ including. + +user:term_expansion(In, Out) :- + prolog_load_context(module, plunit), + if_expansion(In, Out). + +swi :- catch(current_prolog_flag(dialect, swi), _, fail), !. +swi :- catch(current_prolog_flag(dialect, yap), _, fail). +sicstus :- catch(current_prolog_flag(system_type, _), _, fail). + + +:- if(swi). + +throw_error(Error_term,Impldef) :- + throw(error(Error_term,Impldef)). + +:- set_prolog_flag(generate_debug_info, false). +:- use_module(library(option)). +:- use_module(library(pairs)). + +current_test_flag(Name, Value) :- + current_prolog_flag(Name, Value). + +set_test_flag(Name, Value) :- + set_prolog_flag(Name, Value). +:- endif. + +:- if(sicstus). +throw_error(Error_term,Impldef) :- + throw(error(Error_term,i(Impldef))). % SICStus 3 work around + +:- if(current_prolog_flag(dialect, sicstus)). +:- use_module(swi). % SWI-Compatibility +:- endif. +:- use_module(library(terms)). +:- op(700, xfx, =@=). + +'$set_source_module'(_, _). + +%% current_test_flag(?Name, ?Value) is nondet. +% +% Query flags that control the testing process. Emulates +% SWI-Prologs flags. + +:- dynamic test_flag/2. % Name, Val + +current_test_flag(optimise, Val) :- + current_prolog_flag(compiling, Compiling), + ( Compiling == debugcode ; true % TBD: Proper test + -> Val = false + ; Val = true + ). +current_test_flag(Name, Val) :- + test_flag(Name, Val). + + +%% set_test_flag(+Name, +Value) is det. + +set_test_flag(Name, Val) :- + var(Name), !, + throw_error(instantiation_error, set_test_flag(Name,Val)). +set_test_flag( Name, Val ) :- + retractall(test_flag(Name,_)), + asserta(test_flag(Name, Val)). + +:- op(1150, fx, thread_local). + +user:term_expansion((:- thread_local(PI)), (:- dynamic(PI))) :- + prolog_load_context(module, plunit). + +:- endif. + + /******************************* + * IMPORTS * + *******************************/ + +:- use_module(library(lists)). + +:- initialization + ( current_test_flag(test_options, _) + -> true + ; set_test_flag(test_options, + [ run(make), % run tests on make/0 + sto(false) + ]) + ). + +%% set_test_options(+Options) +% +% Specifies how to deal with test suites. Defined options are: +% +% * load(+Load) +% Whether or not the tests must be loaded. Values are +% =never=, =always=, =normal= (only if not optimised) +% +% * run(+When) +% When the tests are run. Values are =manual=, =make= +% or make(all). +% +% * silent(+Bool) +% If =true= (default =false=), report successful tests +% using message level =silent=, only printing errors and +% warnings. +% +% * sto(+Bool) +% How to test whether code is subject to occurs check +% (STO). If =false= (default), STO is not considered. +% If =true= and supported by the hosting Prolog, code +% is run in all supported unification mode and reported +% if the results are inconsistent. + +set_test_options(Options) :- + valid_options(Options, global_test_option), + set_test_flag(test_options, Options). + +global_test_option(load(Load)) :- + must_be(oneof([never,always,normal]), Load). +global_test_option(run(When)) :- + must_be(oneof([manual,make,all]), When). +global_test_option(silent(Bool)) :- + must_be(boolean, Bool). +global_test_option(sto(Bool)) :- + must_be(boolean, Bool). + + +%% loading_tests +% +% True if tests must be loaded. + +loading_tests :- + current_test_flag(test_options, Options), + option(load(Load), Options, normal), + ( Load == always + -> true + ; Load == normal, + \+ current_test_flag(optimise, true) + ). + + /******************************* + * MODULE * + *******************************/ + +:- dynamic + loading_unit/4, % Unit, Module, File, OldSource + current_unit/4, % Unit, Module, Context, Options + test_file_for/2. % ?TestFile, ?PrologFile + +%% begin_tests(+UnitName:atom) is det. +%% begin_tests(+UnitName:atom, Options) is det. +% +% Start a test-unit. UnitName is the name of the test set. the +% unit is ended by :- end_tests(UnitName). + +begin_tests(Unit) :- + begin_tests(Unit, []). + +begin_tests(Unit, Options) :- + valid_options(Options, test_set_option), + make_unit_module(Unit, Name), + source_location(File, Line), + begin_tests(Unit, Name, File:Line, Options). + +:- if(swi). +begin_tests(Unit, Name, File:Line, Options) :- + loading_tests, !, + '$set_source_module'(Context, Context), + ( current_unit(Unit, Name, Context, Options) + -> true + ; retractall(current_unit(Unit, Name, _, _)), + assert(current_unit(Unit, Name, Context, Options)) + ), + '$set_source_module'(Old, Name), + '$declare_module'(Name, Context, File, Line, false), + discontiguous(Name:'unit test'/4), + '$set_predicate_attribute'(Name:'unit test'/4, trace, 0), + discontiguous(Name:'unit body'/2), + asserta(loading_unit(Unit, Name, File, Old)). +begin_tests(Unit, Name, File:_Line, _Options) :- + '$set_source_module'(Old, Old), + asserta(loading_unit(Unit, Name, File, Old)). + +set_import_modules(Module, Imports) :- + findall(I, import_module(Module, I), IL), + forall(member(I, IL), delete_import_module(Module, I)), + forall(member(I, Imports), add_import_module(Module, I, end)). + +:- else. + +% we cannot use discontiguous as a goal in SICStus Prolog. + +user:term_expansion((:- begin_tests(Set)), + [ (:- begin_tests(Set)), + (:- discontiguous(test/2)), + (:- discontiguous('unit body'/2)), + (:- discontiguous('unit test'/4)) + ]). + +begin_tests(Unit, Name, File:_Line, Options) :- + loading_tests, !, + ( current_unit(Unit, Name, _, Options) + -> true + ; retractall(current_unit(Unit, Name, _, _)), + assert(current_unit(Unit, Name, -, Options)) + ), + asserta(loading_unit(Unit, Name, File, -)). +begin_tests(Unit, Name, File:_Line, _Options) :- + asserta(loading_unit(Unit, Name, File, -)). + +:- endif. + +%% end_tests(+Name) is det. +% +% Close a unit-test module. +% +% @tbd Run tests/clean module? +% @tbd End of file? + +end_tests(Unit) :- + loading_unit(StartUnit, _, _, _), !, + ( Unit == StartUnit + -> once(retract(loading_unit(StartUnit, _, _, Old))), + '$set_source_module'(_, Old) + ; throw_error(context_error(plunit_close(Unit, StartUnit)), _) + ). +end_tests(Unit) :- + throw_error(context_error(plunit_close(Unit, -)), _). + +%% make_unit_module(+Name, -ModuleName) is det. +%% unit_module(+Name, -ModuleName) is det. + +:- if(swi). + +unit_module(Unit, Module) :- + atom_concat('plunit_', Unit, Module). + +make_unit_module(Unit, Module) :- + unit_module(Unit, Module), + ( current_module(Module), + \+ current_unit(_, Module, _, _) + -> throw_error(permission_error(create, plunit, Unit), + 'Existing module') + ; true + ). + +:- else. + +:- dynamic + unit_module_store/2. + +unit_module(Unit, Module) :- + unit_module_store(Unit, Module), !. + +make_unit_module(Unit, Module) :- + prolog_load_context(module, Module), + assert(unit_module_store(Unit, Module)). + +:- endif. + + /******************************* + * EXPANSION * + *******************************/ + +%% expand_test(+Name, +Options, +Body, -Clause) is det. +% +% Expand test(Name, Options) :- Body into a clause for +% 'unit test'/4 and 'unit body'/2. + +expand_test(Name, Options0, Body, + [ 'unit test'(Name, Line, Options, Module:'unit body'(Id, Vars)), + ('unit body'(Id, Vars) :- !, Body) + ]) :- + source_location(_File, Line), + prolog_load_context(module, Module), + atomic_list_concat([Name, '@line ', Line], Id), + term_variables(Body, VarList), + Vars =.. [vars|VarList], + ( is_list(Options0) % allow for single option without list + -> Options1 = Options0 + ; Options1 = [Options0] + ), + maplist(expand_option, Options1, Options), + valid_options(Options, test_option). + +expand_option(Var, _) :- + var(Var), !, + throw_error(instantiation_error,_). +expand_option(A == B, true(A==B)) :- !. +expand_option(A = B, true(A=B)) :- !. +expand_option(A =@= B, true(A=@=B)) :- !. +expand_option(A =:= B, true(A=:=B)) :- !. +expand_option(O, O). + + +%% expand(+Term, -Clauses) is semidet. + +expand(end_of_file, _) :- + loading_unit(Unit, _, _, _), !, + end_tests(Unit), % warn? + fail. +expand(_Term, []) :- + \+ loading_tests. +expand((test(Name) :- Body), Clauses) :- !, + expand_test(Name, [], Body, Clauses). +expand((test(Name, Options) :- Body), Clauses) :- !, + expand_test(Name, Options, Body, Clauses). +expand(test(Name), _) :- !, + throw_error(existence_error(body, test(Name)), _). +expand(test(Name, _Options), _) :- !, + throw_error(existence_error(body, test(Name)), _). + +:- if(swi). +:- multifile + user:term_expansion/2. +:- endif. + +user:term_expansion(Term, Expanded) :- + ( loading_unit(_, _, File, _) + -> source_location(File, _), + expand(Term, Expanded) + ). + + + /******************************* + * OPTIONS * + *******************************/ + +:- if(swi). +:- use_module(library(error)). +:- else. +must_be(list, X) :- !, + ( is_list(X) + -> true + ; is_not(list, X) + ). +must_be(Type, X) :- + ( call(Type, X) + -> true + ; is_not(Type, X) + ). + +is_not(Type, X) :- + ( ground(X) + -> throw_error(type_error(Type, X), _) + ; throw_error(instantiation_error, _) + ). +:- endif. + +%% valid_options(+Options, :Pred) is det. +% +% Verify Options to be a list of valid options according to +% Pred. +% +% @throws =type_error= or =instantiation_error=. + +valid_options(Options, Pred) :- + must_be(list, Options), + verify_options(Options, Pred). + +verify_options([], _). +verify_options([H|T], Pred) :- + ( call(Pred, H) + -> verify_options(T, Pred) + ; throw_error(domain_error(Pred, H), _) + ). + + +%% test_option(+Option) is semidet. +% +% True if Option is a valid option for test(Name, Options). + +test_option(Option) :- + test_set_option(Option), !. +test_option(true(_)). +test_option(fail). +test_option(true). +test_option(throws(_)). +test_option(error(_)). +test_option(all(_)). +test_option(set(_)). +test_option(nondet). +test_option(fixme(_)). +test_option(forall(X)) :- + must_be(callable, X). + +%% test_option(+Option) is semidet. +% +% True if Option is a valid option for :- begin_tests(Name, +% Options). + +test_set_option(blocked(X)) :- + must_be(ground, X). +test_set_option(condition(X)) :- + must_be(callable, X). +test_set_option(setup(X)) :- + must_be(callable, X). +test_set_option(cleanup(X)) :- + must_be(callable, X). +test_set_option(sto(V)) :- + nonvar(V), member(V, [finite_trees, rational_trees]). + + + /******************************* + * RUNNING TOPLEVEL * + *******************************/ + +:- thread_local + passed/5, % Unit, Test, Line, Det, Time + failed/4, % Unit, Test, Line, Reason + blocked/4, % Unit, Test, Line, Reason + sto/4, % Unit, Test, Line, Results + fixme/5. % Unit, Test, Line, Reason, Status + +:- dynamic + running/5. % Unit, Test, Line, STO, Thread + +%% run_tests is semidet. +%% run_tests(+TestSet) is semidet. + +run_tests :- + cleanup, + forall(current_test_set(Set), + run_unit(Set)), + report. + +run_tests(Set) :- + cleanup, + run_unit(Set), + report. + +run_unit([]) :- !. +run_unit([H|T]) :- !, + run_unit(H), + run_unit(T). +run_unit(Spec) :- + unit_from_spec(Spec, Unit, Tests, Module, UnitOptions), + ( option(blocked(Reason), UnitOptions) + -> info(plunit(blocked(unit(Unit, Reason)))) + ; setup(Module, unit(Unit), UnitOptions) + -> info(plunit(begin(Spec))), + forall((Module:'unit test'(Name, Line, Options, Body), + matching_test(Name, Tests)), + run_test(Unit, Name, Line, Options, Body)), + info(plunit(end(Spec))), + ( message_level(silent) + -> true + ; format(user_error, '~N', []) + ), + cleanup(Module, UnitOptions) + ; true + ). + +unit_from_spec(Unit, Unit, _, Module, Options) :- + atom(Unit), !, + ( current_unit(Unit, Module, _Supers, Options) + -> true + ; throw_error(existence_error(unit_test, Unit), _) + ). +unit_from_spec(Unit:Tests, Unit, Tests, Module, Options) :- + atom(Unit), !, + ( current_unit(Unit, Module, _Supers, Options) + -> true + ; throw_error(existence_error(unit_test, Unit), _) + ). + + +matching_test(X, X) :- !. +matching_test(Name, Set) :- + is_list(Set), + memberchk(Name, Set). + +cleanup :- + thread_self(Me), + retractall(passed(_, _, _, _, _)), + retractall(failed(_, _, _, _)), + retractall(blocked(_, _, _, _)), + retractall(sto(_, _, _, _)), + retractall(fixme(_, _, _, _, _)), + retractall(running(_,_,_,_,Me)). + + +%% run_tests_in_files(+Files:list) is det. +% +% Run all test-units that appear in the given Files. + +run_tests_in_files(Files) :- + findall(Unit, unit_in_files(Files, Unit), Units), + ( Units == [] + -> true + ; run_tests(Units) + ). + +unit_in_files(Files, Unit) :- + is_list(Files), !, + member(F, Files), + absolute_file_name(F, Source, + [ file_type(prolog), + access(read), + file_errors(fail) + ]), + unit_file(Unit, Source). + + + /******************************* + * HOOKING MAKE/0 * + *******************************/ + +%% make_run_tests(+Files) +% +% Called indirectly from make/0 after Files have been reloaded. + +make_run_tests(Files) :- + current_test_flag(test_options, Options), + option(run(When), Options, manual), + ( When == make + -> run_tests_in_files(Files) + ; When == make(all) + -> run_tests + ; true + ). + +:- if(swi). + +unification_capability(sto_error_incomplete). +% can detect some (almost all) STO runs +unification_capability(rational_trees). +unification_capability(finite_trees). + +set_unification_capability(Cap) :- + cap_to_flag(Cap, Flag), + set_prolog_flag(occurs_check, Flag). + +current_unification_capability(Cap) :- + current_prolog_flag(occurs_check, Flag), + cap_to_flag(Cap, Flag), !. + +cap_to_flag(sto_error_incomplete, error). +cap_to_flag(rational_trees, false). +cap_to_flag(finite_trees, true). + +:- else. +:- if(sicstus). + +unification_capability(rational_trees). +set_unification_capability(rational_trees). +current_unification_capability(rational_trees). + +:- else. + +unification_capability(_) :- + fail. + +:- endif. +:- endif. + + + /******************************* + * RUNNING A TEST * + *******************************/ + +%% run_test(+Unit, +Name, +Line, +Options, +Body) is det. +% +% Run a single test. + +run_test(Unit, Name, Line, Options, Body) :- + option(forall(Generator), Options), !, + unit_module(Unit, Module), + term_variables(Generator, Vars), + forall(Module:Generator, + run_test_once(Unit, @(Name,Vars), Line, Options, Body)). +run_test(Unit, Name, Line, Options, Body) :- + run_test_once(Unit, Name, Line, Options, Body). + +run_test_once(Unit, Name, Line, Options, Body) :- + current_test_flag(test_options, GlobalOptions), + option(sto(false), GlobalOptions, false), !, + run_test_6(Unit, Name, Line, Options, Body, Result), + report_result(Result, Options). +run_test_once(Unit, Name, Line, Options, Body) :- + current_unit(Unit, _Module, _Supers, UnitOptions), + option(sto(Type), UnitOptions), + \+ option(sto(_), Options), !, + current_unification_capability(Cap0), + call_cleanup(run_test_cap(Unit, Name, Line, [sto(Type)|Options], Body), + set_unification_capability(Cap0)). +run_test_once(Unit, Name, Line, Options, Body) :- + current_unification_capability(Cap0), + call_cleanup(run_test_cap(Unit, Name, Line, Options, Body), + set_unification_capability(Cap0)). + +run_test_cap(Unit, Name, Line, Options, Body) :- + ( option(sto(Type), Options) + -> unification_capability(Type), + set_unification_capability(Type), + run_test_6(Unit, Name, Line, Options, Body, Result), + report_result(Result, Options) + ; findall(Key-(Type+Result), + test_caps(Type, Unit, Name, Line, Options, Body, Result, Key), + Pairs), + group_pairs_by_key(Pairs, Keyed), + ( Keyed == [] + -> true + ; Keyed = [_-Results] + -> Results = [_Type+Result|_], + report_result(Result, Options) % consistent results + ; pairs_values(Pairs, ResultByType), + report_result(sto(Unit, Name, Line, ResultByType), Options) + ) + ). + +%% test_caps(-Type, +Unit, +Name, +Line, +Options, +Body, -Result, -Key) is nondet. + +test_caps(Type, Unit, Name, Line, Options, Body, Result, Key) :- + unification_capability(Type), + set_unification_capability(Type), + begin_test(Unit, Name, Line, Type), + run_test_6(Unit, Name, Line, Options, Body, Result), + end_test(Unit, Name, Line, Type), + result_to_key(Result, Key), + Key \== setup_failed. + +result_to_key(blocked(_, _, _, _), blocked). +result_to_key(failure(_, _, _, How0), failure(How1)) :- + ( How0 = succeeded(_T) -> How1 = succeeded ; How0 = How1 ). +result_to_key(success(_, _, _, Determinism, _), success(Determinism)). +result_to_key(setup_failed(_,_,_), setup_failed). + +report_result(blocked(Unit, Name, Line, Reason), _) :- !, + assert(blocked(Unit, Name, Line, Reason)). +report_result(failure(Unit, Name, Line, How), Options) :- !, + failure(Unit, Name, Line, How, Options). +report_result(success(Unit, Name, Line, Determinism, Time), Options) :- !, + success(Unit, Name, Line, Determinism, Time, Options). +report_result(setup_failed(_Unit, _Name, _Line), _Options). +report_result(sto(Unit, Name, Line, ResultByType), Options) :- + assert(sto(Unit, Name, Line, ResultByType)), + print_message(error, plunit(sto(Unit, Name, Line))), + report_sto_results(ResultByType, Options). + +report_sto_results([], _). +report_sto_results([Type+Result|T], Options) :- + print_message(error, plunit(sto(Type, Result))), + report_sto_results(T, Options). + + +%% run_test_6(+Unit, +Name, +Line, +Options, :Body, -Result) is det. +% +% Result is one of: +% +% * blocked(Unit, Name, Line, Reason) +% * failure(Unit, Name, Line, How) +% * success(Unit, Name, Line, Determinism, Time) +% * setup_failed(Unit, Name, Line) + +run_test_6(Unit, Name, Line, Options, _Body, + blocked(Unit, Name, Line, Reason)) :- + option(blocked(Reason), Options), !. +run_test_6(Unit, Name, Line, Options, Body, Result) :- + option(all(Answer), Options), !, % all(Bindings) + nondet_test(all(Answer), Unit, Name, Line, Options, Body, Result). +run_test_6(Unit, Name, Line, Options, Body, Result) :- + option(set(Answer), Options), !, % set(Bindings) + nondet_test(set(Answer), Unit, Name, Line, Options, Body, Result). +run_test_6(Unit, Name, Line, Options, Body, Result) :- + option(fail, Options), !, % fail + unit_module(Unit, Module), + ( setup(Module, test(Unit,Name,Line), Options) + -> statistics(runtime, [T0,_]), + ( catch(Module:Body, E, true) + -> ( var(E) + -> statistics(runtime, [T1,_]), + Time is (T1 - T0)/1000.0, + Result = failure(Unit, Name, Line, succeeded(Time)), + cleanup(Module, Options) + ; Result = failure(Unit, Name, Line, E), + cleanup(Module, Options) + ) + ; statistics(runtime, [T1,_]), + Time is (T1 - T0)/1000.0, + Result = success(Unit, Name, Line, true, Time), + cleanup(Module, Options) + ) + ; Result = setup_failed(Unit, Name, Line) + ). +run_test_6(Unit, Name, Line, Options, Body, Result) :- + option(true(Cmp), Options), !, + unit_module(Unit, Module), + ( setup(Module, test(Unit,Name,Line), Options) % true(Binding) + -> statistics(runtime, [T0,_]), + ( catch(call_det(Module:Body, Det), E, true) + -> ( var(E) + -> statistics(runtime, [T1,_]), + Time is (T1 - T0)/1000.0, + ( catch(Cmp, _, fail) % tbd: error + -> Result = success(Unit, Name, Line, Det, Time) + ; Result = failure(Unit, Name, Line, wrong_answer(Cmp)) + ), + cleanup(Module, Options) + ; Result = failure(Unit, Name, Line, E), + cleanup(Module, Options) + ) + ; Result = failure(Unit, Name, Line, failed), + cleanup(Module, Options) + ) + ; Result = setup_failed(Unit, Name, Line) + ). +run_test_6(Unit, Name, Line, Options, Body, Result) :- + ( option(throws(Expect), Options) + -> true + ; option(error(ErrorExpect), Options) + -> Expect = error(ErrorExpect, _) + ), !, + unit_module(Unit, Module), + ( setup(Module, test(Unit,Name,Line), Options) + -> statistics(runtime, [T0,_]), + ( catch(Module:Body, E, true) + -> ( var(E) + -> Result = failure(Unit, Name, Line, no_exception), + cleanup(Module, Options) + ; statistics(runtime, [T1,_]), + Time is (T1 - T0)/1000.0, + ( match_error(Expect, E) + -> Result = success(Unit, Name, Line, true, Time) + ; Result = failure(Unit, Name, Line, wrong_error(Expect, E)) + ), + cleanup(Module, Options) + ) + ; Result = failure(Unit, Name, Line, failed), + cleanup(Module, Options) + ) + ; Result = setup_failed(Unit, Name, Line) + ). +run_test_6(Unit, Name, Line, Options, Body, Result) :- + unit_module(Unit, Module), + ( setup(Module, test(Unit,Name,Line), Options) + -> statistics(runtime, [T0,_]), + ( catch(call_det(Module:Body, Det), E, true) + -> ( var(E) + -> statistics(runtime, [T1,_]), + Time is (T1 - T0)/1000.0, + Result = success(Unit, Name, Line, Det, Time), + cleanup(Module, Options) + ; Result = failure(Unit, Name, Line, E), + cleanup(Module, Options) + ) + ; Result = failure(Unit, Name, Line, failed), + cleanup(Module, Options) + ) + ; Result = setup_failed(Unit, Name, Line) + ). + + +%% non_det_test(+Expected, +Unit, +Name, +Line, +Options, +Body, -Result) +% +% Run tests on non-deterministic predicates. + +nondet_test(Expected, Unit, Name, Line, Options, Body, Result) :- + unit_module(Unit, Module), + result_vars(Expected, Vars), + statistics(runtime, [T0,_]), + ( setup(Module, test(Unit,Name,Line), Options) + -> ( catch(findall(Vars, Module:Body, Bindings), E, true) + -> ( var(E) + -> statistics(runtime, [T1,_]), + Time is (T1 - T0)/1000.0, + ( nondet_compare(Expected, Bindings, Unit, Name, Line) + -> Result = success(Unit, Name, Line, true, Time) + ; Result = failure(Unit, Name, Line, wrong_answer) + ), + cleanup(Module, Options) + ; Result = failure(Unit, Name, Line, E), + cleanup(Module, Options) + ) + ) + ; Result = setup_failed(Unit, Name, Line) + ). + + +%% result_vars(+Expected, -Vars) is det. +% +% Create a term v(V1, ...) containing all variables at the left +% side of the comparison operator on Expected. + +result_vars(Expected, Vars) :- + arg(1, Expected, CmpOp), + arg(1, CmpOp, Vars). + +%% nondet_compare(+Expected, +Bindings, +Unit, +Name, +Line) is semidet. +% +% Compare list/set results for non-deterministic predicates. +% +% @tbd Properly report errors +% @bug Sort should deal with equivalence on the comparison +% operator. + +nondet_compare(all(Cmp), Bindings, _Unit, _Name, _Line) :- + cmp(Cmp, _Vars, Op, Values), + cmp_list(Values, Bindings, Op). +nondet_compare(set(Cmp), Bindings0, _Unit, _Name, _Line) :- + cmp(Cmp, _Vars, Op, Values0), + sort(Bindings0, Bindings), + sort(Values0, Values), + cmp_list(Values, Bindings, Op). + +cmp_list([], [], _Op). +cmp_list([E0|ET], [V0|VT], Op) :- + call(Op, E0, V0), + cmp_list(ET, VT, Op). + +%% cmp(+CmpTerm, -Left, -Op, -Right) is det. + +cmp(Var == Value, Var, ==, Value). +cmp(Var =:= Value, Var, =:=, Value). +cmp(Var = Value, Var, =, Value). +:- if(swi). +cmp(Var =@= Value, Var, =@=, Value). +:- else. +:- if(sicstus). +cmp(Var =@= Value, Var, variant, Value). % variant/2 is the same =@= +:- endif. +:- endif. + + +%% call_det(:Goal, -Det) is nondet. +% +% True if Goal succeeded. Det is unified to =true= if Goal left +% no choicepoints and =false= otherwise. + +:- if((swi|sicstus)). +call_det(Goal, Det) :- + call_cleanup(Goal,Det0=true), + ( var(Det0) -> Det = false ; Det = true ). +:- else. +call_det(Goal, true) :- + call(Goal). +:- endif. + +%% match_error(+Expected, +Received) is semidet. +% +% True if the Received errors matches the expected error. Matching +% is based on subsumes_chk/2. + +match_error(Expect, Rec) :- + subsumes_chk(Expect, Rec). + +%% setup(+Module, +Context, +Options) is semidet. +% +% Call the setup handler and fail if it cannot run for some +% reason. The condition handler is similar, but failing is not +% considered an error. Context is one of +% +% * unit(Unit) +% If it is the setup handler for a unit +% * test(Unit,Name,Line) +% If it is the setup handler for a test + +setup(Module, Context, Options) :- + option(condition(Condition), Options), + option(setup(Setup), Options), !, + setup(Module, Context, [condition(Condition)]), + setup(Module, Context, [setup(Setup)]). +setup(Module, Context, Options) :- + option(setup(Setup), Options), !, + ( catch(call_ex(Module, Setup), E, true) + -> ( var(E) + -> true + ; print_message(error, plunit(error(setup, Context, E))), + fail + ) + ; print_message(error, error(goal_failed(Setup), _)), + fail + ). +setup(Module, Context, Options) :- + option(condition(Setup), Options), !, + ( catch(call_ex(Module, Setup), E, true) + -> ( var(E) + -> true + ; print_message(error, plunit(error(condition, Context, E))), + fail + ) + ; fail + ). +setup(_,_,_). + +%% call_ex(+Module, +Goal) +% +% Call Goal in Module after applying goal expansion. + +call_ex(Module, Goal) :- + Module:(expand_goal(Goal, GoalEx), + GoalEx). + +%% cleanup(+Module, +Options) is det. +% +% Call the cleanup handler and succeed. Failure or error of the +% cleanup handler is reported, but tests continue normally. + +cleanup(Module, Options) :- + option(cleanup(Cleanup), Options, true), + ( catch(call_ex(Module, Cleanup), E, true) + -> ( var(E) + -> true + ; print_message(warning, E) + ) + ; print_message(warning, goal_failed(Cleanup, '(cleanup handler)')) + ). + +success(Unit, Name, Line, Det, _Time, Options) :- + memberchk(fixme(Reason), Options), !, + ( ( Det == true + ; memberchk(nondet, Options) + ) + -> put_char(user_error, +), + Ok = passed + ; put_char(user_error, !), + Ok = nondet + ), + flush_output(user_error), + assert(fixme(Unit, Name, Line, Reason, Ok)). +success(Unit, Name, Line, Det, Time, Options) :- + assert(passed(Unit, Name, Line, Det, Time)), + ( ( Det == true + ; memberchk(nondet, Options) + ) + -> put_char(user_error, .) + ; unit_file(Unit, File), + print_message(warning, plunit(nondet(File, Line, Name))) + ), + flush_output(user_error). + +failure(Unit, Name, Line, _, Options) :- + memberchk(fixme(Reason), Options), !, + put_char(user_error, -), + flush_output(user_error), + assert(fixme(Unit, Name, Line, Reason, failed)). +failure(Unit, Name, Line, E, Options) :- + report_failure(Unit, Name, Line, E, Options), + assert_cyclic(failed(Unit, Name, Line, E)). + +%% assert_cyclic(+Term) is det. +% +% Assert a possibly cyclic unit clause. Current SWI-Prolog +% assert/1 does not handle cyclic terms, so we emulate this using +% the recorded database. +% +% @tbd Implement cycle-safe assert and remove this. + +:- if(swi). +assert_cyclic(Term) :- + acyclic_term(Term), !, + assert(Term). +assert_cyclic(Term) :- + Term =.. [Functor|Args], + recorda(cyclic, Args, Id), + functor(Term, _, Arity), + length(NewArgs, Arity), + Head =.. [Functor|NewArgs], + assert((Head :- recorded(_, Var, Id), Var = NewArgs)). +:- else. +:- if(sicstus). +:- endif. +assert_cyclic(Term) :- + assert(Term). +:- endif. + + + /******************************* + * REPORTING * + *******************************/ + +%% begin_test(Unit, Test, Line, STO) is det. +%% end_test(Unit, Test, Line, STO) is det. +% +% Maintain running/5 and report a test has started/is ended using +% a =silent= message: +% +% * plunit(begin(Unit:Test, File:Line, STO)) +% * plunit(end(Unit:Test, File:Line, STO)) +% +% @see message_hook/3 for intercepting these messages + +begin_test(Unit, Test, Line, STO) :- + thread_self(Me), + assert(running(Unit, Test, Line, STO, Me)), + unit_file(Unit, File), + print_message(silent, plunit(begin(Unit:Test, File:Line, STO))). + +end_test(Unit, Test, Line, STO) :- + thread_self(Me), + retractall(running(_,_,_,_,Me)), + unit_file(Unit, File), + print_message(silent, plunit(end(Unit:Test, File:Line, STO))). + +%% running_tests is det. +% +% Print the currently running test. + +running_tests :- + running_tests(Running), + print_message(informational, plunit(running(Running))). + +running_tests(Running) :- + findall(running(Unit:Test, File:Line, STO, Thread), + ( running(Unit, Test, Line, STO, Thread), + unit_file(Unit, File) + ), Running). + + +%% report is semidet. +% +% True if there are no errors. If errors were encountered, report +% them to current output and fail. + +report :- + number_of_clauses(passed/5, Passed), + number_of_clauses(failed/4, Failed), + number_of_clauses(blocked/4, Blocked), + number_of_clauses(sto/4, STO), + ( Passed+Failed+Blocked+STO =:= 0 + -> info(plunit(no_tests)) + ; Failed+Blocked+STO =:= 0 + -> report_fixme, + info(plunit(all_passed(Passed))) + ; report_blocked, + report_fixme, + report_failed, + report_sto + ). + +number_of_clauses(F/A,N) :- + ( current_predicate(F/A) + -> functor(G,F,A), + findall(t, G, Ts), + length(Ts, N) + ; N = 0 + ). + +report_blocked :- + number_of_clauses(blocked/4,N), + N > 0, !, + info(plunit(blocked(N))), + ( blocked(Unit, Name, Line, Reason), + unit_file(Unit, File), + print_message(informational, + plunit(blocked(File:Line, Name, Reason))), + fail ; true + ). +report_blocked. + +report_failed :- + number_of_clauses(failed/4, N), + N > 0, !, + info(plunit(failed(N))), + fail. +report_failed :- + info(plunit(failed(0))). + +report_sto :- + number_of_clauses(sto/4, N), + N > 0, !, + info(plunit(sto(N))), + fail. +report_sto :- + info(plunit(sto(0))). + +report_fixme :- + report_fixme(_,_,_). + +report_fixme(TuplesF, TuplesP, TuplesN) :- + fixme(failed, TuplesF, Failed), + fixme(passed, TuplesP, Passed), + fixme(nondet, TuplesN, Nondet), + print_message(informational, plunit(fixme(Failed, Passed, Nondet))). + + +fixme(How, Tuples, Count) :- + findall(fixme(Unit, Name, Line, Reason, How), + fixme(Unit, Name, Line, Reason, How), Tuples), + length(Tuples, Count). + + +report_failure(Unit, Name, Line, Error, _Options) :- + print_message(error, plunit(failed(Unit, Name, Line, Error))). + + +%% test_report(What) is det. +% +% Produce reports on test results after the run. + +test_report(fixme) :- !, + report_fixme(TuplesF, TuplesP, TuplesN), + append([TuplesF, TuplesP, TuplesN], Tuples), + print_message(informational, plunit(fixme(Tuples))). +test_report(What) :- + throw_error(domain_error(report_class, What), _). + + + /******************************* + * INFO * + *******************************/ + +%% current_test_set(?Unit) is nondet. +% +% True if Unit is a currently loaded test-set. + +current_test_set(Unit) :- + current_unit(Unit, _Module, _Context, _Options). + +%% unit_file(+Unit, -File) is det. +%% unit_file(-Unit, +File) is nondet. + +unit_file(Unit, File) :- + current_unit(Unit, Module, _Context, _Options), + current_module(Module, File). +unit_file(Unit, PlFile) :- + nonvar(PlFile), + test_file_for(TestFile, PlFile), + current_module(Module, TestFile), + current_unit(Unit, Module, _Context, _Options). + + + /******************************* + * FILES * + *******************************/ + +%% load_test_files(+Options) is det. +% +% Load .plt test-files related to loaded source-files. + +load_test_files(_Options) :- + ( source_file(File), + file_name_extension(Base, Old, File), + Old \== plt, + file_name_extension(Base, plt, TestFile), + exists_file(TestFile), + ( test_file_for(TestFile, File) + -> true + ; load_files(TestFile, + [ if(changed), + imports([]) + ]), + asserta(test_file_for(TestFile, File)) + ), + fail ; true + ). + + + + /******************************* + * MESSAGES * + *******************************/ + +%% info(+Term) +% +% Runs print_message(Level, Term), where Level is one of =silent= +% or =informational= (default). + +info(Term) :- + message_level(Level), + print_message(Level, Term). + +message_level(Level) :- + current_test_flag(test_options, Options), + option(silent(Silent), Options, false), + ( Silent == false + -> Level = informational + ; Level = silent + ). + +locationprefix(File:Line) --> !, + [ '~w:~d:\n\t'-[File,Line]]. +locationprefix(test(Unit,_Test,Line)) --> !, + { unit_file(Unit, File) }, + locationprefix(File:Line). +locationprefix(unit(Unit)) --> !, + [ 'PL-Unit: unit ~w: '-[Unit] ]. +locationprefix(FileLine) --> + { throw_error(type_error(locationprefix,FileLine), _) }. + +message(error(context_error(plunit_close(Name, -)), _)) --> + [ 'PL-Unit: cannot close unit ~w: no open unit'-[Name] ]. +message(error(context_error(plunit_close(Name, Start)), _)) --> + [ 'PL-Unit: cannot close unit ~w: current unit is ~w'-[Name, Start] ]. +message(plunit(nondet(File, Line, Name))) --> + locationprefix(File:Line), + [ 'PL-Unit: Test ~w: Test succeeded with choicepoint'- [Name] ]. + % Unit start/end +:- if(swi). +message(plunit(begin(Unit))) --> + [ 'PL-Unit: ~w '-[Unit], flush ]. +message(plunit(end(_Unit))) --> + [ at_same_line, ' done' ]. +:- else. +message(plunit(begin(Unit))) --> + [ 'PL-Unit: ~w '-[Unit]/*, flush-[]*/ ]. +message(plunit(end(_Unit))) --> + [ ' done'-[] ]. +:- endif. +message(plunit(blocked(unit(Unit, Reason)))) --> + [ 'PL-Unit: ~w blocked: ~w'-[Unit, Reason] ]. +message(plunit(running([]))) --> !, + [ 'PL-Unit: no tests running' ]. +message(plunit(running([One]))) --> !, + [ 'PL-Unit: running ' ], + running(One). +message(plunit(running(More))) --> !, + [ 'PL-Unit: running tests:', nl ], + running(More). +message(plunit(fixme([]))) --> !. +message(plunit(fixme(Tuples))) --> !, + fixme_message(Tuples). + + % Blocked tests +message(plunit(blocked(1))) --> !, + [ 'one test is blocked:'-[] ]. +message(plunit(blocked(N))) --> + [ '~D tests are blocked:'-[N] ]. +message(plunit(blocked(Pos, Name, Reason))) --> + locationprefix(Pos), + test_name(Name), + [ ': ~w'-[Reason] ]. + + % fail/success +message(plunit(no_tests)) --> !, + [ 'No tests to run' ]. +message(plunit(all_passed(Count))) --> !, + [ 'All ~D tests passed'-[Count] ]. +message(plunit(failed(0))) --> !, + []. +message(plunit(failed(1))) --> !, + [ '1 test failed'-[] ]. +message(plunit(failed(N))) --> + [ '~D tests failed'-[N] ]. +message(plunit(sto(0))) --> !, + []. +message(plunit(sto(N))) --> + [ '~D test results depend on unification mode'-[N] ]. +message(plunit(fixme(0,0,0))) --> + []. +message(plunit(fixme(Failed,0,0))) --> !, + [ 'all ~D tests flagged FIXME failed'-[Failed] ]. +message(plunit(fixme(Failed,Passed,0))) --> + [ 'FIXME: ~D failed; ~D passed'-[Failed, Passed] ]. +message(plunit(fixme(Failed,Passed,Nondet))) --> + { TotalPassed is Passed+Nondet }, + [ 'FIXME: ~D failed; ~D passed; (~D nondet)'-[Failed, TotalPassed, Nondet] ]. +message(plunit(failed(Unit, Name, Line, Failure))) --> + { unit_file(Unit, File) }, + locationprefix(File:Line), + test_name(Name), + [': '-[] ], + failure(Failure). + % Setup/condition errors +message(plunit(error(Where, Context, Exception))) --> + locationprefix(Context), + { message_to_string(Exception, String) }, + [ 'error in ~w: ~w'-[Where, String] ]. + + % STO messages +message(plunit(sto(Unit, Name, Line))) --> + { unit_file(Unit, File) }, + locationprefix(File:Line), + test_name(Name), + [' is subject to occurs check (STO): '-[] ]. +message(plunit(sto(Type, Result))) --> + sto_type(Type), + sto_result(Result). + + % Interrupts (SWI) +:- if(swi). +message(interrupt(begin)) --> + { thread_self(Me), + running(Unit, Test, Line, STO, Me), !, + unit_file(Unit, File) + }, + [ 'Interrupted test '-[] ], + running(running(Unit:Test, File:Line, STO, Me)), + [nl], + '$messages':prolog_message(interrupt(begin)). +message(interrupt(begin)) --> + '$messages':prolog_message(interrupt(begin)). +:- endif. + +test_name(@(Name,Bindings)) --> !, + [ 'test ~w (forall bindings = ~p)'-[Name, Bindings] ]. +test_name(Name) --> !, + [ 'test ~w'-[Name] ]. + +sto_type(sto_error_incomplete) --> + [ 'Finite trees (error checking): ' ]. +sto_type(rational_trees) --> + [ 'Rational trees: ' ]. +sto_type(finite_trees) --> + [ 'Finite trees: ' ]. + +sto_result(success(_Unit, _Name, _Line, Det, Time)) --> + det(Det), + [ ' success in ~2f seconds'-[Time] ]. +sto_result(failure(_Unit, _Name, _Line, How)) --> + failure(How). + +det(true) --> + [ 'deterministic' ]. +det(false) --> + [ 'non-deterministic' ]. + +running(running(Unit:Test, File:Line, STO, Thread)) --> + thread(Thread), + [ '~q:~q at ~w:~d'-[Unit, Test, File, Line] ], + current_sto(STO). +running([H|T]) --> + ['\t'], running(H), + ( {T == []} + -> [] + ; [nl], running(T) + ). + +thread(main) --> !. +thread(Other) --> + [' [~w] '-[Other] ]. + +current_sto(sto_error_incomplete) --> + [ ' (STO: error checking)' ]. +current_sto(rational_trees) --> + []. +current_sto(finite_trees) --> + [ ' (STO: occurs check enabled)' ]. + +:- if(swi). +write_term(T, OPS) --> + ['~@'-[write_term(T,OPS)]]. +:- else. +write_term(T, _OPS) --> + ['~q'-[T]]. +:- endif. + +expected_got_ops_(Ex, E, OPS, Goals) --> + [' Expected: '-[]], write_term(Ex, OPS), [nl], + [' Got: '-[]], write_term(E, OPS), [nl], + ( { Goals = [] } -> [] + ; [' with: '-[]], write_term(Goals, OPS), [nl] + ). + + +failure(Var) --> + { var(Var) }, !, + [ 'Unknown failure?' ]. +failure(succeeded(Time)) --> !, + [ 'must fail but succeeded in ~2f seconds~n'-[Time] ]. +failure(wrong_error(Expected, Error)) --> !, + { copy_term(Expected-Error, Ex-E, Goals), + numbervars(Ex-E-Goals, 0, _), + write_options(OPS) + }, + [ 'wrong error'-[], nl ], + expected_got_ops_(Ex, E, OPS, Goals). +failure(wrong_answer(Cmp)) --> + { Cmp =.. [Op,Answer,Expected], !, + copy_term(Expected-Answer, Ex-A, Goals), + numbervars(Ex-A-Goals, 0, _), + write_options(OPS) + }, + [ 'wrong answer (compared using ~w)'-[Op], nl ], + expected_got_ops_(Ex, A, OPS, Goals). +:- if(swi). +failure(Error) --> + { Error = error(_,_), !, + message_to_string(Error, Message) + }, + [ 'received error: ~w'-[Message] ]. +:- endif. +failure(Why) --> + [ '~p~n'-[Why] ]. + +fixme_message([]) --> []. +fixme_message([fixme(Unit, _Name, Line, Reason, How)|T]) --> + { unit_file(Unit, File) }, + fixme_message(File:Line, Reason, How), + ( {T == []} + -> [] + ; [nl], + fixme_message(T) + ). + +fixme_message(Location, Reason, failed) --> + [ 'FIXME: ~w: ~w'-[Location, Reason] ]. +fixme_message(Location, Reason, passed) --> + [ 'FIXME: ~w: passed ~w'-[Location, Reason] ]. +fixme_message(Location, Reason, nondet) --> + [ 'FIXME: ~w: passed (nondet) ~w'-[Location, Reason] ]. + + +write_options([ numbervars(true), + quoted(true), + portray(true), + max_depth(10), + attributes(portray) + ]). + +:- if(swi). + +:- multifile + prolog:message/3, + user:message_hook/3. + +prolog:message(Term) --> + message(Term). + +% user:message_hook(+Term, +Kind, +Lines) + +user:message_hook(make(done(Files)), _, _) :- + make_run_tests(Files), + fail. % give other hooks a chance + +:- endif. + +:- if(sicstus). + +user:generate_message_hook(Message) --> + message(Message), + [nl]. % SICStus requires nl at the end + +% user:message_hook(+Severity, +Message, +Lines) is semidet. +% +% Redefine printing some messages. It appears SICStus has no way +% to get multiple messages at the same line, so we roll our own. +% As there is a lot pre-wired and checked in the SICStus message +% handling we cannot reuse the lines. Unless I miss something ... + +user:message_hook(informational, plunit(begin(Unit)), _Lines) :- + format(user_error, '% PL-Unit: ~w ', [Unit]), + flush_output(user_error). +user:message_hook(informational, plunit(end(_Unit)), _Lines) :- + format(user, ' done~n', []). + +:- endif. + diff --git a/packages/plunit/test_cover.pl b/packages/plunit/test_cover.pl new file mode 100644 index 000000000..4435d1177 --- /dev/null +++ b/packages/plunit/test_cover.pl @@ -0,0 +1,251 @@ +/* $Id$ + + Part of SWI-Prolog + + Author: Jan Wielemaker + E-mail: wielemak@science.uva.nl + WWW: http://www.swi-prolog.org + Copyright (C): 1985-2006, University of Amsterdam + + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License + as published by the Free Software Foundation; either version 2 + of the License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + As a special exception, if you link this library with other files, + compiled with a Free Software compiler, to produce an executable, this + library does not by itself cause the resulting executable to be covered + by the GNU General Public License. This exception does not however + invalidate any other reasons why the executable file might be covered by + the GNU General Public License. +*/ + +:- module(prolog_cover, + [ show_coverage/1, % :Goal + covered_clauses/4 % +Goal, -Result, -Succeeded, -Failed + ]). +:- use_module(library(ordsets)). + +:- set_prolog_flag(generate_debug_info, false). + +/** Clause cover analysis + +The purpose of this module is to find which part of the program has been +use by a certain goal. Usage is defined in terms of clauses that have +fired, seperated in clauses that succeeded at least once and clauses +that failed on each occasion. + +This module relies on the SWI-Prolog tracer hooks. It modifies these +hooks and collects the results, after which it restores the debugging +environment. This has some limitations: + + * The performance degrades significantly (about 10 times) + * It is not possible to use the debugger using coverage analysis + * The cover analysis tool is currently not thread-safe. + +The result is represented as a list of clause-references. As the +references to clauses of dynamic predicates cannot be guaranteed, these +are omitted from the result. + +@bug Relies heavily on SWI-Prolog internals. We have considered using + a meta-interpreter for this purpose, but it is nearly impossible + to do 100% complete meta-interpretation of Prolog. Example + problem areas include handling cuts in control-structures + and calls from non-interpreted meta-predicates. +*/ + + +:- dynamic + entered/1, % clauses entered + exited/1. % clauses completed + +:- module_transparent + covering/1, + covering/4. + +%% show_coverage(Goal) +% +% Report on coverage by Goal + +show_coverage(Goal) :- + covered_clauses(Goal, Result, Succeeded, Failed), + file_coverage(Succeeded, Failed), + return(Result). + +return(true). +return(fail) :- !, fail. +return(error(E)) :- + throw(E). + +%% covered_clauses(:Goal, -Result, -Succeeded, -Failed) is det. +% +% Run Goal as once/1. Unify Result with one of =true=, =fail= or +% error(Error). +% +% @param Succeeded Ordered set of succeeded clauses +% @param Failed Ordered set of clauses that are entered but +% never succeeded. + +covered_clauses(Goal, Result, Succeeded, Failed) :- + asserta(user:prolog_trace_interception(Port, Frame, _, continue) :- + prolog_cover:assert_cover(Port, Frame), Ref), + port_mask([unify,exit], Mask), + '$visible'(V, Mask), + '$leash'(L, Mask), + trace, + call_with_result(Goal, Result), + set_prolog_flag(debug, false), + covered(Ref, V, L, Succeeded, Failed). + +%% call_with_result(:Goal, -Result) is det. +% +% Run Goal as once/1. Unify Result with one of =true=, =fail= or +% error(Error). + +call_with_result(Goal, Result) :- + ( catch(Goal, E, true) + -> ( var(E) + -> Result = true + ; Result = error(E) + ) + ; Result = false + ). + +port_mask([], 0). +port_mask([H|T], Mask) :- + port_mask(T, M0), + '$syspreds':'$port_bit'(H, Bit), % Private stuff + Mask is M0 \/ Bit. + +%% assert_cover(+Port, +Frame) is det. +% +% Assert coverage of the current clause. We monitor two ports: the +% _unify_ port to see which clauses we entered, and the _exit_ +% port to see which completed successfully. + +assert_cover(unify, Frame) :- + running_static_pred(Frame), + prolog_frame_attribute(Frame, clause, Cl), !, + assert_entered(Cl). +assert_cover(exit, Frame) :- + running_static_pred(Frame), + prolog_frame_attribute(Frame, clause, Cl), !, + assert_exited(Cl). +assert_cover(_, _). + +%% running_static_pred(+Frame) is semidet. +% +% True if Frame is not running a dynamic predicate. + +running_static_pred(Frame) :- + prolog_frame_attribute(Frame, goal, Goal), + \+ predicate_property(Goal, dynamic). + +%% assert_entered(+Ref) is det. +%% assert_exited(+Ref) is det. +% +% Add Ref to the set of entered or exited clauses. + +assert_entered(Cl) :- + entered(Cl), !. +assert_entered(Cl) :- + assert(entered(Cl)). + +assert_exited(Cl) :- + exited(Cl), !. +assert_exited(Cl) :- + assert(exited(Cl)). + +%% covered(+Ref, +VisibleMask, +LeashMask, -Succeeded, -Failed) is det. +% +% Restore state and collect failed and succeeded clauses. + +covered(Ref, V, L, Succeeded, Failed) :- + '$visible'(_, V), + '$leash'(_, L), + erase(Ref), + findall(Cl, (entered(Cl), \+exited(Cl)), Failed0), + findall(Cl, retract(exited(Cl)), Succeeded0), + retractall(entered(Cl)), + sort(Failed0, Failed), + sort(Succeeded0, Succeeded). + + + /******************************* + * REPORTING * + *******************************/ + +%% file_coverage(+Succeeded, +Failed) is det. +% +% Write a report on the clauses covered organised by file to +% current output. + +file_coverage(Succeeded, Failed) :- + format('~N~n~`=t~78|~n'), + format('~tCoverage by File~t~78|~n'), + format('~`=t~78|~n'), + format('~w~t~w~64|~t~w~72|~t~w~78|~n', + ['File', 'Clauses', '%Cov', '%Fail']), + format('~`=t~78|~n'), + forall(source_file(File), + file_coverage(File, Succeeded, Failed)), + format('~`=t~78|~n'). + +file_coverage(File, Succeeded, Failed) :- + findall(Cl, clause_source(Cl, File, _), Clauses), + sort(Clauses, All), + ( ord_intersect(All, Succeeded) + -> true + ; ord_intersect(All, Failed) + ), !, + ord_intersection(All, Failed, FailedInFile), + ord_intersection(All, Succeeded, SucceededInFile), + ord_subtract(All, SucceededInFile, UnCov1), + ord_subtract(UnCov1, FailedInFile, Uncovered), + length(All, AC), + length(Uncovered, UC), + length(FailedInFile, FC), + CP is 100-100*UC/AC, + FCP is 100*FC/AC, + summary(File, 56, SFile), + format('~w~t ~D~64| ~t~1f~72| ~t~1f~78|~n', [SFile, AC, CP, FCP]). +file_coverage(_,_,_). + + +summary(Atom, MaxLen, Summary) :- + atom_length(Atom, Len), + ( Len < MaxLen + -> Summary = Atom + ; SLen is MaxLen - 5, + sub_atom(Atom, _, SLen, 0, End), + atom_concat('...', End, Summary) + ). + + +%% clause_source(+Clause, -File, -Line) is det. +%% clause_source(-Clause, +File, -Line) is det. + +clause_source(Clause, File, Line) :- + nonvar(Clause), !, + clause_property(Clause, file(File)), + clause_property(Clause, line_count(Line)). +clause_source(Clause, File, Line) :- + source_file(Pred, File), + \+ predicate_property(Pred, multifile), + nth_clause(Pred, _Index, Clause), + clause_property(Clause, line_count(Line)). +clause_source(Clause, File, Line) :- + Pred = _:_, + predicate_property(Pred, multifile), + nth_clause(Pred, _Index, Clause), + clause_property(Clause, file(File)), + clause_property(Clause, line_count(Line)). diff --git a/packages/plunit/test_wizard.pl b/packages/plunit/test_wizard.pl new file mode 100644 index 000000000..7775277e3 --- /dev/null +++ b/packages/plunit/test_wizard.pl @@ -0,0 +1,211 @@ +:- module(test_wizard, + [ make_tests/3, % +Module, +File, +Out + make_test/3 % +Callable, -Module, -Test + ]). +:- use_module(library(time)). +:- use_module(library(lists)). +:- use_module(library(listing)). +:- use_module(library(readutil)). + +/** Test Generation Wizard + +Tasks + + * Accumulate user queries + * Suggest tests from user queries +*/ + +setting(max_time(5)). + + + /******************************* + * UNIT GENERATION * + *******************************/ + +%% make_tests(+Module, +File, +Out) is det. +% +% Create tests from queries stored in File and write the tests for +% Module to the stream Out. + +make_tests(Module, File, Out) :- + read_file_to_terms(File, Queries, []), + findall(Test, ( member(Q, Queries), + make_test(Q, Module, Test)), Tests), + ( Tests == [] + -> true + ; format(Out, ':- begin_tests(~q).~n~n', [Module]), + maplist(portray_clause(Out), Tests), + format(Out, '~n:- end_tests(~q).~n', [Module]) + ). + + + /******************************* + * TEST GENERATION * + *******************************/ + +%% make_test(+Query:callable, -Module, -Test:term) is det. +% +% Generate a test from a query. Test is returned as a clause of +% test/1 or test/2 to be inserted between begin_tests and +% end_tests. + +make_test(Query0, Module, (test(Name, Options) :- Query)) :- + find_test_module(Query0, Module, Query), + pred_name(Query, Name), + setting(max_time(Max)), + test_result(Module:Query, Max, Options). + +%% find_test_module(+QuerySpec, ?Module, -Query). +% +% Find module to test from a query. Note that it is very common +% for toplevel usage to rely on SWI-Prolog's DWIM. +% +% @tbd What if multiple modules match? We can select the +% local one or ask the user. + +find_test_module(Var, _, _) :- + var(Var), !, fail. +find_test_module(M:Query, M0, Query) :- !, + M0 = M. +find_test_module(Query, M, Query) :- + current_predicate(_, M:Query), + \+ predicate_property(M:Query, imported_from(_M2)). + +%% pred_name(+Callable, -Name) is det. +% +% Suggest a name for the test. In the plunit framework the name +% needs not be unique, so we simply take the predicate name. + +pred_name(Callable, Name) :- + strip_module(Callable, _, Term), + functor(Term, Name, _Arity). + +%% test_result(+Callable, +Maxtime, -Result) is det. +% +% Try running goal and get meaningful results. Results are: +% +% * true(Templ == Var) +% * fail +% * all(Templ == Bindings) +% * throws(Error) +% * timeout + +test_result(Callable, Maxtime, Result) :- + term_variables(Callable, Vars), + make_template(Vars, Templ), + catch(call_with_time_limit(Maxtime, + findall(Templ-Det, + call_test(Callable, Det), + Bindings)), + E, true), + ( var(E) + -> success(Bindings, Templ, Result) + ; error(E, Result) + ). + +%% success(+Bindings, +Templ, -Result) is det. +% +% Create test-results from non-error cases. + +success([], _, [fail]) :- !. +success([[]-true], _, []) :- !. +success([S1-true], Templ, [ true(Templ == S1) ]) :- !. +success([[]-false], _, [ nondet ]) :- !. +success([S1-false], Templ, [ true(Templ == S1), nondet ]) :- !. +success(ListDet, Templ, [all(Templ == List)]) :- + strip_det(ListDet, List). + +strip_det([], []). +strip_det([H-_|T0], [H|T]) :- + strip_det(T0, T). + +%% error(+ErrorTerm, -Result) + +error(Error0, [throws(Error)]) :- + generalise_error(Error0, Error). + + +generalise_error(error(Formal, _), error(Formal, _)) :- !. +generalise_error(Term, Term). + + +%% make_template(+Vars, -Template) is det. +% +% Make a nice looking template + +make_template([], []) :- !. +make_template([One], One) :- !. +make_template([One, Two], One-Two) :- !. +make_template(List, Vars) :- + Vars =.. [v|List]. + +%% call_test(:Goal, -Det) is nondet. +% +% True if Goal succeeded. Det is unified to =true= if Goal left +% no choicepoints and =false= otherwise. + +call_test(Goal, Det) :- + Goal, + deterministic(Det). + + + /******************************* + * COLLECT * + *******************************/ + +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +Collect toplevel queries if the Prolog flag log_query_file points to the +name of a writeable file. The file is opened in append-mode for +exclusive write to allow for concurrent operation from multiple Prolog +systems using the same logfile. + +The file is written in UTF-8 encoding and using ignore_ops(true) to +ensure it can be read. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +:- multifile + user:message_hook/3. + +user:message_hook(toplevel_goal(Goal0, Bindings), _Level, _Lines) :- + open_query_log(Out), + bind_vars(Bindings), + clean_goal(Goal0, Goal), + call_cleanup(format(Out, '~W.~n', [Goal, [ numbervars(true), + quoted(true), + ignore_ops(true) + ]]), close(Out)), + fail. + +clean_goal(Var, _) :- + var(Var), !, fail. +clean_goal(user:Goal, Goal) :- !. +clean_goal(Goal, Goal). + +bind_vars([]). +bind_vars([Name=Var|T]) :- + Var = '$VAR'(Name), + bind_vars(T). + +open_query_log(Out) :- + current_prolog_flag(log_query_file, File), + exists_file(File), !, + open(File, append, Out, + [ encoding(utf8), + lock(write) + ]). +open_query_log(Out) :- + current_prolog_flag(log_query_file, File), + access_file(File, write), !, + open(File, write, Out, + [ encoding(utf8), + lock(write), + bom(true) + ]), + format(Out, + '/* SWI-Prolog query log. This file contains all syntactically\n \ + correct queries issued in this directory. It is used by the\n \ + test wizard to generate unit tests.\n\ + */~n~n', []). + + +