transunit.m

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