1 % Copyright (C) 2018-2019 Alaskan Emily, Transnat Games
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.
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:
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.
19 :- module transunit.compare.
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.
26 %==============================================================================%
31 :- use_module array2d.
34 %------------------------------------------------------------------------------%
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).
42 %------------------------------------------------------------------------------%
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)).
56 %------------------------------------------------------------------------------%
58 :- func generic_compare(T, T) = maybe.maybe_error <= to_string(T).
60 %------------------------------------------------------------------------------%
62 :- func negate(float) = float.
64 %------------------------------------------------------------------------------%
66 :- pred float_equals(float, float).
67 :- mode float_equals(in, in) is semidet.
68 :- mode float_equals(di, di) is semidet.
70 %------------------------------------------------------------------------------%
71 % Promise the associativity of float comparisons
72 :- promise all[A, B] (
73 float_equals(A, B) <=> float_equals(B, A)
76 %------------------------------------------------------------------------------%
78 :- promise all[A, B] (
79 float_equals(A, B) <=> float_equals(negate(A), negate(B))
82 %------------------------------------------------------------------------------%
84 :- promise all[A, B] (
85 (negate(A) = B) <=> (negate(B) = A)
88 %------------------------------------------------------------------------------%
90 :- promise all[A, B] (
91 some [C] (negate(A) = C, negate(B) = C, A = B)
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.
100 %------------------------------------------------------------------------------%
102 :- promise all[A, B, Epsilon] (
103 float_equals(A, B, Epsilon) <=> float_equals(B, A, Epsilon)
106 %==============================================================================%
108 %==============================================================================%
110 :- import_module float.
112 :- use_module string.
113 :- use_module std_util.
115 %------------------------------------------------------------------------------%
117 :- instance to_string(int) where [
118 func(to_string/1) is string.from_int
121 :- instance to_string(string) where [
122 func(to_string/1) is std_util.id
125 :- instance to_string(float) where [
126 func(to_string/1) is string.from_float
129 :- instance to_string(bool.bool) where [
130 (to_string(bool.yes) = "bool.yes"),
131 (to_string(bool.no) = "bool.no")
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")
139 %------------------------------------------------------------------------------%
141 generic_compare(A, B) = Result :-
147 Message = string.join_list(" != ", map(to_string, [A|[B|[]]])),
148 Result = maybe.error(Message)
151 %------------------------------------------------------------------------------%
153 :- pred accumulate_mismatch(T, T, list(string), list(string), int, int)
155 :- mode accumulate_mismatch(in, in, in, out, in, out) is det.
157 accumulate_mismatch(A, B, !List, I, int.plus(I, 1)) :-
158 compare(A, B) = MaybeResult,
160 MaybeResult = maybe.ok
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)
168 %------------------------------------------------------------------------------%
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,
175 LenCompare = maybe.ok,
176 list.foldl2_corresponding(accumulate_mismatch, A, B, [], Errors, 0, _),
178 list.is_empty(Errors)
182 Result = maybe.error(string.join_list("\n", Errors))
185 LenCompare = maybe.error(Error),
186 Result = maybe.error(string.append("List length ", Error))
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,
196 LenCompare = maybe.ok,
197 ( set.to_sorted_list(A, AList) & set.to_sorted_list(B, BList) ),
198 compare(AList, BList) = Result
200 LenCompare = maybe.error(Error),
201 Result = maybe.error(string.append("List length ", Error))
206 %:- instance compare(rbtree.rbtree(K, V)) <= (compare(V), to_string(K), to_string(V)) where [
209 %:- instance compare(tree.tree(K, V)) <= (compare(V), to_string(K), to_string(V)) where [
212 :- instance compare(int) where [
213 func(compare/2) is generic_compare
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|[]]])) )
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) )
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") )
238 :- instance compare(maybe.maybe(T)) <= (to_string(T), compare(T)) where [
239 func(compare/2) is generic_compare
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,
247 LenCompare = maybe.ok,
248 ( array.to_list(A, AList) & array.to_list(B, BList) ),
249 compare(AList, BList) = Result
251 LenCompare = maybe.error(Error),
252 Result = maybe.error(string.append("Array length ", Error))
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,
265 % Kind of silly. Join the lists.
267 ( array2d.lists(A) = ALists,
268 list.foldl(list.append, ALists, []) = AList ) &
269 ( array2d.lists(B) = BLists,
270 list.foldl(list.append, BLists, []) = BList )
272 compare(AList, BList) = Result
275 HCompare = maybe.error(Error),
276 Result = maybe.error(string.append("Array2D height ", Error))
278 WCompare = maybe.error(Error),
280 Result = maybe.error(string.append("Array2D width ", Error))
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|[]]]))
291 %------------------------------------------------------------------------------%
295 %------------------------------------------------------------------------------%
297 float_equals(A, B) :-
298 abs(A - B) =< float.epsilon.
300 float_equals(A, B, Epsilon) :-
301 abs(A - B) =< Epsilon.