Detecter le cas ou l'on trace deux fois la meme fonction sous divers …

…noms.

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

toplevel/topdirs.ml

@@ -198,15 +198,17 @@ external current_environment: unit -> Obj.t = "get_current_environment"
 let dir_trace lid =
   try
     let (path, desc) = Env.lookup_value lid !toplevel_env in
-    if is_traced path then begin
-      Printtyp.path path; print_string " is already traced.";
-      print_newline()
-    end else begin
-      let clos = eval_path path in
-      (* Nothing to do if it's not a closure *)
-      if Obj.is_block clos & Obj.tag clos = 250 then begin
-        let old_clos = copy_closure clos in
+    let clos = eval_path path in
+    (* Nothing to do if it's not a closure *)
+    if Obj.is_block clos & Obj.tag clos = 250 then begin
+    match is_traced clos with
+      Some opath ->
+        Printtyp.path path; print_string " is already traced (under the name ";
+        Printtyp.path opath; print_string ")";
+        print_newline()
+    | None ->
         (* Instrument the old closure *)
+        let old_clos = copy_closure clos in
         traced_functions :=
           { path = path; 
             closure = clos;
@@ -228,11 +230,10 @@ let dir_trace lid =
         | _ ->
             Printtyp.longident lid; print_string " is now traced.";
             print_newline()
-      end else begin
-        Printtyp.longident lid; print_string " is not a function.";
-        print_newline()
-      end      
-    end
+    end else begin
+      Printtyp.longident lid; print_string " is not a function.";
+      print_newline()
+    end      
   with Not_found ->
     print_string "Unbound value "; Printtyp.longident lid;
     print_newline()

toplevel/trace.ml

@@ -30,10 +30,10 @@ let traced_functions = ref ([] : traced_function list)
 
 (* Check if a function is already traced *)
 
-let is_traced path =
+let is_traced clos =
   let rec is_traced = function
-      [] -> false
-    | tf :: rem -> Path.same path tf.path or is_traced rem
+      [] -> None
+    | tf :: rem -> if tf.closure == clos then Some tf.path else is_traced rem
   in is_traced !traced_functions
 
 (* Make a copy of a closure *)

toplevel/trace.mli

@@ -20,7 +20,7 @@ type traced_function =
     instrumented_fun: Obj.t }
 
 val traced_functions: traced_function list ref
-val is_traced: Path.t -> bool
+val is_traced: Obj.t -> Path.t option
 val copy_closure: Obj.t -> Obj.t
 val overwrite_closure: Obj.t -> Obj.t -> unit
 val instrument_closure: