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