real fix for PR#5738

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

1 files changed, 26 insertions, 10 deletions

diff --git a/tools/depend.ml b/tools/depend.ml
index 020289292..0ad748d14 100644
--- a/tools/depend.ml
+++ b/tools/depend.ml
@@ -108,6 +108,8 @@ let add_class_description bv infos =
 
 let add_class_type_declaration = add_class_description
 
+let pattern_bv = ref StringSet.empty
+
 let rec add_pattern bv pat =
   match pat.ppat_desc with
     Ppat_any -> ()
@@ -124,13 +126,19 @@ let rec add_pattern bv pat =
   | Ppat_variant(_, op) -> add_opt add_pattern bv op
   | Ppat_type li -> add bv li
   | Ppat_lazy p -> add_pattern bv p
-  | Ppat_unpack id -> add bv (mkloc (Lident id.txt) id.loc)
+  | Ppat_unpack id -> pattern_bv := StringSet.add id.txt !pattern_bv
+
+let add_pattern bv pat =
+  pattern_bv := bv;
+  add_pattern bv pat;
+  !pattern_bv
 
 let rec add_expr bv exp =
   match exp.pexp_desc with
     Pexp_ident l -> add bv l
   | Pexp_constant _ -> ()
-  | Pexp_let(_, pel, e) -> add_pat_expr_list bv pel; add_expr bv e
+  | Pexp_let(rf, pel, e) ->
+      let bv = add_bindings rf bv pel in add_expr bv e
   | Pexp_function (_, opte, pel) ->
       add_opt add_expr bv opte; add_pat_expr_list bv pel
   | Pexp_apply(e, el) ->
@@ -168,12 +176,19 @@ let rec add_expr bv exp =
   | Pexp_lazy (e) -> add_expr bv e
   | Pexp_poly (e, t) -> add_expr bv e; add_opt add_type bv t
   | Pexp_object { pcstr_pat = pat; pcstr_fields = fieldl } ->
-      add_pattern bv pat; List.iter (add_class_field bv) fieldl
+      let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl
   | Pexp_newtype (_, e) -> add_expr bv e
   | Pexp_pack m -> add_module bv m
   | Pexp_open (m, e) -> addmodule bv m; add_expr bv e
+
 and add_pat_expr_list bv pel =
-  List.iter (fun (p, e) -> add_pattern bv p; add_expr bv e) pel
+  List.iter (fun (p, e) -> let bv = add_pattern bv p in add_expr bv e) pel
+
+and add_bindings recf bv pel =
+  let bv' = List.fold_left (fun bv (p, _) -> add_pattern bv p) bv pel in
+  let bv = if recf = Recursive then bv else bv' in
+  List.iter (fun (_, e) -> add_expr bv e) pel;
+  bv'
 
 and add_modtype bv mty =
   match mty.pmty_desc with
@@ -245,8 +260,8 @@ and add_struct_item bv item =
   match item.pstr_desc with
     Pstr_eval e ->
       add_expr bv e; bv
-  | Pstr_value(id, pel) ->
-      add_pat_expr_list bv pel; bv
+  | Pstr_value(rf, pel) ->
+      let bv = add_bindings rf bv pel in bv
   | Pstr_primitive(id, vd) ->
       add_type bv vd.pval_type; bv
   | Pstr_type dcls ->
@@ -291,13 +306,14 @@ and add_class_expr bv ce =
     Pcl_constr(l, tyl) ->
       add bv l; List.iter (add_type bv) tyl
   | Pcl_structure { pcstr_pat = pat; pcstr_fields = fieldl } ->
-      add_pattern bv pat; List.iter (add_class_field bv) fieldl
+      let bv = add_pattern bv pat in List.iter (add_class_field bv) fieldl
   | Pcl_fun(_, opte, pat, ce) ->
-      add_opt add_expr bv opte; add_pattern bv pat; add_class_expr bv ce
+      add_opt add_expr bv opte;
+      let bv = add_pattern bv pat in add_class_expr bv ce
   | Pcl_apply(ce, exprl) ->
       add_class_expr bv ce; List.iter (fun (_,e) -> add_expr bv e) exprl
-  | Pcl_let(_, pel, ce) ->
-      add_pat_expr_list bv pel; add_class_expr bv ce
+  | Pcl_let(rf, pel, ce) ->
+      let bv = add_bindings rf bv pel in add_class_expr bv ce
   | Pcl_constraint(ce, ct) ->
       add_class_expr bv ce; add_class_type bv ct