transunit.compare.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.compare.
  20
  21 %==============================================================================%
  22 % General components for the unit test framework.
  23 % I know this isn't great. But it has no dependencies, and there are not a lot
  24 % of prebuilt solutions for Mercury.
  25 :- interface.
  26 %==============================================================================%
  27
  28 :- use_module bool.
  29 :- use_module rbtree.
  30 :- use_module array.
  31 :- use_module array2d.
  32 :- use_module set.
  33
  34 %------------------------------------------------------------------------------%
  35
  36 :- instance to_string(int).
  37 :- instance to_string(string).
  38 :- instance to_string(float).
  39 :- instance to_string(bool.bool).
  40 :- instance to_string(maybe.maybe(T)) <= to_string(T).
  41
  42 %------------------------------------------------------------------------------%
  43
  44 :- instance compare(list(T)) <= (compare(T), to_string(T)).
  45 :- instance compare(set.set(T)) <= (compare(T), to_string(T)).
  46 %:- instance compare(rbtree.rbtree(K, V)) <= (compare(V), to_string(K), to_string(V)).
  47 %:- instance compare(tree.tree(K, V)) <= (compare(V), to_string(K), to_string(V)).
  48 :- instance compare(int).
  49 :- instance compare(string).
  50 :- instance compare(float).
  51 :- instance compare(bool.bool).
  52 :- instance compare(maybe.maybe(T)) <= (to_string(T), compare(T)).
  53 :- instance compare(array.array(T)) <= (to_string(T), compare(T)).
  54 :- instance compare(array2d.array2d(T)) <= (to_string(T), compare(T)).
  55
  56 %------------------------------------------------------------------------------%
  57
  58 :- func generic_compare(T, T) = maybe.maybe_error <= to_string(T).
  59
  60 %------------------------------------------------------------------------------%
  61
  62 :- func negate(float) = float.
  63
  64 %------------------------------------------------------------------------------%
  65 % float_equals(A, B)
  66 :- pred float_equals(float, float).
  67 :- mode float_equals(in, in) is semidet.
  68 :- mode float_equals(di, di) is semidet.
  69
  70 %------------------------------------------------------------------------------%
  71 % Promise the associativity of float comparisons
  72 :- promise all[A, B] (
  73     float_equals(A, B) <=> float_equals(B, A)
  74 ).
  75
  76 %------------------------------------------------------------------------------%
  77
  78 :- promise all[A, B] (
  79     float_equals(A, B) <=> float_equals(negate(A), negate(B))
  80 ).
  81
  82 %------------------------------------------------------------------------------%
  83
  84 :- promise all[A, B] (
  85     (negate(A) = B) <=> (negate(B) = A)
  86 ).
  87
  88 %------------------------------------------------------------------------------%
  89
  90 :- promise all[A, B] (
  91     some [C] (negate(A) = C, negate(B) = C, A = B)
  92 ).
  93
  94 %------------------------------------------------------------------------------%
  95 % float_equals(A, B, Epsilon)
  96 :- pred float_equals(float, float, float).
  97 :- mode float_equals(in, in, in) is semidet.
  98 :- mode float_equals(di, di, in) is semidet.
  99
 100 %------------------------------------------------------------------------------%
 101
 102 :- promise all[A, B, Epsilon] (
 103     float_equals(A, B, Epsilon) <=> float_equals(B, A, Epsilon)
 104 ).
 105
 106 %==============================================================================%
 107 :- implementation.
 108 %==============================================================================%
 109
 110 :- import_module float.
 111 :- use_module int.
 112 :- use_module string.
 113 :- use_module std_util.
 114
 115 %------------------------------------------------------------------------------%
 116
 117 :- instance to_string(int) where [
 118     func(to_string/1) is string.from_int
 119 ].
 120
 121 :- instance to_string(string) where [
 122     func(to_string/1) is std_util.id
 123 ].
 124
 125 :- instance to_string(float) where [
 126     func(to_string/1) is string.from_float
 127 ].
 128
 129 :- instance to_string(bool.bool) where [
 130     (to_string(bool.yes) = "bool.yes"),
 131     (to_string(bool.no) = "bool.no")
 132 ].
 133
 134 :- instance to_string(maybe.maybe(T)) <= to_string(T) where [
 135     (to_string(maybe.yes(That)) = to_string(That)),
 136     (to_string(maybe.no) = "maybe.no")
 137 ].
 138
 139 %------------------------------------------------------------------------------%
 140
 141 generic_compare(A, B) = Result :-
 142     ( if
 143         A = B
 144     then
 145         Result = maybe.ok
 146     else
 147         Message = string.join_list(" != ", map(to_string, [A|[B|[]]])),
 148         Result = maybe.error(Message)
 149     ).
 150
 151 %------------------------------------------------------------------------------%
 152
 153 :- pred accumulate_mismatch(T, T, list(string), list(string), int, int)
 154     <= compare(T).
 155 :- mode accumulate_mismatch(in, in, in, out, in, out) is det.
 156
 157 accumulate_mismatch(A, B, !List, I, int.plus(I, 1)) :-
 158     compare(A, B) = MaybeResult,
 159     (
 160         MaybeResult = maybe.ok
 161     ;
 162         MaybeResult = maybe.error(Error),
 163         string.append("Element ", string.from_int(I), Prefix),
 164         string.append(string.append(Prefix, "\t: "), Error, Message),
 165         list.cons(Message, !List)
 166     ).
 167
 168 %------------------------------------------------------------------------------%
 169
 170 :- instance compare(list(T)) <= (compare(T), to_string(T)) where [
 171     ( compare(A, B) = Result :-
 172         list.length(A, ALen), list.length(B, BLen),
 173         generic_compare(ALen, BLen) = LenCompare,
 174         (
 175             LenCompare = maybe.ok,
 176             list.foldl2_corresponding(accumulate_mismatch, A, B, [], Errors, 0, _),
 177             ( if
 178                 list.is_empty(Errors)
 179             then
 180                 Result = maybe.ok
 181             else
 182                 Result = maybe.error(string.join_list("\n", Errors))
 183             )
 184         ;
 185             LenCompare = maybe.error(Error),
 186             Result = maybe.error(string.append("List length ", Error))
 187         )
 188     )
 189 ].
 190
 191 :- instance compare(set.set(T)) <= (compare(T), to_string(T)) where [
 192     ( compare(A, B) = Result :-
 193         set.count(A, ALen), set.count(B, BLen),
 194         generic_compare(ALen, BLen) = LenCompare,
 195         (
 196             LenCompare = maybe.ok,
 197             ( set.to_sorted_list(A, AList) & set.to_sorted_list(B, BList) ),
 198             compare(AList, BList) = Result
 199         ;
 200             LenCompare = maybe.error(Error),
 201             Result = maybe.error(string.append("List length ", Error))
 202         )
 203     )
 204 ].
 205
 206 %:- instance compare(rbtree.rbtree(K, V)) <= (compare(V), to_string(K), to_string(V)) where [
 207 %].
 208
 209 %:- instance compare(tree.tree(K, V)) <= (compare(V), to_string(K), to_string(V)) where [
 210 %].
 211
 212 :- instance compare(int) where [
 213     func(compare/2) is generic_compare
 214 ].
 215
 216 :- instance compare(string) where [
 217     ( compare(A, B) = Result :-
 218         ( A = B -> Result = maybe.ok
 219         ; Result = maybe.error(string.join_list(" != ", [A|[B|[]]])) )
 220     )
 221 ].
 222
 223 :- instance compare(float) where [
 224     ( compare(A, B) = Result :-
 225         ( float_equals(A, B) -> Result = maybe.ok
 226         ; Message = string.join_list(" != ", map(string.from_float, [A|[B|[]]])),
 227           Result = maybe.error(Message) )
 228     )
 229 ].
 230
 231 :- instance compare(bool.bool) where [
 232     ( compare(bool.yes, bool.yes) = maybe.ok ),
 233     ( compare(bool.no, bool.no) = maybe.ok ),
 234     ( compare(bool.yes, bool.no) = maybe.error("bool.yes != bool.no") ),
 235     ( compare(bool.no, bool.yes) = maybe.error("bool.no != bool.yes") )
 236 ].
 237
 238 :- instance compare(maybe.maybe(T)) <= (to_string(T), compare(T)) where [
 239     func(compare/2) is generic_compare
 240 ].
 241
 242 :- instance compare(array.array(T)) <= (to_string(T), compare(T)) where [
 243     ( compare(A, B) = Result :-
 244         array.size(A, ALen), array.size(B, BLen),
 245         generic_compare(ALen, BLen) = LenCompare,
 246         (
 247             LenCompare = maybe.ok,
 248             ( array.to_list(A, AList) & array.to_list(B, BList) ),
 249             compare(AList, BList) = Result
 250         ;
 251             LenCompare = maybe.error(Error),
 252             Result = maybe.error(string.append("Array length ", Error))
 253         )
 254     )
 255 ].
 256
 257 :- instance compare(array2d.array2d(T)) <= (to_string(T), compare(T)) where [
 258     ( compare(A, B) = Result :-
 259         array2d.bounds(A, AW, AH), array2d.bounds(B, BW, BH),
 260         generic_compare(AW, BW) = WCompare,
 261         generic_compare(AH, BH) = HCompare,
 262         (
 263             WCompare = maybe.ok,
 264             HCompare = maybe.ok,
 265             % Kind of silly. Join the lists.
 266             (
 267               ( array2d.lists(A) = ALists,
 268                 list.foldl(list.append, ALists, []) = AList ) &
 269               ( array2d.lists(B) = BLists,
 270                 list.foldl(list.append, BLists, []) = BList )
 271             ),
 272             compare(AList, BList) = Result
 273         ;
 274             WCompare = maybe.ok,
 275             HCompare = maybe.error(Error),
 276             Result = maybe.error(string.append("Array2D height ", Error))
 277         ;
 278             WCompare = maybe.error(Error),
 279             HCompare = maybe.ok,
 280             Result = maybe.error(string.append("Array2D width ", Error))
 281         ;
 282             WCompare = maybe.error(WError),
 283             HCompare = maybe.error(HError),
 284             string.append("Array2D width ", WError, W),
 285             string.append("Array2D height ", HError, H),
 286             Result = maybe.error(string.join_list("\n", [W|[H|[]]]))
 287         )
 288     )
 289 ].
 290
 291 %------------------------------------------------------------------------------%
 292
 293 negate(X) = -X.
 294
 295 %------------------------------------------------------------------------------%
 296
 297 float_equals(A, B) :-
 298     abs(A - B) =< float.epsilon.
 299
 300 float_equals(A, B, Epsilon) :-
 301     abs(A - B) =< Epsilon.