mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-17 02:13:54 +00:00
80b1d4a7e3
library/test_bitset.m:
Instead of comparing just one bitset module (tree_bitset by default)
against set_ordlist, compare all of them (tree_bitset, sparse_bitset,
and fat_sparse_bitset) against set_ordlist.
tests/hard_coded/test_bitsets.{m,exp}:
Rename this test case from test_tree_bitset to test_bitsets, since
(through library/test_bitset.m) we now test ALL bitset implementations,
not just tree_bitset.
tests/hard_coded/Mmakefile:
Refer to the test by its new name.
403 lines
12 KiB
Mathematica
403 lines
12 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ts=4 sw=4 et ft=mercury
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module test_bitsets.
|
|
:- interface.
|
|
|
|
:- import_module io.
|
|
|
|
:- pred main(io::di, io::uo) is det.
|
|
|
|
:- implementation.
|
|
|
|
:- import_module bool.
|
|
:- import_module enum.
|
|
:- import_module int.
|
|
:- import_module list.
|
|
:- import_module pair.
|
|
:- import_module random.
|
|
:- import_module random.sfc64.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module test_bitset.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type maybe_double
|
|
---> do_not_double
|
|
; do_double.
|
|
|
|
:- type maybe_write
|
|
---> do_not_write
|
|
; do_write.
|
|
|
|
:- type which_test
|
|
---> test_count
|
|
; test_foldl
|
|
; test_union
|
|
; test_intersection
|
|
; test_difference
|
|
; test_remove_least
|
|
; test_remove_leq
|
|
; test_remove_gt
|
|
; test_delete
|
|
; test_delete_list
|
|
; test_divide_by_set
|
|
; test_all.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func list1 = list(int).
|
|
|
|
list1 =
|
|
[29, 28, 31, 22, 15, 32, 19, 58, 59, 36, 7, 39, 42,
|
|
34, 25, 40, 59, 2, 19, 44, 47, 38].
|
|
|
|
:- func list2 = list(int).
|
|
|
|
list2 =
|
|
[21, 52, 23, 18, 23, 56, 11, 46, 61, 4, 63, 54, 17, 64,
|
|
13, 38, 37, 4, 39, 2, 57, 56, 37, 30, 51, 12, 49,
|
|
58, 31, 48, 61, 42, 53, 44, 55, 14, 9, 40, 43, 50].
|
|
|
|
main(!IO) :-
|
|
% This control makes it easy to test only a specific operation being
|
|
% being worked on.
|
|
WhichTest = test_all,
|
|
|
|
SimpleTest = list1 - list2,
|
|
StressTests = [
|
|
% The values of X and Y on 32 bit machines (or 2X and 2Y on 64 bit
|
|
% machines) are intended to end up in near the start and the end
|
|
% of one interior node, while Z (or 2Z) ends up near the start of
|
|
% the next interior node. These stress tests were derived from a bug
|
|
% in the implementation of the difference operation. The bug was in
|
|
% how the difference operation handled interior nodes at the same level
|
|
% but not at the same starting address.
|
|
|
|
[532, 32431] - [32794],
|
|
[1, 29424] - [1, 2, 3, 35701],
|
|
[1] - [2, 35701],
|
|
[101, 102] - [1, 2, 3, 35699, 35700, 35701],
|
|
[36696, 35702, 35703, 35705] -
|
|
[1, 2, 3, 33416, 334283],
|
|
[0, 63, 64, 65, 127] - [],
|
|
[0, 63, 64, 65, 127, 128] - [],
|
|
[0, 63, 64, 65, 127, 128, 130] - [],
|
|
|
|
% These test the handling of empty sets, which several operations
|
|
% handle with special case code.
|
|
[] - [2],
|
|
[] - [2, 35701],
|
|
[2] - [],
|
|
[2, 35701] - []
|
|
],
|
|
|
|
% Run one lot of tests with known input lists,
|
|
% to generate some visible output.
|
|
run_test(do_not_double, do_write, WhichTest, SimpleTest, !IO),
|
|
run_tests(do_double, do_write, WhichTest, StressTests, !IO),
|
|
|
|
% Run some more tests with random input, checking the output against the
|
|
% output of the corresponding predicates in set_ordlist.
|
|
% XXX Ten runs with small input sets is not a rigourous test.
|
|
Iterations = 10,
|
|
List1Size = 20,
|
|
List2Size = 40,
|
|
sfc64.init(RNG, RS0),
|
|
run_random_tests(RNG, Iterations, List1Size, List2Size, WhichTest,
|
|
RS0, _, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred run_random_tests(RNG::in, int::in, int::in, int::in, which_test::in,
|
|
RS::di, RS::uo, io::di, io::uo) is det <= urandom(RNG, RS).
|
|
|
|
run_random_tests(RNG, Iterations, List1Size, List2Size, WhichTest,
|
|
!RS, !IO) :-
|
|
( if Iterations = 0 then
|
|
true
|
|
else
|
|
get_random_numbers(RNG, List1Size, [], List1, !RS),
|
|
get_random_numbers(RNG, List2Size, [], List2, !RS),
|
|
% We cannot write out the random tests, since we cannot anticipate
|
|
% the random numbers in the .exp file.
|
|
run_test(do_not_double, do_not_write, WhichTest, List1 - List2, !IO),
|
|
|
|
run_random_tests(RNG, Iterations - 1, List1Size, List2Size, WhichTest,
|
|
!RS, !IO)
|
|
).
|
|
|
|
:- pred get_random_numbers(RNG::in, int::in, list(int)::in, list(int)::out,
|
|
RS::di, RS::uo) is det <= urandom(RNG, RS).
|
|
|
|
get_random_numbers(RNG, Num, !List, !RS) :-
|
|
( if Num = 0 then
|
|
true
|
|
else
|
|
% 1048576 = 2^20
|
|
random.uniform_int_in_range(RNG, 0, 1048576, RN, !RS),
|
|
get_random_numbers(RNG, Num - 1, [RN | !.List], !:List, !RS)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred run_tests(maybe_double::in, maybe_write::in, which_test::in,
|
|
list(pair(list(int), list(int)))::in, io::di, io::uo) is det.
|
|
|
|
run_tests(_Double, _Write, _WhichTest, [], !IO).
|
|
run_tests(Double, Write, WhichTest, [Test | Tests], !IO) :-
|
|
run_test(Double, Write, WhichTest, Test, !IO),
|
|
run_tests(Double, Write, WhichTest, Tests, !IO).
|
|
|
|
:- pred run_test(maybe_double::in, maybe_write::in, which_test::in,
|
|
pair(list(int), list(int))::in, io::di, io::uo) is det.
|
|
|
|
run_test(Double, Write, WhichTest, List1 - List2, !IO) :-
|
|
do_run_test(Write, WhichTest, List1 - List2, !IO),
|
|
(
|
|
Double = do_not_double
|
|
;
|
|
Double = do_double,
|
|
DoubleList1 = list.map(double, List1),
|
|
DoubleList2 = list.map(double, List2),
|
|
do_run_test(Write, WhichTest, DoubleList1 - DoubleList2, !IO)
|
|
).
|
|
|
|
:- func double(int) = int.
|
|
|
|
double(X) = 2 * X.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred do_run_test(maybe_write::in, which_test::in,
|
|
pair(list(int), list(int))::in, io::di, io::uo) is det.
|
|
|
|
do_run_test(Write, WhichTest, List1 - List2, !IO) :-
|
|
(
|
|
Write = do_write,
|
|
io.nl(!IO),
|
|
io.write_string("List1: ", !IO),
|
|
io.write_list(list.sort(List1), ", ", io.write_int, !IO),
|
|
io.nl(!IO),
|
|
io.write_string("List2: ", !IO),
|
|
io.write_list(list.sort(List2), ", ", io.write_int, !IO),
|
|
io.nl(!IO),
|
|
io.nl(!IO)
|
|
;
|
|
Write = do_not_write
|
|
),
|
|
Set1 = test_bitset.list_to_set(List1),
|
|
Set2 = test_bitset.list_to_set(List2),
|
|
|
|
( if
|
|
( WhichTest = test_count
|
|
; WhichTest = test_all
|
|
)
|
|
then
|
|
io.write_string("testing count\n", !IO),
|
|
Count1 = test_bitset.count(Set1),
|
|
Count2 = test_bitset.count(Set2),
|
|
(
|
|
Write = do_write,
|
|
io.format("count: %d %d\n", [i(Count1), i(Count2)], !IO)
|
|
;
|
|
Write = do_not_write
|
|
)
|
|
else
|
|
true
|
|
),
|
|
|
|
( if
|
|
( WhichTest = test_foldl
|
|
; WhichTest = test_all
|
|
)
|
|
then
|
|
io.write_string("testing foldl\n", !IO),
|
|
Sum = (func(Elem, Acc) = Elem + Acc),
|
|
Result1 = test_bitset.foldl(Sum, Set1, 0),
|
|
Result2 = test_bitset.foldl(Sum, Set2, 0),
|
|
(
|
|
Write = do_write,
|
|
io.format("Sum of List1 = %d\n", [i(Result1)], !IO),
|
|
io.format("Sum of List2 = %d\n", [i(Result2)], !IO)
|
|
;
|
|
Write = do_not_write
|
|
)
|
|
else
|
|
true
|
|
),
|
|
|
|
( if
|
|
( WhichTest = test_union
|
|
; WhichTest = test_all
|
|
)
|
|
then
|
|
io.write_string("testing union\n", !IO),
|
|
Union = test_bitset.union(Set1, Set2),
|
|
maybe_write_bitset(Write, Union, !IO)
|
|
else
|
|
true
|
|
),
|
|
|
|
( if
|
|
( WhichTest = test_intersection
|
|
; WhichTest = test_all
|
|
)
|
|
then
|
|
io.write_string("testing intersection\n", !IO),
|
|
Intersection = test_bitset.intersect(Set1, Set2),
|
|
maybe_write_bitset(Write, Intersection, !IO)
|
|
else
|
|
true
|
|
),
|
|
|
|
( if
|
|
( WhichTest = test_difference
|
|
; WhichTest = test_all
|
|
)
|
|
then
|
|
io.write_string("testing difference\n", !IO),
|
|
Difference = test_bitset.difference(Set1, Set2),
|
|
maybe_write_bitset(Write, Difference, !IO)
|
|
else
|
|
true
|
|
),
|
|
|
|
( if
|
|
( WhichTest = test_remove_least
|
|
; WhichTest = test_all
|
|
)
|
|
then
|
|
io.write_string("testing remove_least\n", !IO),
|
|
( if test_bitset.remove_least(Least, Set1, RemovedLeast) then
|
|
(
|
|
Write = do_write,
|
|
io.write_int(Least, !IO),
|
|
io.nl(!IO)
|
|
;
|
|
Write = do_not_write
|
|
),
|
|
maybe_write_bitset(Write, RemovedLeast, !IO)
|
|
else
|
|
(
|
|
Write = do_write,
|
|
io.write_string("call failed\n", !IO)
|
|
;
|
|
Write = do_not_write
|
|
)
|
|
)
|
|
else
|
|
true
|
|
),
|
|
|
|
( if
|
|
( WhichTest = test_remove_leq
|
|
; WhichTest = test_all
|
|
),
|
|
get_middle(List1, Mid1Leq)
|
|
then
|
|
% We want to include the parameter we test the remove_leq operation
|
|
% with in the output when we are debugging either the operation
|
|
% or its test. However, we don't want to include it when generating
|
|
% output to be compared with a .exp file, because our caller calls us
|
|
% with random lists, which .exp files should know nothing about.
|
|
(
|
|
Write = do_write,
|
|
io.format("testing remove_leq %d\n", [i(Mid1Leq)], !IO)
|
|
;
|
|
Write = do_not_write
|
|
),
|
|
test_bitset.remove_leq(Set1, Mid1Leq, SetGtMid1),
|
|
maybe_write_bitset(Write, SetGtMid1, !IO)
|
|
else
|
|
true
|
|
),
|
|
|
|
( if
|
|
( WhichTest = test_remove_gt
|
|
; WhichTest = test_all
|
|
),
|
|
get_middle(List1, Mid1Gt)
|
|
then
|
|
% See the comment for test_remove_leq just above.
|
|
(
|
|
Write = do_write,
|
|
io.format("testing remove_gt %d\n", [i(Mid1Gt)], !IO)
|
|
;
|
|
Write = do_not_write
|
|
),
|
|
test_bitset.remove_gt(Set1, Mid1Gt, SetLeqMid1),
|
|
maybe_write_bitset(Write, SetLeqMid1, !IO)
|
|
else
|
|
true
|
|
),
|
|
|
|
( if
|
|
( WhichTest = test_delete
|
|
; WhichTest = test_all
|
|
)
|
|
then
|
|
io.write_string("testing delete\n", !IO),
|
|
list.foldl(test_bitset.delete, List2, Set1, Delete2From1),
|
|
maybe_write_bitset(Write, Delete2From1, !IO),
|
|
|
|
list.foldl(test_bitset.delete, List1, Set1, Delete1From1),
|
|
require(unify(Delete1From1, init), "Delete1From1 is not empty")
|
|
else
|
|
true
|
|
),
|
|
|
|
( if
|
|
( WhichTest = test_delete_list
|
|
; WhichTest = test_all
|
|
)
|
|
then
|
|
io.write_string("testing delete_list\n", !IO),
|
|
test_bitset.delete_list(List2, Set1, DeleteList2From1),
|
|
maybe_write_bitset(Write, DeleteList2From1, !IO),
|
|
|
|
test_bitset.delete_list(List1, Set1, DeleteList1From1),
|
|
require(unify(DeleteList1From1, init), "DeleteList1From1 is not empty")
|
|
else
|
|
true
|
|
),
|
|
|
|
( if
|
|
( WhichTest = test_divide_by_set
|
|
; WhichTest = test_all
|
|
)
|
|
then
|
|
io.write_string("testing divide_by_set\n", !IO),
|
|
test_bitset.divide_by_set(Set1, Set2, InSet, OutSet),
|
|
maybe_write_bitset(Write, InSet, !IO),
|
|
maybe_write_bitset(Write, OutSet, !IO)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred get_middle(list(int)::in, int::out) is semidet.
|
|
|
|
get_middle(List, Mid) :-
|
|
Head = list.head(List),
|
|
list.last(List, Last),
|
|
Mid = (Head + Last) / 2.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred maybe_write_bitset(maybe_write::in, test_bitset(int)::in,
|
|
io::di, io::uo) is det.
|
|
:- pragma no_inline(pred(maybe_write_bitset/4)).
|
|
|
|
maybe_write_bitset(Write, Set, !IO) :-
|
|
(
|
|
Write = do_write,
|
|
test_bitset.to_sorted_list(Set, List),
|
|
io.write_line(List, !IO)
|
|
;
|
|
Write = do_not_write
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|