mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 09:23:44 +00:00
38f1f5faf2
tests/hard_coded/bitmap_test_helper_1.m:
tests/hard_coded/curry_2_helper_1.m:
tests/hard_coded/deep_copy_bug.m:
tests/hard_coded/erroneous_liveness.m:
tests/hard_coded/foreign_type_1.m:
tests/hard_coded/hash_table_test.m:
tests/hard_coded/ho_float_reg.m:
tests/hard_coded/impl_def_lex_string.m:
tests/hard_coded/impure_foreign.m:
tests/hard_coded/intermod_multimode_helper_1.m:
tests/hard_coded/multimode.m:
tests/hard_coded/qual_is_test.m:
tests/hard_coded/string_codepoint.m:
tests/hard_coded/string_codepoint_offset_ilseq.m:
tests/hard_coded/string_count_codepoints_ilseq.m:
tests/hard_coded/string_set_char.m:
tests/hard_coded/version_hash_table_test_2.m:
tests/submodules/parent_t2.m:
tests/typeclasses/arbitrary_constraint_pred_1.m:
tests/typeclasses/arbitrary_constraint_pred_2.m:
tests/typeclasses/instance_unconstrained_tvar_type_spec.m:
tests/typeclasses/typeclass_order_bug_1.m:
Change code to avoid compiler warnings where this is (a) possible,
and (b) does not interfere with the purpose of the test.
tests/hard_coded/string_codepoint.exp:
tests/hard_coded/string_codepoint_offset_ilseq.exp:
tests/hard_coded/string_codepoint_offset_ilseq.exp2:
The changes to the source files of these tests changed all references
to "codepoint" to "code_point", including in the text they output.
Expect the updated output.
tests/general/Mercury.options:
tests/hard_coded/Mercury.options:
tests/typeclasses/Mercury.options:
tests/submodules/Mercury.options:
Disable many of the remaining warnings.
451 lines
15 KiB
Mathematica
451 lines
15 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ts=4 sw=4 et ft=mercury
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Test bitmaps by checking the output against a simpler implementation.
|
|
|
|
:- module bitmap_test_helper_1.
|
|
|
|
:- interface.
|
|
|
|
:- import_module bitmap.
|
|
:- import_module bitmap_test_helper_2.
|
|
:- import_module bool.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type mypair(T, U)
|
|
---> (fst::T) - (snd::U).
|
|
:- type tbitmap == mypair(bitmap, sbitmap).
|
|
|
|
:- inst tbitmap == bound(bitmap - sbitmap).
|
|
:- inst uniq_tbitmap == tbitmap. % XXX should be unique
|
|
:- mode tbitmap_di == in(uniq_tbitmap). % XXX should be di
|
|
:- mode tbitmap_uo == out(uniq_tbitmap).
|
|
:- mode tbitmap_ui == in(uniq_tbitmap).
|
|
|
|
:- type bitmap_result_error
|
|
---> some [OtherArgs] one_argument(string, sbitmap, OtherArgs, tbitmap)
|
|
; some [OtherArgs] two_arguments(string, sbitmap, sbitmap,
|
|
OtherArgs, tbitmap)
|
|
; some [OtherArgs, Result] query(string, sbitmap, OtherArgs,
|
|
mypair(Result, Result))
|
|
; some [OtherArgs, Result] binary_query(string, sbitmap, sbitmap,
|
|
OtherArgs, mypair(Result, Result)).
|
|
|
|
:- type bitmap_verify_error
|
|
---> bitmap_verify_error(bitmap, bitmap_verify_error_type).
|
|
|
|
:- type bitmap_verify_error_type
|
|
---> hash
|
|
; trailing_bits_not_empty
|
|
; to_string(string, string).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% new(N, B) creates a bitmap of size N (indexed 0 .. N-1)
|
|
% setting each bit if B = yes and clearing each bit if B = no.
|
|
% An exception is thrown if N is negative.
|
|
%
|
|
:- func new(num_bits, bool) = tbitmap.
|
|
:- mode new(in, in) = tbitmap_uo is det.
|
|
|
|
% Create a new copy of a bitmap.
|
|
%
|
|
:- func copy(tbitmap) = tbitmap.
|
|
%:- mode copy(tbitmap_ui) = tbitmap_uo is det.
|
|
:- mode copy(in) = tbitmap_uo is det.
|
|
|
|
% resize(BM, N, B) resizes bitmap BM to have N bits; if N is
|
|
% smaller than the current number of bits in BM then the excess
|
|
% are discarded. If N is larger than the current number of bits
|
|
% in BM then the new bits are set if B = yes and cleared if
|
|
% B = no.
|
|
%
|
|
:- func resize(tbitmap, num_bits, bool) = tbitmap.
|
|
:- mode resize(tbitmap_di, in, in) = tbitmap_uo is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Get or set the given bit.
|
|
% The unsafe versions do not check whether the bit is in range.
|
|
%
|
|
:- func bit(bit_index, tbitmap) = bool.
|
|
%:- mode bit(in, tbitmap_ui) = out is det.
|
|
:- mode bit(in, in) = out is det.
|
|
|
|
:- func 'bit :='(bit_index, tbitmap, bool) = tbitmap.
|
|
:- mode 'bit :='(in, tbitmap_di, in) = tbitmap_uo is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Bitmap ^ bits(OffSet, NumBits) = Word.
|
|
% The low order bits of Word contain the NumBits bits of BM
|
|
% starting at OffSet.
|
|
% NumBits must be less than int.bits_per_int.
|
|
%
|
|
:- func bits(bit_index, num_bits, tbitmap) = word.
|
|
%:- mode bits(in, in, tbitmap_ui) = out is det.
|
|
:- mode bits(in, in, in) = out is det.
|
|
|
|
:- func 'bits :='(bit_index, num_bits, tbitmap, word) = tbitmap.
|
|
:- mode 'bits :='(in, in, tbitmap_di, in) = tbitmap_uo is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func byte(int, tbitmap) = int.
|
|
%:- mode byte(in, tbitmap_ui) = out is det.
|
|
:- mode byte(in, in) = out is det.
|
|
|
|
:- func 'byte :='(int, tbitmap, int) = tbitmap.
|
|
:- mode 'byte :='(in, tbitmap_di, in) = tbitmap_uo is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Flip the given bit.
|
|
%
|
|
:- func flip(tbitmap, bit_index) = tbitmap.
|
|
:- mode flip(tbitmap_di, in) = tbitmap_uo is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Set operations; for binary operations the second argument is altered
|
|
% in all cases. The input bitmaps must have the same size.
|
|
%
|
|
|
|
:- func complement(tbitmap) = tbitmap.
|
|
:- mode complement(tbitmap_di) = tbitmap_uo is det.
|
|
|
|
:- func union(tbitmap, tbitmap) = tbitmap.
|
|
%:- mode union(tbitmap_ui, tbitmap_di) = tbitmap_uo is det.
|
|
:- mode union(in, tbitmap_di) = tbitmap_uo is det.
|
|
|
|
:- func intersect(tbitmap, tbitmap) = tbitmap.
|
|
%:- mode intersect(tbitmap_ui, tbitmap_di) = tbitmap_uo is det.
|
|
:- mode intersect(in, tbitmap_di) = tbitmap_uo is det.
|
|
|
|
:- func difference(tbitmap, tbitmap) = tbitmap.
|
|
%:- mode difference(tbitmap_ui, tbitmap_di) = tbitmap_uo is det.
|
|
:- mode difference(in, tbitmap_di) = tbitmap_uo is det.
|
|
|
|
:- func xor(tbitmap, tbitmap) = tbitmap.
|
|
%:- mode xor(tbitmap_ui, tbitmap_di) = tbitmap_uo is det.
|
|
:- mode xor(in, tbitmap_di) = tbitmap_uo is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% copy_bits(SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits)
|
|
%
|
|
% Overwrite NumBits bits in DestBM starting at DestStartBit with
|
|
% the NumBits bits starting at SrcStartBit in SrcBM.
|
|
%
|
|
:- func copy_bits(tbitmap, bit_index, tbitmap, bit_index, num_bits) = tbitmap.
|
|
%:- mode copy_bits(tbitmap_ui, in, tbitmap_di, in, in) = tbitmap_uo is det.
|
|
:- mode copy_bits(in, in, tbitmap_di, in, in) = tbitmap_uo is det.
|
|
|
|
% copy_bits_in_bitmap(BM, SrcStartBit, DestStartBit, NumBits)
|
|
%
|
|
% Overwrite NumBits bits starting at DestStartBit with the NumBits
|
|
% bits starting at SrcStartBit in the same bitmap.
|
|
%
|
|
:- func copy_bits_in_bitmap(tbitmap, bit_index, bit_index, num_bits) = tbitmap.
|
|
:- mode copy_bits_in_bitmap(tbitmap_di, in, in, in) = tbitmap_uo is det.
|
|
|
|
% copy_bytes(SrcBM, SrcStartByte, DestBM, DestStartByte, NumBytes)
|
|
%
|
|
% Overwrite NumBytes bytes in DestBM starting at DestStartByte with
|
|
% the NumBytes bytes starting at SrcStartByte in SrcBM.
|
|
%
|
|
:- func copy_bytes(tbitmap, byte_index, tbitmap, byte_index,
|
|
num_bytes) = tbitmap.
|
|
%:- mode copy_bytes(tbitmap_ui, in, tbitmap_di, in, in) = tbitmap_uo is det.
|
|
:- mode copy_bytes(in, in, tbitmap_di, in, in) = tbitmap_uo is det.
|
|
|
|
% copy_bytes_in_bitmap(BM, SrcStartByte, DestStartByte, NumBytes)
|
|
%
|
|
% Overwrite NumBytes bytes starting at DestStartByte with the NumBytes
|
|
% bytes starting at SrcStartByte in the same bitmap.
|
|
%
|
|
:- func copy_bytes_in_bitmap(tbitmap, byte_index, byte_index,
|
|
num_bytes) = tbitmap.
|
|
:- mode copy_bytes_in_bitmap(tbitmap_di, in, in, in) = tbitmap_uo is det.
|
|
|
|
:- func to_byte_string(tbitmap) = string.
|
|
%:- mode to_byte_string(tbitmap_ui) = out is det.
|
|
:- mode to_byte_string(in) = out is det.
|
|
|
|
:- func ordering(tbitmap, tbitmap) = comparison_result.
|
|
:- mode ordering(tbitmap_ui, tbitmap_ui) = out is det.
|
|
|
|
:- func test_unify(tbitmap, tbitmap) = bool.
|
|
:- mode test_unify(tbitmap_ui, tbitmap_ui) = out is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module char.
|
|
:- import_module deconstruct.
|
|
:- import_module enum.
|
|
:- import_module exception.
|
|
:- import_module int.
|
|
:- import_module list.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
new(N, B) = bitmap.init(N, B) - new(N, B).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
resize(BM, NewSize, InitializerBit) =
|
|
check("resize", BM, {NewSize, InitializerBit},
|
|
resize(BM ^ fst, NewSize, InitializerBit)
|
|
- resize(BM ^ snd, NewSize, InitializerBit)).
|
|
|
|
copy(BM) =
|
|
check("copy", BM, {}, copy(BM ^ fst) - copy(BM ^ snd)).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
bit(I, BM) =
|
|
check_query("bit", BM, I, BM ^ fst ^ bit(I) - BM ^ snd ^ bit(I)).
|
|
|
|
'bit :='(I, BM, B) =
|
|
check("bit :=", BM, {I, B},
|
|
(BM ^ fst ^ bit(I) := B)
|
|
^ snd ^ bit(I) := B).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
bits(FirstBit, NumBits, BM) =
|
|
check_query("bits", BM, {FirstBit, NumBits},
|
|
BM ^ fst ^ bits(FirstBit, NumBits) -
|
|
BM ^ snd ^ bits(FirstBit, NumBits)).
|
|
|
|
'bits :='(FirstBit, NumBits, BM, Bits) =
|
|
check("bits :=", BM, {FirstBit, NumBits},
|
|
(BM ^ fst ^ bits(FirstBit, NumBits) := Bits)
|
|
^ snd ^ bits(FirstBit, NumBits) := Bits).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
byte(I, BM) =
|
|
check_query("byte", BM, I, BM ^ fst ^ byte(I) - BM ^ snd ^ byte(I)).
|
|
|
|
'byte :='(I, BM, B) =
|
|
check("byte :=", BM, {I, B},
|
|
(BM ^ fst ^ byte(I) := B)
|
|
^ snd ^ byte(I) := B).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
flip(BM, I) =
|
|
check("bits :=", BM, I, flip(BM ^ fst, I) - flip(BM ^ snd, I)).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
complement(BM) =
|
|
check("complement", BM, {}, complement(BM ^ fst) - complement(BM ^ snd)).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
union(BMa, BMb) =
|
|
check2("union", BMa, BMb, {},
|
|
union(BMa ^ fst, BMb ^ fst)
|
|
- union(BMa ^ snd, BMb ^ snd)).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
intersect(BMa, BMb) =
|
|
check2("intersect", BMa, BMb, {},
|
|
intersect(BMa ^ fst, BMb ^ fst)
|
|
- intersect(BMa ^ snd, BMb ^ snd)).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
difference(BMa, BMb) =
|
|
check2("difference", BMa, BMb, {},
|
|
difference(BMa ^ fst, BMb ^ fst)
|
|
- difference(BMa ^ snd, BMb ^ snd)).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
xor(BMa, BMb) =
|
|
check2("xor", BMa, BMb, {},
|
|
xor(BMa ^ fst, BMb ^ fst)
|
|
- xor(BMa ^ snd, BMb ^ snd)).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
copy_bits(SrcBM, SrcStartBit, DestBM, DestStartBit, NumBits) =
|
|
check2("copy_bits", SrcBM, DestBM, {SrcStartBit, DestStartBit, NumBits},
|
|
copy_bits(SrcBM ^ fst, SrcStartBit,
|
|
DestBM ^ fst, DestStartBit, NumBits) -
|
|
copy_bits(SrcBM ^ snd, SrcStartBit,
|
|
DestBM ^ snd, DestStartBit, NumBits)).
|
|
|
|
copy_bits_in_bitmap(SrcBM, SrcStartBit, DestStartBit, NumBits) =
|
|
check("copy_bits_in_bitmap", SrcBM, {SrcStartBit, DestStartBit, NumBits},
|
|
copy_bits_in_bitmap(SrcBM ^ fst, SrcStartBit, DestStartBit, NumBits) -
|
|
copy_bits_in_bitmap(SrcBM ^ snd, SrcStartBit, DestStartBit, NumBits)).
|
|
|
|
copy_bytes(SrcBM, SrcStartByte, DestBM, DestStartByte, NumBytes) =
|
|
check2("copy_bytes", SrcBM, DestBM,
|
|
{SrcStartByte, DestStartByte, NumBytes},
|
|
copy_bytes(SrcBM ^ fst, SrcStartByte,
|
|
DestBM ^ fst, DestStartByte, NumBytes) -
|
|
copy_bytes(SrcBM ^ snd, SrcStartByte,
|
|
DestBM ^ snd, DestStartByte, NumBytes)).
|
|
|
|
copy_bytes_in_bitmap(SrcBM, SrcStartByte, DestStartByte, NumBytes) =
|
|
check("copy_bytes_in_bitmap", SrcBM,
|
|
{SrcStartByte, DestStartByte, NumBytes},
|
|
copy_bytes_in_bitmap(SrcBM ^ fst, SrcStartByte,
|
|
DestStartByte, NumBytes) -
|
|
copy_bytes_in_bitmap(SrcBM ^ snd, SrcStartByte,
|
|
DestStartByte, NumBytes)).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
ordering(BM1, BM2) =
|
|
check_query2("ordering", BM1, BM2, {},
|
|
builtin.ordering(BM1 ^ fst, BM2 ^ fst) -
|
|
builtin.ordering(BM1 ^ snd, BM2 ^ snd)).
|
|
|
|
test_unify(BM1, BM2) =
|
|
check_query2("test_unify", BM1, BM2, {},
|
|
pred_to_bool(unify(BM1 ^ fst, BM2 ^ fst)) -
|
|
pred_to_bool(unify(BM1 ^ snd, BM2 ^ snd))).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func check(string, tbitmap, OtherArgs, tbitmap) = tbitmap.
|
|
%:- mode check(in, tbitmap_ui, in, tbitmap_di) = tbitmap_uo is det.
|
|
:- mode check(in, in, in, tbitmap_di) = tbitmap_uo is det.
|
|
|
|
check(Op, Tester0, OtherArgs, Tester) = Tester :-
|
|
Tester = BM - SBM,
|
|
BMArray = to_sbitmap(BM),
|
|
( if verify(BM), BMArray = SBM then
|
|
true
|
|
else
|
|
throw('new one_argument'(Op, Tester0 ^ snd, OtherArgs, Tester))
|
|
).
|
|
|
|
:- func check2(string, tbitmap, tbitmap, OtherArgs, tbitmap) = tbitmap.
|
|
%:- mode check2(in, tbitmap_ui, tbitmap_ui, in, tbitmap_di) = tbitmap_uo is det.
|
|
:- mode check2(in, in, in, in, tbitmap_di) = tbitmap_uo is det.
|
|
|
|
check2(Op, Tester1, Tester2, OtherArgs, Tester) = Result :-
|
|
Tester = BM - SBM,
|
|
BMArray = to_sbitmap(BM),
|
|
( if verify(BM), SBM = BMArray then
|
|
Result = Tester
|
|
else
|
|
throw('new two_arguments'(Op, Tester1 ^ snd, Tester2 ^ snd,
|
|
OtherArgs, Tester))
|
|
).
|
|
|
|
:- func check_query(string, tbitmap, OtherArgs, mypair(T, T)) = T.
|
|
%:- mode check_query(in, tbitmap_ui, in, in) = out is det.
|
|
:- mode check_query(in, in, in, in) = out is det.
|
|
|
|
check_query(Op, Tester1, OtherArgs, Res) = TheRes :-
|
|
Res = Res1 - Res2,
|
|
( if Res1 = Res2 then
|
|
TheRes = Res1
|
|
else
|
|
throw('new query'(Op, Tester1 ^ snd, OtherArgs, Res))
|
|
).
|
|
|
|
:- func check_query2(string, tbitmap, tbitmap,
|
|
OtherArgs, mypair(T, T)) = T.
|
|
%:- mode check_query2(in, tbitmap_ui, tbitmap_ui, in, in) = out is det.
|
|
:- mode check_query2(in, in, in, in, in) = out is det.
|
|
|
|
check_query2(Op, Tester1, Tester2, OtherArgs, Res) = TheRes :-
|
|
Res = Res1 - Res2,
|
|
( if Res1 = Res2 then
|
|
TheRes = Res1
|
|
else
|
|
throw('new binary_query'(Op, Tester1 ^ snd, Tester2 ^ snd,
|
|
OtherArgs, Res))
|
|
).
|
|
|
|
:- func to_sbitmap(bitmap) = sbitmap.
|
|
%:- mode to_sbitmap(bitmap_ui) = sbitmap_uo.
|
|
:- mode to_sbitmap(in) = sbitmap_uo.
|
|
|
|
to_sbitmap(BM) =
|
|
to_sbitmap_2(0, BM ^ num_bits, BM, new(BM ^ num_bits, no)).
|
|
|
|
:- func to_sbitmap_2(int, int, bitmap, sbitmap) = sbitmap.
|
|
%:- mode to_sbitmap_2(in, in, bitmap_ui, sbitmap_di) = sbitmap_uo.
|
|
:- mode to_sbitmap_2(in, in, in, sbitmap_di) = sbitmap_uo.
|
|
|
|
to_sbitmap_2(Index, NumBits, BM, SBM) =
|
|
( if Index < NumBits then
|
|
to_sbitmap_2(Index + 1, NumBits, BM,
|
|
SBM ^ bit(Index) := BM ^ bit(Index))
|
|
else
|
|
SBM
|
|
).
|
|
|
|
to_byte_string(BM) = to_byte_string(BM ^ fst).
|
|
|
|
% At each step we check that the output bitmap can be converted to
|
|
% and from a string, and that the hash produced by the Mercury code
|
|
% in bitmap.m matches that produced by the C code in mercury_bitmap.h.
|
|
% We also check that any trailing bits in the final byte are empty.
|
|
:- pred verify(bitmap).
|
|
%:- mode verify(bitmap_ui) is semidet.
|
|
:- mode verify(in) is semidet.
|
|
|
|
verify(BM) :-
|
|
% functor/4 uses MR_bitmap_to_string in runtime/mercury_bitmap.h.
|
|
functor(BM, do_not_allow, Functor, _Arity),
|
|
Str = bitmap.to_string(BM),
|
|
( if
|
|
Functor = "\"" ++ Str ++ "\"",
|
|
BM = bitmap.from_string(Str)
|
|
then
|
|
semidet_succeed
|
|
else
|
|
throw(bitmap_verify_error(BM, to_string(Functor, Str)))
|
|
),
|
|
( if bitmap.hash(BM) = foreign_hash(BM) then
|
|
semidet_succeed
|
|
else
|
|
throw(bitmap_verify_error(BM, hash))
|
|
),
|
|
NumBits = BM ^ num_bits,
|
|
BitsInLastByte = NumBits `rem` bitmap.bits_per_byte,
|
|
( if
|
|
BitsInLastByte = 0
|
|
then
|
|
true
|
|
else if
|
|
0 = BM ^ unsafe_bits(NumBits, bitmap.bits_per_byte - BitsInLastByte)
|
|
then
|
|
true
|
|
else
|
|
throw(bitmap_verify_error(BM, trailing_bits_not_empty))
|
|
).
|
|
|
|
:- pragma foreign_decl("C", "#include ""mercury_bitmap.h""").
|
|
|
|
:- func foreign_hash(bitmap) = int.
|
|
%:- mode foreign_hash(bitmap_ui) = out is det.
|
|
:- mode foreign_hash(in) = out is det.
|
|
|
|
foreign_hash(BM) = bitmap.hash(BM).
|
|
|
|
:- pragma foreign_proc("C",
|
|
foreign_hash(BM::in) = (Hash::out),
|
|
[will_not_call_mercury, promise_pure],
|
|
"
|
|
Hash = MR_hash_bitmap(BM);
|
|
").
|