[m-rev.] diff: test case for injection.m

[Mark Brown]

Estimated hours taken: 3
Branches: main

tests/hard_coded/Mmakefile:
tests/hard_coded/test_injection.exp:
tests/hard_coded/test_injection.m:
	Add a test case for the injection library module.

library/injection.m:
	injection.merge and injection.overlay do not actually throw exceptions
	like the documentation says.  The reason is that the underlying map
	implementation does not throw exceptions in these circumstances, but
	silently accepts the error.  We therefore continue to do the same,
	but update the documentation to reflect this.

	Note that getting map.m to throw exceptions in these circumstances
	would probably be the better solution.

Index: library/injection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/injection.m,v
retrieving revision 1.1
diff -u -r1.1 injection.m
--- library/injection.m	22 Jul 2005 12:32:06 -0000	1.1
+++ library/injection.m	23 Jul 2005 14:31:49 -0000
@@ -236,8 +236,7 @@
 	injection(K, V)::out) is det.
 
 	% Merge the contents of the two injections.  Both sets of keys must
-	% be disjoint, and both sets of values must be disjoint.  Throws an
-	% exception if this condition is not satisfied.
+	% be disjoint, and both sets of values must be disjoint.
 	%
 :- func injection.merge(injection(K, V), injection(K, V)) = injection(K, V).
 :- pred injection.merge(injection(K, V)::in, injection(K, V)::in,
@@ -245,8 +244,7 @@
 
 	% Merge the contents of the two injections.  For keys that occur in
 	% both injections, map them to the value in the second argument.
-	% Both sets of values must be disjoint.  Throws an exception if this
-	% condition is not satisfied.
+	% Both sets of values must be disjoint.
 	%
 :- func injection.overlay(injection(K, V), injection(K, V)) = injection(K, V).
 :- pred injection.overlay(injection(K, V)::in, injection(K, V)::in,
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.256
diff -u -r1.256 Mmakefile
--- tests/hard_coded/Mmakefile	23 May 2005 03:15:48 -0000	1.256
+++ tests/hard_coded/Mmakefile	23 Jul 2005 08:52:53 -0000
@@ -176,6 +176,7 @@
 	test_bitset \
 	test_cord \
 	test_imported_no_tag \
+	test_injection \
 	test_promise_impure_implicit \
 	time_test \
 	tim_qual1 \
Index: tests/hard_coded/test_injection.exp
===================================================================
RCS file: tests/hard_coded/test_injection.exp
diff -N tests/hard_coded/test_injection.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/test_injection.exp	23 Jul 2005 15:31:10 -0000
@@ -0,0 +1,47 @@
+Test "is_empty" passed.
+Test "not is_empty" passed.
+Test "set same" passed.
+Test "update new" passed.
+Test "forward_search succ 1" passed.
+Test "forward_search succ 2" passed.
+Test "forward_search fail" passed.
+Test "reverse_search succ 1" passed.
+Test "reverse_search succ 2" passed.
+Test "reverse_search fail" passed.
+Test "lookup throw" threw exception: software_error("map__lookup: key not found\n\tKey Type: int\n\tKey Value: 10\n\tValue Type: int")
+Test "reverse_lookup throw" threw exception: software_error("map__lookup: key not found\n\tKey Type: int\n\tKey Value: 1\n\tValue Type: int")
+Test "keys" passed.
+Test "values" passed.
+Test "insert fail on key" passed.
+Test "insert fail on value 1" passed.
+Test "insert fail on value 2" passed.
+Test "insert throw on key" threw exception: software_error("map__det_insert: key already present\n\tKey Type: int\n\tKey Value: 2\n\tValue Type: int")
+Test "insert throw on value 1" threw exception: software_error("map__det_insert: key already present\n\tKey Type: int\n\tKey Value: 20\n\tValue Type: int")
+Test "insert throw on value 2" threw exception: software_error("map__det_insert: key already present\n\tKey Type: int\n\tKey Value: 21\n\tValue Type: int")
+Test "update fail on key" passed.
+Test "update fail on value 1" passed.
+Test "update fail on value 2" passed.
+Test "update fail on value 3" passed.
+Test "update fail on value 4" passed.
+Test "update throw on key" threw exception: software_error("map__det_update: key not found\n\tKey Type: int\n\tKey Value: -1\n\tValue Type: int")
+Test "update throw on value 1" threw exception: software_error("map__det_insert: key already present\n\tKey Type: int\n\tKey Value: 20\n\tValue Type: int")
+Test "update throw on value 2" threw exception: software_error("map__det_insert: key already present\n\tKey Type: int\n\tKey Value: 21\n\tValue Type: int")
+Test "update throw on value 3" threw exception: software_error("map__det_insert: key already present\n\tKey Type: int\n\tKey Value: 30\n\tValue Type: int")
+Test "update throw on value 4" threw exception: software_error("map__det_insert: key already present\n\tKey Type: int\n\tKey Value: 31\n\tValue Type: int")
+Test "set succeed 1" passed.
+Test "set succeed 2" passed.
+Test "set succeed 3" passed.
+Test "set fail 1" passed.
+Test "set fail 2" passed.
+Test "set throw 1" threw exception: software_error("injection.det_set: value is already associated with another key")
+Test "set throw 2" threw exception: software_error("injection.det_set: value is already associated with another key")
+Test "delete_key" passed.
+Test "delete_value succ" passed.
+Test "delete_value throw" threw exception: software_error("injection.delete_value: value is associated with a key")
+Test "merge no overlap" passed.
+Test "overlay no overlap" passed.
+Test "overlay key overlap" passed.
+Test "map_keys injective" passed.
+Test "map_keys non-injective" passed.
+Test "map_values injective" passed.
+Test "map_values non-injective" threw exception: software_error("injection.map_values: merged two values with different keys")
Index: tests/hard_coded/test_injection.m
===================================================================
RCS file: tests/hard_coded/test_injection.m
diff -N tests/hard_coded/test_injection.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/test_injection.m	23 Jul 2005 16:00:51 -0000
@@ -0,0 +1,420 @@
+:- module test_injection.
+:- interface.
+:- import_module io.
+:- pred main(io::di, io::uo) is cc_multi.
+:- implementation.
+:- import_module assoc_list.
+:- import_module exception.
+:- import_module injection.
+:- import_module int.
+:- import_module list.
+:- import_module std_util.
+
+:- type test_inj == injection(int, int).
+:- type test_data == assoc_list(int, int).
+
+main(!IO) :-
+	injection.init(J0),
+	test(is_empty_test(J0), "is_empty", !IO),
+	test_data_1(Data1),
+	injection.det_insert_from_assoc_list(Data1, J0, J1),
+	test(not_is_empty_test(J1), "not is_empty", !IO),
+	test(set_same_test(J1, Data1), "set same", !IO),
+	test_data_2(Data2),
+	test(update_new(J1, Data2), "update new", !IO),
+	J = list.foldl((func(K - V, X) = injection.det_update(X, K, V)),
+		Data2, J1),
+	test_data(Data),
+	test(forward_search_succ_1(J, Data), "forward_search succ 1", !IO),
+	test(forward_search_succ_2(J, Data), "forward_search succ 2", !IO),
+	test(forward_search_fail(J, -1), "forward_search fail", !IO),
+	AllData = Data1 ++ Data2,
+	test(reverse_search_succ_1(J, AllData), "reverse_search succ 1", !IO),
+	test(reverse_search_succ_2(J, AllData), "reverse_search succ 2", !IO),
+	test(reverse_search_fail(J, -1), "reverse_search fail", !IO),
+	test(lookup_throw(J, 10), "lookup throw", !IO),
+	test(reverse_lookup_throw(J, 1), "reverse_lookup throw", !IO),
+	test(keys_test(J, Data), "keys", !IO),
+	test(values_test(J, AllData), "values", !IO),
+	test(insert_fail(J, 1, -1), "insert fail on key", !IO),
+	test(insert_fail(J, -1, 10), "insert fail on value 1", !IO),
+	test(insert_fail(J, -1, 11), "insert fail on value 2", !IO),
+	test(insert_throw(J, 2, -1), "insert throw on key", !IO),
+	test(insert_throw(J, -1, 20), "insert throw on value 1", !IO),
+	test(insert_throw(J, -1, 21), "insert throw on value 2", !IO),
+	test(update_fail(J, -1, -1), "update fail on key", !IO),
+	test(update_fail(J, 1, 10), "update fail on value 1", !IO),
+	test(update_fail(J, 1, 11), "update fail on value 2", !IO),
+	test(update_fail(J, 1, 20), "update fail on value 3", !IO),
+	test(update_fail(J, 1, 21), "update fail on value 4", !IO),
+	test(update_throw(J, -1, -1), "update throw on key", !IO),
+	test(update_throw(J, 2, 20), "update throw on value 1", !IO),
+	test(update_throw(J, 2, 21), "update throw on value 2", !IO),
+	test(update_throw(J, 2, 30), "update throw on value 3", !IO),
+	test(update_throw(J, 2, 31), "update throw on value 4", !IO),
+	test(set_succeed(J, 3, 30), "set succeed 1", !IO),
+	test(set_succeed(J, 3, 31), "set succeed 2", !IO),
+	test(set_succeed(J, 3, -1), "set succeed 3", !IO),
+	test(set_fail(J, 1, 20), "set fail 1", !IO),
+	test(set_fail(J, 1, 21), "set fail 2", !IO),
+	test(set_throw(J, 2, 10), "set throw 1", !IO),
+	test(set_throw(J, 2, 11), "set throw 2", !IO),
+	test(delete_key_test(J, 3), "delete_key", !IO),
+	test(delete_value_succ(J, 30), "delete_value succ", !IO),
+	test(delete_value_throw(J, 31), "delete_value throw", !IO),
+
+		% Tests of merging and overlaying injections.  Some are these
+		% are designed to test that an exception is thrown if the
+		% calling conditions are not met.  However, we don't actually
+		% throw an exception in these cases since the underlying map
+		% implementation doesn't either.  Hence these cases are
+		% disabled for the moment.
+		%
+	merge_test_data_no_overlap(NoOverlapData),
+	injection.det_set_from_assoc_list(NoOverlapData, J0, NoOverlapJ),
+	merge_test_data_key_overlap(KeyOverlapData),
+	injection.det_set_from_assoc_list(KeyOverlapData, J0, KeyOverlapJ),
+	% merge_test_data_value_overlap_1(ValOverlapData1),
+	% injection.det_set_from_assoc_list(ValOverlapData1, J0, ValOverlapJ1),
+	% merge_test_data_value_overlap_2(ValOverlapData2),
+	% injection.det_set_from_assoc_list(ValOverlapData2, J0, ValOverlapJ2),
+	test(merge_succ(J, NoOverlapJ), "merge no overlap", !IO),
+	% test(merge_throw(J, KeyOverlapJ), "merge key overlap", !IO),
+	% test(merge_throw(J, ValOverlapJ1), "merge value overlap 1", !IO),
+	% test(merge_throw(J, ValOverlapJ2), "merge value overlap 2", !IO),
+	test(overlay_succ(J, NoOverlapJ), "overlay no overlap", !IO),
+	test(overlay_succ(J, KeyOverlapJ), "overlay key overlap", !IO),
+	% test(overlay_throw(J, ValOverlapJ1), "overlay value overlap 1", !IO),
+	% test(overlay_throw(J, ValOverlapJ2), "overlay value overlap 2", !IO),
+
+	InjectiveMap = (func(_, V) = -V),
+	NonInjectiveMap = (func(_, _) = 0),
+	test(map_keys_test(J, InjectiveMap), "map_keys injective", !IO),
+	test(map_keys_test(J, NonInjectiveMap), "map_keys non-injective", !IO),
+	test(map_values_test(J, InjectiveMap), "map_values injective", !IO),
+	test(map_values_test(J, NonInjectiveMap), "map_values non-injective",
+		!IO).
+
+:- pred test_data_1(test_data::out) is det.
+
+test_data_1([1 - 10, 2 - 20, 3 - 30, 4 - 40, 5 - 50]).
+
+:- pred test_data_2(test_data::out) is det.
+
+test_data_2([1 - 11, 2 - 21, 3 - 31]).
+
+:- pred test_data(test_data::out) is det.
+
+test_data([1 - 11, 2 - 21, 3 - 31, 4 - 40, 5 - 50]).
+
+:- pred merge_test_data_no_overlap(test_data::out) is det.
+
+merge_test_data_no_overlap([6 - 60, 7 - 70, 8 - 80]).
+
+:- pred merge_test_data_key_overlap(test_data::out) is det.
+
+merge_test_data_key_overlap([5 - 150, 6 - 160, 7 - 170]).
+
+:- pred merge_test_data_value_overlap_1(test_data::out) is det.
+
+merge_test_data_value_overlap_1([6 - 60, 7 - 10, 8 - 80]).
+
+:- pred merge_test_data_value_overlap_2(test_data::out) is det.
+
+merge_test_data_value_overlap_2([6 - 60, 7 - 21, 8 - 80]).
+
+:- pred test(pred(string)::in(pred(out) is semidet), string::in,
+	io::di, io::uo) is cc_multi.
+
+test(Pred, Name, !IO) :-
+	io.write_strings(["Test """, Name, """ "], !IO),
+	try(Pred, Result),
+	(
+		Result = succeeded(Msg),
+		io.write_strings(["did not pass: ", Msg, ".\n"], !IO)
+	;
+		Result = failed,
+		io.write_string("passed.\n", !IO)
+	;
+		Result = exception(Univ),
+		io.write_string("threw exception: ", !IO),
+		io.write_univ(Univ, !IO),
+		io.write_string("\n", !IO)
+	).
+
+:- pred validate_injection(test_inj::in) is semidet.
+
+validate_injection(J) :-
+	(
+		\+ validate_condition_1(J)
+	->
+		throw("first invariant violated")
+	;
+		\+ validate_condition_2(J)
+	->
+		throw("second invariant violated")
+	;
+		semidet_succeed
+	).
+
+:- pred validate_condition_1(test_inj::in) is semidet.
+
+validate_condition_1(J) :-
+	injection.keys(J, Ks),
+	all [K, V] (
+		(
+			list.member(K, Ks),
+			injection.lookup(J, K, V)
+		) =>
+		injection.reverse_search(J, K, V)
+	).
+
+:- pred validate_condition_2(test_inj::in) is semidet.
+
+validate_condition_2(J) :-
+	injection.values(J, Vs),
+	all [K, V] (
+		(
+			list.member(V, Vs),
+			injection.reverse_lookup(J, K, V)
+		) =>
+		injection.forward_search(J, K, _)
+	).
+
+:- pred semidet_succeed(T::in) is semidet.
+
+semidet_succeed(_) :-
+	semidet_succeed.
+
+:- pred semidet_fail(T::in) is semidet.
+
+semidet_fail(_) :-
+	semidet_fail.
+
+%-----------------------------------------------------------------------------%
+
+:- pred is_empty_test(test_inj::in, string::out) is semidet.
+
+is_empty_test(J, "reported not empty") :-
+	\+ is_empty(J).
+
+:- pred not_is_empty_test(test_inj::in, string::out) is semidet.
+
+not_is_empty_test(J, "reported empty") :-
+	is_empty(J).
+
+:- pred set_same_test(test_inj::in, test_data::in, string::out) is semidet.
+
+set_same_test(J, Data, "set failed") :-
+	\+ (
+		injection.set_from_assoc_list(Data, J, NewJ),
+		validate_injection(NewJ)
+	).
+
+:- pred update_new(test_inj::in, test_data::in, string::out) is semidet.
+
+update_new(J, Data, "update failed") :-
+	some [K, V] (
+		list.member(K - V, Data),
+		\+ (
+			injection.update(J, K, V, NewJ),
+			validate_injection(NewJ)
+		)
+	).
+
+:- pred forward_search_succ_1(test_inj::in, test_data::in, string::out)
+	is semidet.
+
+forward_search_succ_1(J, Data, "key not found") :-
+	some [K] (
+		list.member(K - _, Data),
+		\+ injection.forward_search(J, K, _)
+	).
+
+:- pred forward_search_succ_2(test_inj::in, test_data::in, string::out)
+	is semidet.
+
+forward_search_succ_2(J, Data, "wrong value") :-
+	some [K, V] (
+		list.member(K - V, Data),
+		\+ injection.forward_search(J, K, V)
+	).
+
+:- pred forward_search_fail(test_inj::in, int::in, string::out) is semidet.
+
+forward_search_fail(J, K, "wrongly succeeded") :-
+	injection.forward_search(J, K, _).
+
+:- pred reverse_search_succ_1(test_inj::in, test_data::in, string::out)
+	is semidet.
+
+reverse_search_succ_1(J, Data, "value not found") :-
+	some [V] (
+		list.member(_ - V, Data),
+		\+ injection.reverse_search(J, _, V)
+	).
+
+:- pred reverse_search_succ_2(test_inj::in, test_data::in, string::out)
+	is semidet.
+
+reverse_search_succ_2(J, Data, "wrong key") :-
+	some [K, V] (
+		list.member(K - V, Data),
+		\+ injection.reverse_search(J, K, V)
+	).
+
+:- pred reverse_search_fail(test_inj::in, int::in, string::out) is semidet.
+
+reverse_search_fail(J, V, "wrongly succeeded") :-
+	injection.reverse_search(J, _, V).
+
+:- pred lookup_throw(test_inj::in, int::in, string::out) is semidet.
+
+lookup_throw(J, K, "wrongly succeeded") :-
+	injection.lookup(J, K, V),
+	semidet_succeed(V).
+
+:- pred reverse_lookup_throw(test_inj::in, int::in, string::out) is semidet.
+
+reverse_lookup_throw(J, V, "wrongly succeeded") :-
+	injection.reverse_lookup(J, K, V),
+	semidet_succeed(K).
+
+:- pred keys_test(test_inj::in, test_data::in, string::out) is semidet.
+
+keys_test(J, Data, "keys did not match") :-
+	injection.keys(J, Ks),
+	\+ (all [K] (
+		list.member(K - _, Data) <=> list.member(K, Ks)
+	)).
+
+:- pred values_test(test_inj::in, test_data::in, string::out) is semidet.
+
+values_test(J, Data, "values did not match") :-
+	injection.values(J, Vs),
+	\+ (all [V] (
+		list.member(_ - V, Data) <=> list.member(V, Vs)
+	)).
+
+:- pred insert_fail(test_inj::in, int::in, int::in, string::out) is semidet.
+
+insert_fail(J, K, V, "succeeded with duplicate") :-
+	injection.insert(J, K, V, _).
+
+:- pred insert_throw(test_inj::in, int::in, int::in, string::out) is semidet.
+
+insert_throw(J, K, V, "succeeded with duplicate") :-
+	injection.det_insert(J, K, V, NewJ),
+	validate_injection(NewJ).
+
+:- pred update_fail(test_inj::in, int::in, int::in, string::out) is semidet.
+
+update_fail(J, K, V, "wrongly succeeded") :-
+	injection.update(J, K, V, _).
+
+:- pred update_throw(test_inj::in, int::in, int::in, string::out) is semidet.
+
+update_throw(J, K, V, "wrongly succeeded") :-
+	injection.det_update(J, K, V, NewJ),
+	validate_injection(NewJ).
+
+:- pred set_succeed(test_inj::in, int::in, int::in, string::out) is semidet.
+
+set_succeed(J, K, V, "failed with valid value") :-
+	\+ (
+		injection.set(J, K, V, NewJ),
+		validate_injection(NewJ)
+	).
+
+:- pred set_fail(test_inj::in, int::in, int::in, string::out) is semidet.
+
+set_fail(J, K, V, "succeeded with duplicate value") :-
+	injection.set(J, K, V, _).
+
+:- pred set_throw(test_inj::in, int::in, int::in, string::out) is semidet.
+
+set_throw(J, K, V, "succeeded with duplicate value") :-
+	injection.det_set(J, K, V, NewJ),
+	validate_injection(NewJ).
+
+:- pred delete_key_test(test_inj::in, int::in, string::out) is semidet.
+
+delete_key_test(J, K, "dangling reference in reverse map") :-
+	injection.delete_key(K, J, NewJ),
+	validate_injection(NewJ),
+	injection.values(NewJ, Vs),
+	some [V] (
+		list.member(V, Vs),
+		injection.reverse_lookup(NewJ, K, V)
+	).
+
+:- pred delete_value_succ(test_inj::in, int::in, string::out) is semidet.
+
+delete_value_succ(J, V, "if you see this the test driver is broken") :-
+	injection.delete_value(V, J, NewJ),
+	validate_injection(NewJ),
+	semidet_fail(NewJ).
+
+:- pred delete_value_throw(test_inj::in, int::in, string::out) is semidet.
+
+delete_value_throw(J, V, "dangling reference in forward map") :-
+	injection.delete_value(V, J, NewJ),
+	validate_injection(NewJ).
+
+:- pred merge_succ(test_inj::in, test_inj::in, string::out) is semidet.
+
+merge_succ(J, M, "if you see this the test driver is broken") :-
+	injection.merge(J, M, NewJ),
+	validate_injection(NewJ),
+	semidet_fail(NewJ).
+
+:- pred merge_throw(test_inj::in, test_inj::in, string::out) is semidet.
+
+merge_throw(J, M, "duplicates accepted") :-
+	injection.merge(J, M, NewJ),
+	validate_injection(NewJ).
+
+:- pred overlay_succ(test_inj::in, test_inj::in, string::out) is semidet.
+
+overlay_succ(J, M, "if you see this the test driver is broken") :-
+	injection.overlay(J, M, NewJ),
+	validate_injection(NewJ),
+	semidet_fail(NewJ).
+
+:- pred overlay_throw(test_inj::in, test_inj::in, string::out) is semidet.
+
+overlay_throw(J, M, "duplicates accepted") :-
+	injection.overlay(J, M, NewJ),
+	validate_injection(NewJ).
+
+:- pred map_keys_test(test_inj::in, (func(int, int) = int)::in, string::out)
+	is semidet.
+
+map_keys_test(J, F, "bad transformation") :-
+	NewJ = injection.map_keys(F, J),
+	validate_injection(NewJ),
+	injection.values(J, Vs),
+	some [K, V] (
+		list.member(V, Vs),
+		injection.reverse_lookup(J, K, V),
+		\+ injection.reverse_lookup(NewJ, F(V, K), V)
+	).
+
+:- pred map_values_test(test_inj::in, (func(int, int) = int)::in, string::out)
+	is semidet.
+
+map_values_test(J, F, "bad transformation") :-
+	NewJ = injection.map_values(F, J),
+	validate_injection(NewJ),
+	injection.keys(J, Ks),
+	injection.values(J, Vs),
+	some [K, V] (
+		list.member(K, Ks),
+		injection.lookup(J, K, V),
+		\+ injection.lookup(NewJ, K, F(K, V))
+	;
+		list.member(V, Vs),
+		injection.reverse_lookup(J, K, V),
+		\+ injection.reverse_lookup(NewJ, K, F(K, V))
+	).
+
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------