mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 09:53:36 +00:00
33eb3028f5
tests/accumulator/*.m:
tests/analysis_*/*.m:
tests/benchmarks*/*.m:
tests/debugger*/*.{m,exp,inp}:
tests/declarative_debugger*/*.{m,exp,inp}:
tests/dppd*/*.m:
tests/exceptions*/*.m:
tests/general*/*.m:
tests/grade_subdirs*/*.m:
tests/hard_coded*/*.m:
Make these tests use four-space indentation, and ensure that
each module is imported on its own line. (I intend to use the latter
to figure out which subdirectories' tests can be executed in parallel.)
These changes usually move code to different lines. For the debugger tests,
specify the new line numbers in .inp files and expect them in .exp files.
448 lines
15 KiB
Mathematica
448 lines
15 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ts=4 sw=4 et ft=mercury
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Test bitmaps by checking the output against a simpler implementation.
|
|
|
|
:- module bitmap_tester.
|
|
|
|
:- interface.
|
|
|
|
:- import_module bitmap.
|
|
:- import_module bitmap_simple.
|
|
:- 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),
|
|
( verify(BM), BMArray = SBM ->
|
|
true
|
|
;
|
|
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),
|
|
( verify(BM), SBM = BMArray ->
|
|
Result = Tester
|
|
;
|
|
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,
|
|
( Res1 = Res2 ->
|
|
TheRes = Res1
|
|
;
|
|
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,
|
|
( Res1 = Res2 ->
|
|
TheRes = Res1
|
|
;
|
|
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) =
|
|
( Index < NumBits ->
|
|
to_sbitmap_2(Index + 1, NumBits, BM,
|
|
SBM ^ bit(Index) := BM ^ bit(Index))
|
|
;
|
|
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),
|
|
(
|
|
Functor = "\"" ++ Str ++ "\"",
|
|
BM = bitmap.from_string(Str)
|
|
->
|
|
semidet_succeed
|
|
;
|
|
throw(bitmap_verify_error(BM, to_string(Functor, Str)))
|
|
),
|
|
( bitmap.hash(BM) = foreign_hash(BM) ->
|
|
semidet_succeed
|
|
;
|
|
throw(bitmap_verify_error(BM, hash))
|
|
),
|
|
NumBits = BM ^ num_bits,
|
|
BitsInLastByte = NumBits `rem` bitmap.bits_per_byte,
|
|
( BitsInLastByte = 0 ->
|
|
true
|
|
; 0 = BM ^ unsafe_bits(NumBits, bitmap.bits_per_byte - BitsInLastByte) ->
|
|
true
|
|
;
|
|
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.
|
|
:- pragma promise_pure(foreign_hash/1).
|
|
|
|
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);"
|
|
).
|