PR#5119: camlp4 now raises a specific exception when 'DELETE_RULE' fails, rather than raising 'Not_found'

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13047 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

3 files changed, 30 insertions, 4 deletions

diff --git a/camlp4/Camlp4/Struct/Grammar/Delete.ml b/camlp4/Camlp4/Struct/Grammar/Delete.ml
index d8f9f9aa42..4273ebebf0 100644
--- a/camlp4/Camlp4/Struct/Grammar/Delete.ml
+++ b/camlp4/Camlp4/Struct/Grammar/Delete.ml
@@ -17,11 +17,37 @@
  * - Nicolas Pouillard: refactoring
  *)
 
+exception Rule_not_found of (string * string);
+
+let () =
+  Printexc.register_printer
+    (fun
+      [ Rule_not_found (symbols, entry) ->
+	  let msg = Printf.sprintf "rule %S cannot be found in entry\n%s" symbols entry in
+	  Some msg
+      | _ -> None ]) in ()
+;
+
 module Make (Structure : Structure.S) = struct
   module Tools  = Tools.Make Structure;
   module Parser = Parser.Make Structure;
+  module Print = Print.Make Structure;
   open Structure;
 
+value raise_rule_not_found entry symbols =
+  let to_string f x =
+    let buff = Buffer.create 128 in
+    let ppf = Format.formatter_of_buffer buff in
+    do {
+      f ppf x;
+      Format.pp_print_flush ppf ();
+      Buffer.contents buff
+    } in
+    let entry = to_string Print.entry entry in
+    let symbols = to_string Print.print_rule symbols in
+    raise (Rule_not_found (symbols, entry))
+;
+
 (* Deleting a rule *)
 
 (* [delete_rule_in_tree] returns
@@ -104,7 +130,7 @@ value rec delete_rule_in_suffix entry symbols =
       | None ->
           let levs = delete_rule_in_suffix entry symbols levs in
           [lev :: levs] ]
-  | [] -> raise Not_found ]
+  | [] -> raise_rule_not_found entry symbols ]
 ;
 
 value rec delete_rule_in_prefix entry symbols =
@@ -128,7 +154,7 @@ value rec delete_rule_in_prefix entry symbols =
       | None ->
           let levs = delete_rule_in_prefix entry symbols levs in
           [lev :: levs] ]
-  | [] -> raise Not_found ]
+  | [] -> raise_rule_not_found entry symbols ]
 ;
 
 value rec delete_rule_in_level_list entry symbols levs =
diff --git a/camlp4/Camlp4Parsers/Camlp4ListComprehension.ml b/camlp4/Camlp4Parsers/Camlp4ListComprehension.ml
index 7bdad3c4ec..f2216610f1 100644
--- a/camlp4/Camlp4Parsers/Camlp4ListComprehension.ml
+++ b/camlp4/Camlp4Parsers/Camlp4ListComprehension.ml
@@ -102,7 +102,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
     try do {
       DELETE_RULE Gram expr: "["; sem_expr_for_list; "::"; expr; "]" END;
       True
-    } with [ Not_found -> False ];
+    } with [ Struct.Grammar.Delete.Rule_not_found _ -> False ];
 
   value comprehension_or_sem_expr_for_list =
     Gram.Entry.mk "comprehension_or_sem_expr_for_list";
diff --git a/camlp4/Camlp4Parsers/Camlp4OCamlReloadedParser.ml b/camlp4/Camlp4Parsers/Camlp4OCamlReloadedParser.ml
index 02c89f818d..85efa827e0 100644
--- a/camlp4/Camlp4Parsers/Camlp4OCamlReloadedParser.ml
+++ b/camlp4/Camlp4Parsers/Camlp4OCamlReloadedParser.ml
@@ -40,7 +40,7 @@ module Make (Syntax : Sig.Camlp4Syntax) = struct
   value revised =
     try
       (DELETE_RULE Gram expr: "if"; SELF; "then"; SELF; "else"; SELF END; True)
-    with [ Not_found -> begin
+    with [ Struct.Grammar.Delete.Rule_not_found _ -> begin
       DELETE_RULE Gram expr: "if"; SELF; "then"; expr LEVEL "top"; "else"; expr LEVEL "top" END;
       DELETE_RULE Gram expr: "if"; SELF; "then"; expr LEVEL "top" END; False
     end ];