[m-rev.] for post-commit review: fix mantis bug 207

Zoltan Somogyi zs at csse.unimelb.edu.au
Thu Jul 28 14:51:58 AEST 2011
Previous message: [m-rev.] for review: separate gcc and clang specific code in the runtime
Next message: [m-rev.] for review: peephole optimization for the MLDS
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
library/tree_bitset.m:
	Fix Mantis bug 207.

	Update the assertions in this module to use the latest updates
	to require.m.

tests/hard_coded/tree_bitset_difference.{m,exp}:
	A regression test for the bug. This is the bug in the Mantis bug
	report, modified to also fail on 64 bit systems without the fix.

tests/hard_coded/Mmakefile:
	Enable the new test case.

Zoltan.

cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/extra
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/extra
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/doc
cvs diff: Diffing boehm_gc/libatomic_ops/src
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/armcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops/tests
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/m4
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
cvs diff: Diffing compiler/notes
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_cairo
cvs diff: Diffing extras/graphics/mercury_cairo/samples
cvs diff: Diffing extras/graphics/mercury_cairo/samples/data
cvs diff: Diffing extras/graphics/mercury_cairo/tutorial
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/monte
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/tree_bitset.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/tree_bitset.m,v
retrieving revision 1.11
diff -u -b -r1.11 tree_bitset.m
--- library/tree_bitset.m	22 Jul 2011 01:25:52 -0000	1.11
+++ library/tree_bitset.m	28 Jul 2011 03:24:38 -0000
@@ -529,7 +529,7 @@
 enum_to_index(Elem) = Index :-
     Int = enum.to_int(Elem),
     ( Int < 0 ->
-        error("tree_bitset.m: enums must map to nonnegative integers")
+        unexpected($module, $pred, "enums must map to nonnegative integers")
     ;
         Index = Int
     ).
@@ -542,7 +542,7 @@
     ;
         % We only apply `from_int/1' to integers returned by `to_int/1',
         % so it should never fail.
-        error("tree_bitset.m: `enum.from_int/1' failed")
+        unexpected($module, $pred, "`enum.from_int/1' failed")
     ).
 
 %-----------------------------------------------------------------------------%
@@ -562,7 +562,7 @@
 wrap_tree_bitset(NodeList) = Set :-
     trace [compile_time(flag("tree-bitset-integrity"))] (
         ( integrity(no, NodeList) = no ->
-            error("wrap_tree_bitset: integrity failed")
+            unexpected($module, $pred, "integrity failed")
         ;
             true
         )
@@ -741,7 +741,7 @@
             ( CurLimitOffset - CurInitOffset = Range ->
                 true
             ;
-                error("tree_bitset.m: expand_range: bad range for level")
+                unexpected($module, $pred, "bad range for level")
             )
         ;
             true
@@ -829,8 +829,8 @@
     range_of_parent_node(HeadB ^ init_offset, CurLevel,
         ParentInitOffsetB, ParentLimitOffsetB),
     ( ParentInitOffsetA = ParentInitOffsetB ->
-        require(unify(ParentLimitOffsetA, ParentLimitOffsetB),
-            "tree_bitset.m: raise_to_common_level: limit mismatch"),
+        expect(unify(ParentLimitOffsetA, ParentLimitOffsetB),
+            $module, $pred, "limit mismatch"),
         TopHeadA = HeadA,
         TopTailA = TailA,
         TopHeadB = HeadB,
@@ -872,7 +872,7 @@
     interior_node::out, list(interior_node)::out) is det.
 
 head_and_tail([], _, _) :-
-    error("tree_bitset.m: empty list in head_and_tail").
+    unexpected($module, $pred, "empty list").
 head_and_tail([Head | Tail], Head, Tail).
 
 %-----------------------------------------------------------------------------%
@@ -899,7 +899,7 @@
          ->
              true
         ;
-             error("tree_bitset.m: equal: set and list equality differ")
+             unexpected($module, $pred, "set and list equality differ")
         )
     ),
     SetA = SetB.
@@ -980,7 +980,8 @@
         (
             InteriorList0 = [],
             % This is a violation of our invariants.
-            error("tree_bitset.m :insert into empty list of interior nodes")
+            unexpected($module, $pred,
+                "insert into empty list of interior nodes")
         ;
             InteriorList0 = [InteriorNode0 | _],
             range_of_parent_node(InteriorNode0 ^ init_offset, InteriorLevel,
@@ -1046,14 +1047,14 @@
         Components0 = Head0 ^ components,
         (
             Components0 = leaf_list(LeafList0),
-            require(unify(Level, 1),
-                "interiorlist_insert: bad component list (leaf)"),
+            expect(unify(Level, 1), $module, $pred,
+                "bad component list (leaf)"),
             leaflist_insert(Index, LeafList0, LeafList),
             Components = leaf_list(LeafList)
         ;
             Components0 = interior_list(InteriorLevel, InteriorList0),
-            require(unify(InteriorLevel, Level - 1),
-                "interiorlist_insert: bad component list (interior)"),
+            expect(unify(InteriorLevel, Level - 1), $module, $pred,
+                "bad component list (interior)"),
             interiorlist_insert(Index, InteriorLevel,
                 InteriorList0, InteriorList),
             Components = interior_list(InteriorLevel, InteriorList)
@@ -1259,7 +1260,7 @@
         List0 = interior_list(Level, InteriorNodes0),
         (
             InteriorNodes0 = [],
-            error("tree_bitset.m: remove_least: empty InteriorNodes0")
+            unexpected($module, $pred, "empty InteriorNodes0")
         ;
             InteriorNodes0 = [InteriorHead | InteriorTail],
             remove_least_interior(InteriorHead, InteriorTail, Index,
@@ -1280,7 +1281,7 @@
         Components0 = leaf_list(LeafNodes0),
         (
             LeafNodes0 = [],
-            error("tree_bitset.m: remove_least_interior: empty LeafNodes0")
+            unexpected($module, $pred, "empty LeafNodes0")
         ;
             LeafNodes0 = [LeafHead0 | LeafTail0],
             remove_least_leaf(LeafHead0, LeafTail0, Index, LeafNodes),
@@ -1298,7 +1299,7 @@
         Components0 = interior_list(Level, InteriorNodes0),
         (
             InteriorNodes0 = [],
-            error("tree_bitset.m: remove_least_interior: empty InteriorNodes0")
+            unexpected($module, $pred, "empty InteriorNodes0")
         ;
             InteriorNodes0 = [InteriorHead0 | InteriorTail0],
             remove_least_interior(InteriorHead0, InteriorTail0, Index,
@@ -1377,7 +1378,7 @@
         group_leaf_nodes(LeafHead, LeafTail, InteriorNodes0),
         (
             InteriorNodes0 = [],
-            error("tree_bitset.m: sorted_list_to_set: empty InteriorNodes0")
+            unexpected($module, $pred, "empty InteriorNodes0")
         ;
             InteriorNodes0 = [InteriorNode],
             List = InteriorNode ^ components
@@ -1427,8 +1428,8 @@
     range_of_parent_node(Head ^ leaf_offset, 0,
         HeadParentInitOffset, HeadParentLimitOffset),
     ( ParentInitOffset = HeadParentInitOffset ->
-        require(unify(ParentLimitOffset, HeadParentLimitOffset),
-            "tree_bitset.m: group_leaf_nodes_in_range: limit mismatch"),
+        expect(unify(ParentLimitOffset, HeadParentLimitOffset),
+            $module, $pred, "limit mismatch"),
         !:RevAcc = [Head | !.RevAcc],
         group_leaf_nodes_in_range(ParentInitOffset, ParentLimitOffset,
             !.RevAcc, Tail, ParentNode, Remaining)
@@ -1444,7 +1445,7 @@
 recursively_group_interior_nodes(CurLevel, CurNodes, List) :-
     (
         CurNodes = [],
-        error("tree_bitset.m: recursively_group_interior_nodes: empty CurNodes")
+        unexpected($module, $pred, "empty CurNodes")
     ;
         CurNodes = [CurNodesHead | CurNodesTail],
         (
@@ -1488,8 +1489,8 @@
     range_of_parent_node(Head ^ init_offset, Level,
         HeadParentInitOffset, HeadParentLimitOffset),
     ( ParentInitOffset = HeadParentInitOffset ->
-        require(unify(ParentLimitOffset, HeadParentLimitOffset),
-            "tree_bitset.m: group_interior_nodes_in_range: limit mismatch"),
+        expect(unify(ParentLimitOffset, HeadParentLimitOffset),
+            $module, $pred, "limit mismatch"),
         !:RevAcc = [Head | !.RevAcc],
         group_interior_nodes_in_range(Level,
             ParentInitOffset, ParentLimitOffset,
@@ -1664,8 +1665,8 @@
             range_of_parent_node(FirstNodeB ^ leaf_offset, 0,
                 ParentInitOffsetB, ParentLimitOffsetB),
             ( ParentInitOffsetA = ParentInitOffsetB ->
-                require(unify(ParentLimitOffsetA, ParentLimitOffsetB),
-                    "tree_bitset.m: union: limit mismatch"),
+                expect(unify(ParentLimitOffsetA, ParentLimitOffsetB),
+                    $module, $pred, "limit mismatch"),
                 leaflist_union(LeafNodesA, LeafNodesB, LeafNodes),
                 List = leaf_list(LeafNodes)
             ;
@@ -1778,18 +1779,16 @@
         ;
             ComponentsA = leaf_list(_LeafListA),
             ComponentsB = interior_list(_LevelB, _InteriorListB),
-            error("tree_bitset.m: " ++
-                "inconsistent components in interiorlist_union")
+            unexpected($module, $pred, "inconsistent components")
         ;
             ComponentsA = interior_list(_LevelA, _InteriorListA),
             ComponentsB = leaf_list(_LeafListB),
-            error("tree_bitset.m: " ++
-                "inconsistent components in interiorlist_union")
+            unexpected($module, $pred, "inconsistent components")
         ;
             ComponentsA = interior_list(LevelA, InteriorListA),
             ComponentsB = interior_list(LevelB, InteriorListB),
-            require(unify(LevelA, LevelB),
-                "tree_bitset.m: inconsistent levels in interiorlist_union"),
+            expect(unify(LevelA, LevelB), $module, $pred,
+                "inconsistent levels"),
             interiorlist_union(InteriorListA, InteriorListB, InteriorList),
             Components = interior_list(LevelA, InteriorList),
             Head = interior_node(HeadA ^ init_offset, HeadA ^ limit_offset,
@@ -1833,8 +1832,8 @@
             range_of_parent_node(FirstNodeB ^ leaf_offset, 0,
                 ParentInitOffsetB, ParentLimitOffsetB),
             ( ParentInitOffsetA = ParentInitOffsetB ->
-                require(unify(ParentLimitOffsetA, ParentLimitOffsetB),
-                    "tree_bitset.m: intersect: limit mismatch"),
+                expect(unify(ParentLimitOffsetA, ParentLimitOffsetB),
+                    $module, $pred, "limit mismatch"),
                 leaflist_intersect(LeafNodesA, LeafNodesB, LeafNodes),
                 List = leaf_list(LeafNodes)
             ;
@@ -1923,10 +1922,10 @@
         InteriorNodeA ^ limit_offset =< HeadB ^ limit_offset
     ->
         ( LevelA = LevelB ->
-            require(unify(InteriorNodeA ^ init_offset, HeadB ^ init_offset),
-                "tree_bitset.m: inconsistent inits in descend_and_intersect"),
-            require(unify(InteriorNodeA ^ limit_offset, HeadB ^ limit_offset),
-                "tree_bitset.m: inconsistent limits in descend_and_intersect"),
+            expect(unify(InteriorNodeA ^ init_offset, HeadB ^ init_offset),
+                $module, $pred, "inconsistent inits"),
+            expect(unify(InteriorNodeA ^ limit_offset, HeadB ^ limit_offset),
+                $module, $pred, "inconsistent limits"),
             ComponentsA = InteriorNodeA ^ components,
             ComponentsB = HeadB ^ components,
             (
@@ -1937,13 +1936,13 @@
             ;
                 ComponentsA = leaf_list(_),
                 ComponentsB = interior_list(_, _),
-                error("tree_bitset.m: " ++
-                    "inconsistent levels in descend_and_intersect")
+                unexpected($module, $pred,
+                    "inconsistent levels")
             ;
                 ComponentsA = interior_list(_, _),
                 ComponentsB = leaf_list(_),
-                error("tree_bitset.m: " ++
-                    "inconsistent levels in descend_and_intersect")
+                unexpected($module, $pred,
+                    "inconsistent levels")
             ;
                 ComponentsA = interior_list(_SubLevelA, InteriorNodesA),
                 ComponentsB = interior_list(_SubLevelB, InteriorNodesB),
@@ -1952,13 +1951,11 @@
                 List = interior_list(LevelA, InteriorNodes)
             )
         ;
-            require(LevelA < LevelB,
-                "tree_bitset.m: LevelA > LevelB in descend_and_intersect"),
+            expect(LevelA < LevelB, $module, $pred, "LevelA > LevelB"),
             ComponentsB = HeadB ^ components,
             (
                 ComponentsB = leaf_list(_),
-                error("tree_bitset.m: " ++
-                    "bad ComponentsB in descend_and_intersect")
+                unexpected($module, $pred, "bad ComponentsB")
             ;
                 ComponentsB = interior_list(SubLevelB, InteriorNodesB),
                 descend_and_intersect(LevelA, InteriorNodeA,
@@ -2018,18 +2015,16 @@
         ;
             ComponentsA = interior_list(_LevelA, _InteriorNodesA),
             ComponentsB = leaf_list(_LeafNodesB),
-            error("tree_bitset.m: " ++
-                "inconsistent components in interiorlist_intersect")
+            unexpected($module, $pred, "inconsistent components")
         ;
             ComponentsB = interior_list(_LevelB, _InteriorNodesB),
             ComponentsA = leaf_list(_LeafNodesA),
-            error("tree_bitset.m: " ++
-                "inconsistent components in interiorlist_intersect")
+            unexpected($module, $pred, "inconsistent components")
         ;
             ComponentsA = interior_list(LevelA, InteriorNodesA),
             ComponentsB = interior_list(LevelB, InteriorNodesB),
-            require(unify(LevelA, LevelB),
-                "tree_bitset.m: inconsistent levels in interiorlist_intersect"),
+            expect(unify(LevelA, LevelB), $module, $pred,
+                "inconsistent levels"),
             interiorlist_intersect(InteriorNodesA, InteriorNodesB,
                 InteriorNodes),
             (
@@ -2078,8 +2073,8 @@
             range_of_parent_node(FirstNodeB ^ leaf_offset, 0,
                 ParentInitOffsetB, ParentLimitOffsetB),
             ( ParentInitOffsetA = ParentInitOffsetB ->
-                require(unify(ParentLimitOffsetA, ParentLimitOffsetB),
-                    "tree_bitset.m: difference: limit mismatch"),
+                expect(unify(ParentLimitOffsetA, ParentLimitOffsetB),
+                    $module, $pred, "limit mismatch"),
                 leaflist_difference(LeafNodesA, LeafNodesB, LeafNodes),
                 List = leaf_list(LeafNodes)
             ;
@@ -2144,14 +2139,13 @@
             ComponentsB = ChosenB ^ components,
             (
                 ComponentsB = leaf_list(_),
-                require(unify(LevelA, 1),
-                    "tree_bitset.m: interiornode_difference: bad leaf level"),
+                expect(unify(LevelA, 1), $module, $pred, "bad leaf level"),
                 interiorlist_difference([HeadA | TailA], [ChosenB], List),
                 Level = LevelA
             ;
                 ComponentsB = interior_list(SubLevelB, SubNodesB),
-                require(unify(LevelB, SubLevelB + 1),
-                    "tree_bitset.m: interiornode_difference: bad levels"),
+                expect(unify(LevelB, SubLevelB + 1), $module, $pred,
+                    "bad levels"),
                 head_and_tail(SubNodesB, SubHeadB, SubTailB),
                 interiornode_difference(LevelA, HeadA, TailA,
                     SubLevelB, SubHeadB, SubTailB, Level, List)
@@ -2168,14 +2162,22 @@
         range_of_parent_node(RaisedHeadB ^ init_offset, LevelA,
             ParentInitOffsetB, ParentLimitOffsetB),
         ( ParentInitOffsetA = ParentInitOffsetB ->
-            require(unify(ParentLimitOffsetA, ParentLimitOffsetB),
-                "tree_bitset.m: interiornode_difference: limit mismatch"),
+            expect(unify(ParentLimitOffsetA, ParentLimitOffsetB),
+                $module, $pred, "limit mismatch"),
             interiorlist_difference([HeadA | TailA],
                 [RaisedHeadB | RaisedTailB], List),
             Level = LevelA
         ;
-            Level = 1,
-            List = []
+            (
+                TailA = [],
+                List = [HeadA],
+                Level = LevelA
+            ;
+                TailA = [HeadTailA | TailTailA],
+                interiornode_difference(LevelA, HeadTailA, TailTailA,
+                    LevelA, RaisedHeadB, RaisedTailB, Level, Tail),
+                List = [HeadA | Tail]
+            )
         )
     ).
 
@@ -2249,19 +2251,16 @@
         ;
             ComponentsA = interior_list(_LevelA, _InteriorNodesA),
             ComponentsB = leaf_list(_LeafNodesB),
-            error("tree_bitset.m: " ++
-                "inconsistent components in interiorlist_difference")
+            unexpected($module, $pred, "inconsistent components")
         ;
             ComponentsB = interior_list(_LevelB, _InteriorNodesB),
             ComponentsA = leaf_list(_LeafNodesA),
-            error("tree_bitset.m: " ++
-                "inconsistent components in interiorlist_difference")
+            unexpected($module, $pred, "inconsistent components")
         ;
             ComponentsA = interior_list(LevelA, InteriorNodesA),
             ComponentsB = interior_list(LevelB, InteriorNodesB),
-            require(unify(LevelA, LevelB),
-                "tree_bitset.m: " ++
-                "inconsistent levels in interiorlist_difference"),
+            expect(unify(LevelA, LevelB), $module, $pred,
+                "inconsistent levels"),
             interiorlist_difference(InteriorNodesA, InteriorNodesB,
                 InteriorNodes),
             (
@@ -2513,8 +2512,8 @@
 %             range_of_parent_node(DivideByFirstNode ^ leaf_offset, 0,
 %                 DivideByParentInitOffset, DivideByParentLimitOffset),
 %             ( DivideByParentInitOffset = ParentInitOffset ->
-%                 require(unify(DivideByParentLimitOffset, ParentLimitOffset),
-%                     "tree_bitset.m: divide_by_set: limit mismatch"),
+%                 expect(unify(DivideByParentLimitOffset, ParentLimitOffset),
+%                     $module, $pred, "limit mismatch"),
 %                 leaflist_divide_by_set(DivideByLeafNodes, LeafNodes,
 %                     InLeafNodes, OutLeafNodes),
 %                 InList = leaf_list(InLeafNodes),
@@ -2582,14 +2581,14 @@
 %             ComponentsB = ChosenB ^ components,
 %             (
 %                 ComponentsB = leaf_list(_),
-%                 require(unify(LevelA, 1),
-%                     "tree_bitset.m: interiornode_difference: bad leaf level"),
+%                 expect(unify(LevelA, 1),
+%                     $module, $pred, "bad leaf level"),
 %                 interiorlist_difference([HeadA | TailA], [ChosenB], List),
 %                 Level = LevelA
 %             ;
 %                 ComponentsB = interior_list(SubLevelB, SubNodesB),
-%                 require(unify(LevelB, SubLevelB + 1),
-%                     "tree_bitset.m: interiornode_difference: bad levels"),
+%                 expect(unify(LevelB, SubLevelB + 1),
+%                     $module, $pred, "bad levels"),
 %                 head_and_tail(SubNodesB, SubHeadB, SubTailB),
 %                 interiornode_difference(LevelA, HeadA, TailA,
 %                     SubLevelB, SubHeadB, SubTailB, Level, List)
@@ -2606,8 +2605,8 @@
 %         range_of_parent_node(RaisedHeadB ^ init_offset, LevelA,
 %             ParentInitOffsetB, ParentLimitOffsetB),
 %         ( ParentInitOffsetA = ParentInitOffsetB ->
-%             require(unify(ParentLimitOffsetA, ParentLimitOffsetB),
-%                 "tree_bitset.m: interiornode_difference: limit mismatch"),
+%             expect(unify(ParentLimitOffsetA, ParentLimitOffsetB),
+%                 $module, $pred, "limit mismatch"),
 %             interiorlist_difference([HeadA | TailA],
 %                 [RaisedHeadB | RaisedTailB], List),
 %             Level = LevelA
@@ -2697,7 +2696,7 @@
 %         ;
 %             ComponentsA = interior_list(LevelA, InteriorNodesA),
 %             ComponentsB = interior_list(LevelB, InteriorNodesB),
-%             require(unify(LevelA, LevelB),
+%             expect(unify(LevelA, LevelB),
 %                 "tree_bitset.m: " ++
 %                 "inconsistent levels in interiorlist_difference"),
 %             interiorlist_difference(InteriorNodesA, InteriorNodesB,
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/appengine
cvs diff: Diffing samples/appengine/war
cvs diff: Diffing samples/appengine/war/WEB-INF
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/concurrency
cvs diff: Diffing samples/concurrency/dining_philosophers
cvs diff: Diffing samples/concurrency/midimon
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/java_interface
cvs diff: Diffing samples/java_interface/java_calls_mercury
cvs diff: Diffing samples/java_interface/mercury_calls_java
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.410
diff -u -b -r1.410 Mmakefile
--- tests/hard_coded/Mmakefile	25 Jul 2011 03:32:07 -0000	1.410
+++ tests/hard_coded/Mmakefile	28 Jul 2011 03:03:24 -0000
@@ -155,10 +155,10 @@
 	intermod_unused_args \
 	java_rtti_bug \
 	join_list \
-	lco_pack_args \
 	lco_mday_bug_1 \
 	lco_mday_bug_2 \
 	lco_no_inline \
+	lco_pack_args \
 	list_series_int \
 	lookup_disj \
 	lookup_switch_simple \
@@ -290,6 +290,7 @@
 	trace_goal_4 \
 	transform_value \
 	transitive_inst_type \
+	tree_bitset_difference \
 	trigraphs \
 	tuple_test \
 	type_ctor_desc \
Index: tests/hard_coded/tree_bitset_difference.exp
===================================================================
RCS file: tests/hard_coded/tree_bitset_difference.exp
diff -N tests/hard_coded/tree_bitset_difference.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/tree_bitset_difference.exp	28 Jul 2011 03:03:46 -0000
@@ -0,0 +1,8 @@
+list A:                 [532, 32431]
+list B:                 [32794]
+set difference:         [532, 32431]
+tree_bitset difference: [532, 32431]
+list A:                 [1064, 64862]
+list B:                 [65588]
+set difference:         [1064, 64862]
+tree_bitset difference: [1064, 64862]
Index: tests/hard_coded/tree_bitset_difference.m
===================================================================
RCS file: tests/hard_coded/tree_bitset_difference.m
diff -N tests/hard_coded/tree_bitset_difference.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/tree_bitset_difference.m	28 Jul 2011 03:29:49 -0000
@@ -0,0 +1,71 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% This is a regression test for Mantis bug #207.
+%-----------------------------------------------------------------------------%
+
+:- module tree_bitset_difference.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module set.
+:- import_module tree_bitset.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+    % The values of X and Y (or 2X and 2Y) 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. The bug was in how
+    % the difference operation handled interior nodes at the same level
+    % but not at the same starting address.
+
+    X = 532,
+    Y = 32431,
+    Z = 32794,
+
+    % This version of the test failed on 32 bit systems.
+    ListA_1 = [X, Y],
+    ListB_1 = [Z],
+    test(ListA_1, ListB_1, !IO),
+
+    % This version of the test failed on 64 bit systems.
+    ListA_2 = [X * 2, Y * 2],
+    ListB_2 = [Z * 2],
+    test(ListA_2, ListB_2, !IO).
+
+:- pred test(list(int)::in, list(int)::in, io::di, io::uo) is det.
+
+test(ListA, ListB, !IO) :-
+    SetA = set.from_list(ListA),
+    SetB = set.from_list(ListB),
+    set.difference(SetA, SetB, SetC),
+    set.to_sorted_list(SetC, ListC_set),
+
+    BitSetA = tree_bitset.list_to_set(ListA),
+    BitSetB = tree_bitset.list_to_set(ListB),
+    tree_bitset.difference(BitSetA, BitSetB, BitSetC),
+    ListC_bitset = tree_bitset.to_sorted_list(BitSetC),
+
+    io.write_string("list A:                 ", !IO),
+    io.write(ListA, !IO),
+    io.nl(!IO),
+    io.write_string("list B:                 ", !IO),
+    io.write(ListB, !IO),
+    io.nl(!IO),
+    io.write_string("set difference:         ", !IO),
+    io.write(ListC_set, !IO),
+    io.nl(!IO),
+    io.write_string("tree_bitset difference: ", !IO),
+    io.write(ListC_bitset, !IO),
+    io.nl(!IO).
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
Previous message: [m-rev.] for review: separate gcc and clang specific code in the runtime
Next message: [m-rev.] for review: peephole optimization for the MLDS
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
More information about the reviews mailing list