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)) =
 136         string.append("maybe.yes(", string.append(to_string(That), ")"))),
 137     (to_string(maybe.no) = "maybe.no")
 138 ].
 139
 140 %------------------------------------------------------------------------------%
 141
 142 generic_compare(A, B) = Result :-
 143     ( if
 144         A = B
 145     then
 146         Result = maybe.ok
 147     else
 148         Message = string.join_list(" != ", map(to_string, [A|[B|[]]])),
 149         Result = maybe.error(Message)
 150     ).
 151
 152 %------------------------------------------------------------------------------%
 153
 154 :- pred accumulate_mismatch(T, T, list(string), list(string), int, int)
 155     <= compare(T).
 156 :- mode accumulate_mismatch(in, in, in, out, in, out) is det.
 157
 158 accumulate_mismatch(A, B, !List, I, int.plus(I, 1)) :-
 159     compare(A, B) = MaybeResult,
 160     (
 161         MaybeResult = maybe.ok
 162     ;
 163         MaybeResult = maybe.error(Error),
 164         string.append("Element ", string.from_int(I), Prefix),
 165         string.append(string.append(Prefix, "\t: "), Error, Message),
 166         list.cons(Message, !List)
 167     ).
 168
 169 %------------------------------------------------------------------------------%
 170
 171 :- instance compare(list(T)) <= (compare(T), to_string(T)) where [
 172     ( compare(A, B) = Result :-
 173         list.length(A, ALen), list.length(B, BLen),
 174         generic_compare(ALen, BLen) = LenCompare,
 175         (
 176             LenCompare = maybe.ok,
 177             list.foldl2_corresponding(accumulate_mismatch, A, B, [], Errors, 0, _),
 178             ( if
 179                 list.is_empty(Errors)
 180             then
 181                 Result = maybe.ok
 182             else
 183                 Result = maybe.error(string.join_list("\n", Errors))
 184             )
 185         ;
 186             LenCompare = maybe.error(Error),
 187             Result = maybe.error(string.append("List length ", Error))
 188         )
 189     )
 190 ].
 191
 192 :- instance compare(set.set(T)) <= (compare(T), to_string(T)) where [
 193     ( compare(A, B) = Result :-
 194         set.count(A, ALen), set.count(B, BLen),
 195         generic_compare(ALen, BLen) = LenCompare,
 196         (
 197             LenCompare = maybe.ok,
 198             ( set.to_sorted_list(A, AList) & set.to_sorted_list(B, BList) ),
 199             compare(AList, BList) = Result
 200         ;
 201             LenCompare = maybe.error(Error),
 202             Result = maybe.error(string.append("List length ", Error))
 203         )
 204     )
 205 ].
 206
 207 %:- instance compare(rbtree.rbtree(K, V)) <= (compare(V), to_string(K), to_string(V)) where [
 208 %].
 209
 210 %:- instance compare(tree.tree(K, V)) <= (compare(V), to_string(K), to_string(V)) where [
 211 %].
 212
 213 :- instance compare(int) where [
 214     func(compare/2) is generic_compare
 215 ].
 216
 217 :- instance compare(string) where [
 218     ( compare(A, B) = Result :-
 219         ( A = B -> Result = maybe.ok
 220         ; Result = maybe.error(string.join_list(" != ", [A|[B|[]]])) )
 221     )
 222 ].
 223
 224 :- instance compare(float) where [
 225     ( compare(A, B) = Result :-
 226         ( float_equals(A, B) -> Result = maybe.ok
 227         ; Message = string.join_list(" != ", map(string.from_float, [A|[B|[]]])),
 228           Result = maybe.error(Message) )
 229     )
 230 ].
 231
 232 :- instance compare(bool.bool) where [
 233     ( compare(bool.yes, bool.yes) = maybe.ok ),
 234     ( compare(bool.no, bool.no) = maybe.ok ),
 235     ( compare(bool.yes, bool.no) = maybe.error("bool.yes != bool.no") ),
 236     ( compare(bool.no, bool.yes) = maybe.error("bool.no != bool.yes") )
 237 ].
 238
 239 :- instance compare(maybe.maybe(T)) <= (to_string(T), compare(T)) where [
 240     ( compare(maybe.no, maybe.no) = maybe.ok ),
 241     ( compare(maybe.no, maybe.yes(B)) = maybe.error(
 242         string.append("maybe.no != maybe.yes(", string.append(to_string(B), ")")) )),
 243     ( compare(maybe.yes(A), maybe.no) = maybe.error(
 244         string.append("maybe.yes(", string.append(to_string(A), ") != maybe.no")) )),
 245     ( compare(maybe.yes(A), maybe.yes(B)) = compare(A, B) )
 246 ].
 247
 248 :- instance compare(array.array(T)) <= (to_string(T), compare(T)) where [
 249     ( compare(A, B) = Result :-
 250         array.size(A, ALen), array.size(B, BLen),
 251         generic_compare(ALen, BLen) = LenCompare,
 252         (
 253             LenCompare = maybe.ok,
 254             ( array.to_list(A, AList) & array.to_list(B, BList) ),
 255             compare(AList, BList) = Result
 256         ;
 257             LenCompare = maybe.error(Error),
 258             Result = maybe.error(string.append("Array length ", Error))
 259         )
 260     )
 261 ].
 262
 263 :- instance compare(array2d.array2d(T)) <= (to_string(T), compare(T)) where [
 264     ( compare(A, B) = Result :-
 265         array2d.bounds(A, AW, AH), array2d.bounds(B, BW, BH),
 266         generic_compare(AW, BW) = WCompare,
 267         generic_compare(AH, BH) = HCompare,
 268         (
 269             WCompare = maybe.ok,
 270             HCompare = maybe.ok,
 271             % Kind of silly. Join the lists.
 272             (
 273               ( array2d.lists(A) = ALists,
 274                 list.foldl(list.append, ALists, []) = AList ) &
 275               ( array2d.lists(B) = BLists,
 276                 list.foldl(list.append, BLists, []) = BList )
 277             ),
 278             compare(AList, BList) = Result
 279         ;
 280             WCompare = maybe.ok,
 281             HCompare = maybe.error(Error),
 282             Result = maybe.error(string.append("Array2D height ", Error))
 283         ;
 284             WCompare = maybe.error(Error),
 285             HCompare = maybe.ok,
 286             Result = maybe.error(string.append("Array2D width ", Error))
 287         ;
 288             WCompare = maybe.error(WError),
 289             HCompare = maybe.error(HError),
 290             string.append("Array2D width ", WError, W),
 291             string.append("Array2D height ", HError, H),
 292             Result = maybe.error(string.join_list("\n", [W|[H|[]]]))
 293         )
 294     )
 295 ].
 296
 297 %------------------------------------------------------------------------------%
 298
 299 negate(X) = -X.
 300
 301 %------------------------------------------------------------------------------%
 302
 303 float_equals(A, B) :-
 304     abs(A - B) =< float.epsilon.
 305
 306 float_equals(A, B, Epsilon) :-
 307     abs(A - B) =< Epsilon.