bags.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
class TEST_BAG{T}
class TEST_BAG{T} is
-- This is a class to assist in the testing of bag implementations.
--
-- WARNING This class is not portable and can only be guaranteed to run on
-- the machine on which it was compiled.
-- Version 1.0 Nov 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 19 Nov 98 kh Original for 1.2
include TEST ;
eq(
bag1,
bag2 : $RO_BAG{T}
) : BOOL is
-- This predicate returns true if and only if the two bags are equal.
-- When debugging it may be useful to add some diagnostic write calls.
return bag1.equals(bag2)
end ;
test_setlike_bags(
bag0,
bag1,
bag3 : $RO_BAG{T},
elems : ARRAY{T}
) is
-- This routine implements tests of bags which look like sets. The same
-- tests can be run on sets and the results should be the same.
--
-- bag0 must be empty
-- bag1 must contain {0,2,4,6}
-- bag3 must contain {1,2,3,4,5,6,7,8,9,10}
tpstr : STR := SYS::str_for_tp(SYS::tp(bag1)) ;
class_name("setlike BAG:" + tpstr) ;
bag2 : $RO_BAG{T} := bag1.copy ;
test("concat", eq(bag1.concat(bag2),
bag1.add(elems[0]).add(elems[2]).add(elems[4]).add(elems[6])).str,
true.str) ;
test("union",eq(bag3.union(bag2),bag3.add(elems[0])).str,true.str) ;
test("intersection",eq(bag3.intersection(bag2),bag2.delete(elems[0])).str,
true.str) ;
finish
end ;
test_bag_readonly(
bag0,
bag1,
bag3 : $RO_BAG{T},
elems : ARRAY{T}
) is
-- This routine carries out various tests of the read-only/value class
-- routines. The elems argument contains the elements of the bags referred
-- to by the index below
--
-- bag0 must be empty
-- bag1 must contain {0,2,2,4,6,6}
-- bag3 must contain {1,2,3,4,5,6,7,8,9,9,10,10,10}
tpstr : STR := SYS::str_for_tp(SYS::tp(bag1)) ;
class_name("readonly BAG: " + tpstr) ;
bag2 : $RO_BAG{T} := bag1.copy ;
test("size",bag0.size.str,0.str) ;
test("size",bag1.size.str,6.str) ;
test("is_empty",bag0.is_empty.str,true.str) ;
test("is_empty",bag1.is_empty.str,false.str) ;
test("bag1.contains(0)",bag1.contains(elems[0]).str,true.str) ;
test("bag1.contains(1)",bag1.contains(elems[1]).str,false.str) ;
test("bag1.count(2)",bag1.count(elems[1]).str,0.str) ;
test("bag1.count(2)",bag1.count(elems[2]).str,2.str) ;
test("bag1.count(0)",bag1.count(elems[0]).str,1.str) ;
test("bag1 equals bag2",eq(bag1,bag2).str,true.str) ;
test("bag1.n_unique",bag1.n_unique.str,4.str) ;
bag1_copy : $RO_BAG{T} := bag1.copy ;
nun : CARD := 0 ;
loop
item : T := bag1.unique! ;
nun := nun + 1 ;
bag1_copy := bag1_copy.delete_all(item)
end ;
test("bag1.unique!",nun.str,4.str) ;
test("bag1_copy.size",bag1_copy.size.str,0.str) ;
test("bag1.is_subset_of(bag2)",bag1.is_subset_of(bag2).str,true.str) ;
test("bag1.concat(bag2)",eq(bag1.concat(bag2),
bag1.add(elems[0]).add(elems[2]).add(elems[2]).add(elems[4]).
add(elems[6]).add(elems[6])).str,true.str) ;
test("bag1.union(bag2)",eq(bag1.union(bag2),bag1).str,true.str) ;
test("bag1.union(bag3)",eq(bag1.union(bag3), bag3.add(elems[0]).
add(elems[2]).add(elems[6])).str,true.str) ;
test("bag1.intersection(bag3)",eq(bag1.intersection(bag3),
bag2.delete(elems[0]).delete(elems[2]).delete(elems[6])).str,
true.str) ;
finish
end ;
test_bag_reference(
bag0,
bag1,
bag2 : $BAG{T},
elems : ARRAY{T}
) is
-- This routine carries out various tests of the read-only/value class
-- routines
--
-- bag0 must be empty
-- bag1 must contain {0,1,2,3,4,4}
-- bag2 must contain {0,2,3,5}
tpstr : STR := SYS::str_for_tp(SYS::tp(bag1)) ;
class_name("modifying SET: " + tpstr) ;
-- Use the readonly version to verify the result
bag3 : $BAG{T} := bag1.copy ;
bag3.add(elems[0]) ;
bag3.add(elems[1]) ;
bag3.add(elems[2]) ;
bag3.delete_all(elems[4]) ;
bag3.delete(elems[3]) ;
test("add,delete",eq(bag3,bag1.add(elems[0]).add(elems[1]).add(elems[2]).
delete_all(elems[4]).delete(elems[3])).str,true.str) ;
bag5 : $BAG{T} := bag1.copy ;
bag5.to_concat(bag2) ;
test("to_concat",eq(bag5, bag1.concat(bag2)).str,true.str) ;
bag6 : $BAG{T} := bag1.copy ;
bag6.to_union(bag2) ;
test("to_union",eq(bag6,bag1.union(bag2)).str,true.str) ;
bag7 : $BAG{T} := bag1.copy ;
bag7.to_intersection(bag2) ;
test("to_intersection",eq(bag7,bag1.intersection(bag2)).str,true.str) ;
bag8 : $BAG{T} := bag1.copy ;
bag8.clear ;
test("clear",eq(bag7,bag1.intersection(bag2)).str,true.str) ;
finish
end ;
end ; -- TEST_BAG{T}
class TEST_BAG
class TEST_BAG is
-- This is a program class to test the implementation of bags.
--
-- WARNING This class is not portable and can only be guaranteed to run on
-- the machine on which it was compiled.
-- Version 1.1 Nov 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 24 Oct 97 kh Original from Sather 1.1 distribution
-- 19 Nov 98 kh Revised for 1.2
include TEST ;
test_num_bag is
-- This routine sets up some bags of numeric values and then uses
-- the parameterised test class to carry out the actual tests.
elts : ARRAY{CARD} := |0,1,2,3,4,5,6,7,8,9,10,11| ;
bags0 : BAG{CARD} := BAG{CARD}::create ;
bags1 : BAG{CARD} := BAG{CARD}::create(|0,2,2,4,6,6|) ;
bags2 : BAG{CARD} := BAG{CARD}::create(|1,2,3,4,5,6,7,8,9,9,10,10,10|) ;
TEST_BAG{CARD}::test_bag_readonly(bags0,bags1,bags2,elts) ;
TEST_BAG{CARD}::test_bag_reference(bags0,bags1,bags2,elts)
end ;
test_flt_bag is
-- This routine sets up some bags of floating point values and then uses
-- the parameterised test class to carry out the actual tests.
eltsflt : ARRAY{FLT} := |0.0,1.0,2.0,3.0,4.0,5.0,6.0,
7.0,8.0,9.0,10.0,11.0| ;
bags0 : BAG{FLT} := BAG{FLT}::create ;
bags1 : BAG{FLT} := BAG{FLT}::create(|0.0,2.0,2.0,4.0,6.0,6.0|) ;
bags2 : BAG{FLT} := BAG{FLT}::create(|1.0,2.0,3.0,4.0,5.0,6.0,7.0,
8.0,9.0,9.0,10.0,10.0,10.0|) ;
TEST_BAG{FLT}::test_bag_readonly(bags0,bags1,bags2,eltsflt) ;
TEST_BAG{FLT}::test_bag_reference(bags0,bags1,bags2,eltsflt)
end ;
test_num_vbag is
-- This routine sets up some bags of numeric values and then uses
-- the parameterised test class to carry out the actual tests.
elts : ARRAY{CARD} := |0,1,2,3,4,5,6,7,8,9,10,11| ;
bags0 : VBAG{CARD} := VBAG{CARD}::create ;
bags1 : VBAG{CARD} := VBAG{CARD}::create(|0,2,2,4,6,6|) ;
bags2 : VBAG{CARD} := VBAG{CARD}::create(|1,2,3,4,5,6,7,8,9,9,10,10,10|) ;
TEST_BAG{CARD}::test_bag_readonly(bags0,bags1,bags2,elts)
end ;
test_flt_vbag is
-- This routine sets up some bags of floating point values and then uses
-- the parameterised test class to carry out the actual tests.
eltsflt : ARRAY{FLT} := |0.0,1.0,2.0,3.0,4.0,5.0,6.0,
7.0,8.0,9.0,10.0,11.0| ;
bags0 : VBAG{FLT} := VBAG{FLT}::create ;
bags1 : VBAG{FLT} := VBAG{FLT}::create(|0.0,2.0,2.0,4.0,6.0,6.0|);
bags2 : VBAG{FLT} := VBAG{FLT}::create(|1.0,2.0,3.0,4.0,5.0,6.0,
7.0,8.0,9.0,9.0,10.0,10.0,10.0|) ;
TEST_BAG{FLT}::test_bag_readonly(bags0,bags1,bags2,eltsflt)
end ;
main is
test_num_bag ;
test_flt_bag ;
test_num_vbag ;
test_flt_vbag
end ;
end ; -- TEST_BAG