The unified diff between revisions [7891617d..] and [78746ed3..] is displayed below. It can also be downloaded as a raw diff.

This diff has been restricted to the following files: 'database-mt.ml'

#
#
# patch "database-mt.ml"
#  from [bfbc64267c32b93b83e8d14b1414352d0b6ddb6d]
#    to [4f652fbc8f02cf793f9f61724fee5ce446e201b8]
#
============================================================
--- database-mt.ml	bfbc64267c32b93b83e8d14b1414352d0b6ddb6d
+++ database-mt.ml	4f652fbc8f02cf793f9f61724fee5ce446e201b8
@@ -83,28 +83,30 @@ let auto_cl_re = [
   Str.regexp "\\(\\(explicit_\\)?merge of\\|propagate \\(of\\|from\\)\\) ", MERGE ;
   Str.regexp "disapproval of ", DISAPPROVE
 ]
-let re_match re s = Str.string_match re s 0
+let re_match s (re, _) = Str.string_match re s 0

 let process_changelog_row g = function
   | [| id; cl |] ->
       let cl = monot_decode cl in
-      if not (List.exists (fun (re, _) -> re_match re cl) auto_cl_re)
+      if not (List.exists (re_match cl) auto_cl_re)
       then g else begin
-	let (_, kind) =
-	  try List.find (fun (re, k) -> re_match re cl) auto_cl_re
-	  with Not_found -> assert false (* means I f*cked up the regexps *) in
+	let (_, kind) = List.find (re_match cl) auto_cl_re in
 	let node =
 	  try NodeMap.find id g.nodes
 	  with Not_found -> assert false (* monotone db is inconsistent *) in
 	let updated_edges =
 	  if kind = DISAPPROVE
 	  then begin
-	    match node.family with
-	    | [ pid, PARENT ] ->
-		EdgeMap.add (pid, id) DISAPPROVED g.ancestry
-	    | _ ->
-		g.ancestry
-	  end
+	    let pid =
+	      try list_rassoc PARENT node.family
+	      with Not_found -> assert false in
+	    let a = EdgeMap.add (pid, id) DISAPPROVED g.ancestry in
+	    try
+	      let pnode = NodeMap.find pid g.nodes in
+	      let gpid = list_rassoc PARENT pnode.family in
+	      EdgeMap.add (gpid, pid) DISAPPROVED a
+	    with Not_found -> a
+	  end
 	  else g.ancestry in
 	let updated_nodes =
 	  if kind <> node.kind
@@ -117,11 +119,7 @@ let process_branching_edge_row g = funct

 let process_branching_edge_row g = function
   | [| parent; child |] ->
-      { g with ancestry =
-	begin
-	  assert (NodeMap.mem parent g.nodes && NodeMap.mem child g.nodes) ;
-	  EdgeMap.add (parent, child) BRANCHING g.ancestry
-	end }
+      { g with ancestry = EdgeMap.add (parent, child) BRANCHING g.ancestry }
   | _ -> g