1/*  Author: Joachim Schimpf
    2    Year: 2013
    3
    4    This code is given to the public domain "as is". Use at your own risk.
    5*/
    6
    7:- module(test_util_iso,
    8	  [ test/1,				% +File
    9	    test/2				% +File, +ReportFile
   10	  ]).   11:- use_module(library(apply)).   12:- use_module(library(ansi_term)).   13
   14/** <module> ECLiPSe test automation
   15
   16Use this library as follows: Write a  file with test patterns, using the
   17primitives should_fail/1, should_give/2, and should_throw/2, e.g.
   18
   19    ==
   20    3.0 > 3       should_fail.
   21    X is 3.0+4    should_give  X==7.0.
   22    throw(ball)   should_throw ball.
   23    arg(0,atom,A) should_throw error(type_error(compound,atom),_).
   24    ==
   25
   26The file name should have a .tst   extension, e.g. mytests.tst. Then run
   27all  the  test  in  that  file  by  loading  this  library  and  calling
   28test('mytests.tst'). This will print a  message   for  every test, and a
   29summary at the end. To write the  results   to  a  file, use test/2 (see
   30below).
   31
   32To temporarily disable a test in a test file, use the fixme prefix, e.g.
   33
   34    ==
   35    fixme X is 0/0 should_throw error(evaluation_error(undefined),_).
   36    ==
   37
   38The test procedure will skip those and print a count a the end.
   39
   40The primitives should_fail/1, should_give/2,  should_throw/2 and fixme/1
   41are also predicates that can be called directly.
   42
   43    $ Goal should_fail :
   44    Run the goal Goal and print a message if it doesn't fail.
   45
   46    $ Goal should_give +CheckGoal :
   47    Run the goal Goal and print a message if Goal does not succeed, or
   48    if the result doesn't satisfy CheckGoal.
   49
   50    CheckGoal can be an arbitrary user-defined goal.  In this case, the
   51    first solution of Goal is committed to, and CheckGoal executed with
   52    the variable instantiations of this solution.
   53
   54    To allow verification of goals with multiple solutions, one special
   55    form of CheckGoal is recognised:
   56
   57      ==
   58      multiple_solutions(SolCountVar, FinalCheck, SolutionCheck)
   59      ==
   60
   61    where SolCountVar should be a fresh variable.  With such a
   62    CheckGoal, ALL solutions to Goal will be generated.  For each
   63    solution, SolutionCheck will be executed with the variable
   64    instantiations of this solution, and with SolCountVar
   65    instantiated to the number of this solution (starting from 1).
   66    After all solutions have been found, FinalCheck will be executed,
   67    with SolCountVar instantiated to the total number of solutions.
   68
   69      ==
   70      member(X,[a,b,c])  should_give
   71          multiple_solutions(K, K==3,
   72              ( K==1 -> X==a
   73              ; K==2 -> X==b
   74              ; K==3 -> X==c
   75          )).
   76      ==
   77
   78    $ Goal should_throw +Exception :
   79    Run the goal Goal and print a message if it doesn't throw Exception.
   80    The exception term thrown must be an instance (see subsumes_term/2)
   81    of Exception>
   82
   83    $ fixme +SkippedTest :
   84    Skip a test that is known to fail.
   85    fixme/1 is a low-precedence prefix operator, and can thus be
   86    textually prefixed to any other test.  Its effect is that the test
   87    is skipped (not executed).  When multiple tests are done, the number
   88    of skipped tests gets reported at the end.  Skipped tests count as
   89    neither succeeded or failed.",
   90*/
   91
   92report(brief).
   93
   94:- op(1200,  fy, fixme).   95:- op(1110, xf,  should_fail).   96:- op(1110, xfx, should_give).   97:- op(1110, xfx, should_output).   98:- op(1110, xfx, should_throw).   99:- op(1110, xfx, should_raise).  100:- op(1110, xfx, output).  101
  102%%	test(+TestFile) is det.
  103%
  104%	Runs all the test patterns in TestFile.
  105
  106test(FileIn) :-
  107        setup_call_cleanup(
  108	    open(FileIn, read, In),
  109	    test_stream(In, user_error),
  110	    close(In)).
  111
  112
  113%%	test(+TestFile, +ResultFile) is det.
  114%
  115%	Runs all the test patterns  in   TestFile,  and  logs results in
  116%	ResultFile.
  117
  118test(FileIn, FileOut) :-
  119        setup_call_cleanup(
  120	    open(FileIn, read, In),
  121	    setup_call_cleanup(
  122		open(FileOut, write, Out),
  123		test_stream(In, Out),
  124		close(Out)),
  125	    close(In)).
  126
  127    test_stream(In, Out) :-
  128        stream_property(In, file_name(File)),
  129        format(Out, '~N% Running ECLiPSe tests from file ~w~n', [File]),
  130        counter_set(test_count, 0),
  131        counter_set(non_test_count, 0),
  132        counter_set(succeeded_test_count, 0),
  133        counter_set(failed_test_count, 0),
  134        counter_set(skipped_test_count, 0),
  135        repeat,
  136            catch(catch(read_term(In, Test,
  137				  [ module(test_util_iso)
  138				  ]), SyntaxError,
  139                        unexpected(Out, 0, valid_syntax, throw(SyntaxError))),
  140                        continue, fail),
  141	    source_location(_File, Line),
  142            ( Test \== end_of_file ->
  143                counter_inc(test_count),
  144                counter_get(test_count, N),
  145                catch(interpret_test(Test, t(File,Line,N), Out), continue, true),
  146                fail
  147            ;
  148                counter_get(test_count, N),
  149                counter_get(succeeded_test_count, TN),
  150                counter_get(failed_test_count, FN),
  151                counter_get(skipped_test_count, SN),
  152                counter_get(non_test_count, NN),
  153                format(Out, '~N% Finished tests from file ~w~n', [File]),
  154                format(Out, '% ~D tests found.~n', [N]),
  155                ( NN==0 -> true ; format(Out, '% ~D ignored as malformed.~n', [NN]) ),
  156                format(Out, '% ~D tests succeeded.~n', [TN]),
  157                ( FN==0 -> true ; format(Out, '% ~D tests failed.~n', [FN]) ),
  158                ( SN==0 -> true ; format(Out, '% ~D tests skipped.~n', [SN]) )
  159            ),
  160        !,
  161	FN =:= 0.
  162
  163
  164interpret_test((fixme Test), Name, Stream) :- !,
  165        fixme(Test, Name, Stream).
  166interpret_test((Goal should_fail), Name, Stream) :-  !,
  167        should_fail(Goal, Name, Stream).
  168interpret_test((Goal should_give Check), Name, Stream) :-  !,
  169        should_give(Goal, Check, Name, Stream).
  170interpret_test((Goal should_output Check), Name, Stream) :-  !,
  171        should_output(Goal, Check, Name, Stream).
  172interpret_test((Goal should_throw Ball), Name, Stream) :-  !,
  173        should_throw(Goal, Ball, Name, Stream).
  174interpret_test((Goal should_raise Exception), Name, Stream) :-  !,
  175        ( Exception==4 -> Ball = error(instantiation_error,_)
  176        ; Exception==5 -> Ball = error(type_error(_,_),_)
  177        ; Exception==24 -> Ball = error(type_error(_,_),_)
  178        ; Exception==6 -> Ball = error(domain_error(_,_),_)
  179        ; Ball = error(_,_)
  180        ),
  181        should_throw(Goal, Ball, Name, Stream).
  182interpret_test(_Goal, Name, Stream) :-
  183        write(Stream, 'Non-test goal '), write(Stream, Name),
  184        write(Stream, ': ignored'), nl(Stream),
  185        counter_inc(non_test_count).
  186
  187
  188
  189fixme(Test) :-
  190        current_output(Stream),
  191        catch(fixme(Test, Test, Stream), continue, true).
  192
  193    fixme(_Test, Name, Stream) :-
  194        write(Stream, 'Test '), write(Stream, Name),
  195        write(Stream, ': skipped'), nl(Stream),
  196        counter_inc(skipped_test_count),
  197        throw(continue).
  198
  199
  200
  201Goal should_fail :-
  202        current_output(Stream),
  203        catch(should_fail(Goal, Goal, Stream), continue, true).
  204
  205    should_fail(Goal, Name, Stream) :-
  206        ( catch(Goal, Ball, unexpected(Stream,Name,failure,throw(Ball))) ->
  207            unexpected(Stream, Name, failure, success)
  208        ;
  209            expected_outcome(Stream, Name)
  210        ).
  211
  212
  213
  214Goal should_give Check :-
  215        current_output(Stream),
  216        catch(should_give(Goal, Check, Goal, Stream), continue, true).
  217
  218
  219    should_give(_Goal, Check, Name, Stream) :- \+ callable(Check), !,
  220        unexpected(Stream, Name, success, illegal_check(Check)).
  221
  222    should_give(Goal, multiple_solutions(K,TotalCheck,SolutionCheck), Name, Stream) :- !,
  223        counter_set(solutions, 0),
  224        (
  225            catch(Goal, Ball, unexpected(Stream,Name,'success or failure',throw(Ball))),
  226            counter_inc(solutions),
  227            ( counter_get(solutions, K), catch(SolutionCheck, _, fail) ->
  228                fail    % next solution
  229            ;
  230                unexpected(Stream, Name, success, failed_check(SolutionCheck))
  231            )
  232        ;
  233            ( counter_get(solutions, K), catch(TotalCheck, _, fail) ->
  234                expected_outcome(Stream, Name)
  235            ;
  236                unexpected(Stream,Name,success,failed_check(TotalCheck))
  237            )
  238        ).
  239
  240    should_give(Goal, Check, Name, Stream) :-
  241        ( catch(Goal, Ball, unexpected(Stream,Name,success,throw(Ball))) ->
  242            ( catch(Check, _, fail) ->
  243                expected_outcome(Stream, Name)
  244            ;
  245                unexpected(Stream, Name, success, failed_check(Check))
  246            )
  247        ;
  248            unexpected(Stream, Name, success, failure)
  249        ).
  250
  251Goal should_output ExpectedText :-
  252        current_output(Stream),
  253        catch(should_output(Goal, ExpectedText, Goal, Stream), continue, true).
  254
  255    should_output(Goal, ExpectedText, Name, Stream) :-
  256        ( catch(with_output_to(atom(OutputAtom), Goal), Ball,
  257                unexpected(Stream,Name,Goal,success,throw(Ball))) ->
  258            atom_chars(OutputAtom, OutputChars),
  259            ( output_matches_expected(ExpectedText, OutputChars, OutputAtom) ->
  260                expected_outcome(Stream, Name)
  261            ;
  262                most_readable_text(ExpectedText, MessageText),
  263                unexpected(Stream, Name, Goal, output(MessageText), actual_output(OutputAtom))
  264            )
  265        ; unexpected(Stream, Name, Goal, success, failure)
  266        ).
  267
  268    output_matches_expected(ExpectedText, OutputChars, OutputAtom) :-
  269        ( var(ExpectedText)
  270        ; ExpectedText == [], OutputChars == []
  271        ; atom(ExpectedText), OutputAtom == ExpectedText
  272        ; catch(atom_string(OutputAtom, ExpectedText), _, fail)
  273        ; ExpectedText = [_|_],
  274            ( subsumes_term(ExpectedText, OutputChars)
  275            ; chars_codes(OutputChars, OutputCodes),
  276              subsumes_term(ExpectedText, OutputCodes)
  277            )
  278        ), !.
  279
  280    most_readable_text(T, R) :- atom(T), !, R = T.
  281    most_readable_text(T, R) :- catch(string(T),_,fail), !, R = T.
  282    most_readable_text(T, R) :-
  283        catch(atom_codes(A, T), _, fail),
  284        !, R = A.
  285    most_readable_text(T, R) :-
  286        catch(atom_chars(A, T), _, fail),
  287        !, R = A.
  288    most_readable_text(T, T).
  289
  290    chars_codes([], []).
  291    chars_codes([Char|Chars], [Code|Codes]) :-
  292        char_code(Char, Code),
  293        chars_codes(Chars, Codes).
  294
  295Goal should_throw Ball :-
  296        current_output(Stream),
  297        catch(should_throw(Goal, Ball, Goal, Stream), continue, true).
  298
  299    should_throw(Goal, Expected, Name, Stream) :-
  300        ( catch(with_output_to(string(_), Goal), Ball,
  301                ( subsumes_term(Expected,Ball) ->
  302                    expected_outcome(Stream, Name)
  303                ;
  304                    unexpected(Stream, Name, throw(Expected), throw(Ball))
  305                )
  306            )
  307        ->
  308            unexpected(Stream, Name, throw(Expected), success)
  309        ;
  310            unexpected(Stream, Name, throw(Expected), failure)
  311        ).
  312
  313
  314
  315expected_outcome(Stream, t(_File,Line,TestNo)) =>
  316	(   report(brief)
  317	->  put_char(Stream, '.'),
  318	    flush_output(Stream)
  319	;   format(Stream, '~NTest ~w at line ~d: OK~n', [TestNo, Line])
  320	),
  321	counter_inc(succeeded_test_count),
  322        throw(continue).
  323
  324unexpected(Stream, t(File,Line,TestNo), Expected, Outcome) =>
  325	ansi_format(Stream, error,
  326                    '~NTest ~w at ~w:~w: ~n~texpected ~12|~q,~n~tgot ~12|~q~n',
  327                    [TestNo, File, Line, Expected, Outcome]),
  328        counter_inc(failed_test_count),
  329        throw(continue).
  330
  331unexpected(Stream, t(File,Line,TestNo), Goal, Expected, Outcome) =>
  332        ansi_format(Stream, error, 'Test ~w at ~w:~w:~n', [TestNo,File,Line]),
  333        ansi_format(Stream, error, '  Expected ~p~n', [Expected]),
  334        ansi_format(Stream, error, '       Got ~p~n', [Outcome]),
  335        ansi_format(Stream, error, '      Goal ~p~n', [Goal]),
  336        counter_inc(failed_test_count),
  337        throw(continue).
  338
  339%
  340% ISO implementation of non-backtrackable counters
  341%
  342
  343:- dynamic(counter/2).  344
  345counter_set(Name, Value) :-
  346        retractall(counter(Name,_)),
  347        asserta(counter(Name,Value)).
  348
  349counter_inc(Name) :-
  350        ( retract(counter(Name,N0)) -> N1 is N0+1 ; N1 = 1 ),
  351        asserta(counter(Name,N1)).
  352
  353counter_get(Name, Value) :-
  354        counter(Name, Value)