transunit.m

   1 %   Copyright (C) 2018-2019 Alaskan Emily, Transnat Games
   2 %
   3 %   This software is provided 'as-is', without any express or implied
   4 %   warranty.  In no event will the authors be held liable for any damages
   5 %   arising from the use of this software.
   6 %
   7 %   Permission is granted to anyone to use this software for any purpose,
   8 %   including commercial applications, and to alter it and redistribute it
   9 %   freely, subject to the following restrictions:
  10 %
  11 %   1. The origin of this software must not be misrepresented; you must not
  12 %      claim that you wrote the original software. If you use this software
  13 %      in a product, an acknowledgment in the product documentation would be
  14 %      appreciated but is not required.
  15 %   2. Altered source versions must be plainly marked as such, and must not be
  16 %      misrepresented as being the original software.
  17 %  3. This notice may not be removed or altered from any source distribution.
  18
  19 :- module transunit.
  20
  21 %==============================================================================%
  22 % Transnat Games Unit Testing Framework
  23 % Provides some utilities to run unit tests on Mercury code.
  24 % This is primarily meant to test purely functional code, preds with behavior
  25 % strongly dependent on typeclasses, and parser/converter style code.
  26 %
  27 % Feathers in our cap:
  28 %  - mock framework which makes it fairly easy to mock typeclasses
  29 %  - Result comparison with acceptable error reporting
  30 % Black eyes:
  31 %  - No exception handling whatsoever
  32 %  - No multi-process, meaning badly behaved native code can poison the well.
  33 %
  34 % But there are basically no other Mercury unit test frameworks to start with,
  35 % so at least this gives us a foundation.
  36 :- interface.
  37 %==============================================================================%
  38
  39 :- include_module transunit.compare.
  40 :- include_module transunit.compare_test.
  41 :- include_module transunit.mock.
  42
  43 :- use_module maybe.
  44 :- import_module list.
  45 :- use_module io.
  46 :- use_module unit.
  47
  48 :- typeclass to_string(T) where [
  49     func to_string(T) = string
  50 ].
  51
  52 :- typeclass compare(T) where [
  53     func compare(T, T) = maybe.maybe_error
  54 ].
  55
  56 %-----------------------------------------------------------------------------%
  57
  58 % run_test(TestPred, TestName, !IO)
  59 % Runs a pred, reporting success or failure depending on if it is true of not.
  60 % The input pred's parameter is a dummy parameter.
  61 :- pred run_test(pred(unit.unit), string, io.io, io.io).
  62 :- mode run_test(pred(in) is semidet, in, di, uo) is det.
  63
  64 %-----------------------------------------------------------------------------%
  65 % run_result_test(TestPred, TestName, !IO)
  66 % Runs a pred, reporting success or failure depending on the maybe_error which
  67 % is produced.
  68 % This is intended to be run with preds from the compare_test module as the
  69 % test preds.
  70 % See run_result_test/6 for using input preds that use a different state
  71 % variable type than io.io.
  72 :- pred run_result_test(pred(maybe.maybe_error, io.io, io.io),
  73     string,
  74     io.io, io.io).
  75 :- mode run_result_test(pred(out, di, uo) is det,
  76     in,
  77     di, uo) is det.
  78
  79 %-----------------------------------------------------------------------------%
  80 % run_result_test(TestPred, TestName, !State, !IO)
  81 % Runs a pred, reporting success or failure depending on the maybe_error which
  82 % is produced.
  83 % This does not share the IO state as run_result_test/4 does.
  84 :- pred run_result_test(pred(maybe.maybe_error, State, State),
  85     string,
  86     State, State,
  87     io.io, io.io).
  88 :- mode run_result_test(pred(out, in, out) is det,
  89     in,
  90     in, out,
  91     di, uo) is det.
  92 :- mode run_result_test(pred(out, di, uo) is det,
  93     in,
  94     di, uo,
  95     di, uo) is det.
  96 :- mode run_result_test(pred(out, mdi, muo) is det,
  97     in,
  98     mdi, muo,
  99     di, uo) is det.
 100
 101 %-----------------------------------------------------------------------------%
 102
 103 :- func test_result(maybe.maybe_error, string) = string.
 104
 105 %-----------------------------------------------------------------------------%
 106
 107 :- func success_message = string.
 108 :- func failure_message = string.
 109
 110 %==============================================================================%
 111 :- implementation.
 112 %==============================================================================%
 113
 114 :- use_module string.
 115
 116 %-----------------------------------------------------------------------------%
 117
 118 run_test(Pred, Name, !IO) :-
 119     ( Pred(unit.unit) -> Result = success_message ; Result = failure_message ),
 120     io.write_string(Result, !IO),
 121     io.write_char((' '), !IO),
 122     io.write_string(Name, !IO),
 123     io.nl(!IO).
 124
 125 %-----------------------------------------------------------------------------%
 126
 127 run_result_test(Pred, Name, !IO) :-
 128     Pred(Result, !IO),
 129     io.write_string(test_result(Result, Name), !IO),
 130     io.nl(!IO).
 131
 132 %-----------------------------------------------------------------------------%
 133
 134 run_result_test(Pred, Name, !State, !IO) :-
 135     Pred(Result, !State),
 136     io.write_string(test_result(Result, Name), !IO),
 137     io.nl(!IO).
 138
 139 %-----------------------------------------------------------------------------%
 140
 141 test_result(maybe.ok, Name) = string.append(success_message, Suffix) :-
 142     string.first_char(Suffix, (' '), Name).
 143
 144 test_result(maybe.error(E), Name) = string.append(failure_message, Suffix) :-
 145     string.first_char(Start, (' '), Name),
 146     string.first_char(Rest, ('\n'), E),
 147     string.append(Start, Rest, Suffix).
 148
 149 %-----------------------------------------------------------------------------%
 150
 151 success_message = "Success ...".
 152 failure_message = "Failure !!!".
 153