ocaml#9096 from stedolan/backtrace-names (Review)

lambda/lambda.ml

@@ -458,16 +458,26 @@ let string_of_scope_item = function
   | Ls_method_definition name ->
      name.txt
 
-
 let string_of_scopes scopes =
+  let dot acc =
+    match acc with
+    | [] -> []
+    | acc -> "." :: acc in
   let rec to_strings acc = function
-    (* Collapse nested anonymous function scopes *)
     | [] -> acc
+      (* Collapse nested anonymous function scopes *)
     | Ls_anonymous_function :: ((Ls_anonymous_function :: _) as rest) ->
       to_strings acc rest
+      (* Use class#meth syntax for classes *)
+    | (Ls_method_definition _ as meth) ::
+      (Ls_class_definition _ as cls) :: rest ->
+      to_strings (string_of_scope_item cls :: "#" ::
+                    string_of_scope_item meth :: dot acc) rest
     | s :: rest ->
-      to_strings (string_of_scope_item s :: acc) rest in
-  String.concat "." (to_strings [] scopes)
+      to_strings (string_of_scope_item s :: dot acc) rest in
+  match scopes with
+  | [] -> "<unknown>"
+  | scopes -> String.concat "" (to_strings [] scopes)
 
 type lambda =
     Lvar of Ident.t

lambda/translcore.ml

@@ -585,7 +585,7 @@ and transl_exp0 ~scopes e =
       end
   | Texp_object (cs, meths) ->
       let cty = cs.cstr_type in
-      let cl = Ident.create_local "class" in
+      let cl = Ident.create_local "object" in
       !transl_object ~scopes cl meths
         { cl_desc = Tcl_structure cs;
           cl_loc = e.exp_loc;

testsuite/tests/backtrace/methods.reference

@@ -1,5 +1,5 @@
-Raised at Methods.bar.bang in file "methods.ml", line 16, characters 4-14
-Called from Methods.bar.go in file "methods.ml", line 14, characters 7-18
-Called from Methods.foo.go in file "methods.ml", line 10, characters 7-23
-Called from Methods.class.meth in file "methods.ml", line 23, characters 9-23
+Raised at Methods.bar#bang in file "methods.ml", line 16, characters 4-14
+Called from Methods.bar#go in file "methods.ml", line 14, characters 7-18
+Called from Methods.foo#go in file "methods.ml", line 10, characters 7-23
+Called from Methods.object#meth in file "methods.ml", line 23, characters 9-23
 Called from Methods in file "methods.ml", line 25, characters 8-16

testsuite/tests/backtrace/names.reference

@@ -1,9 +1,9 @@
 Raised at Names.bang in file "names.ml", line 9, characters 29-39
-Called from Names.inline_object.class.othermeth in file "names.ml", line 97, characters 6-10
-Called from Names.inline_object.class.meth in file "names.ml", line 95, characters 6-26
-Called from Names.klass2.othermeth.(fun) in file "names.ml", line 89, characters 18-22
-Called from Names.klass2.othermeth in file "names.ml", line 89, characters 4-30
-Called from Names.klass.meth in file "names.ml", line 85, characters 4-27
+Called from Names.inline_object.object#othermeth in file "names.ml", line 97, characters 6-10
+Called from Names.inline_object.object#meth in file "names.ml", line 95, characters 6-26
+Called from Names.klass2#othermeth.(fun) in file "names.ml", line 89, characters 18-22
+Called from Names.klass2#othermeth in file "names.ml", line 89, characters 4-30
+Called from Names.klass#meth in file "names.ml", line 85, characters 4-27
 Called from Names.(+@+) in file "names.ml", line 80, characters 31-35
 Called from Names.Rec2.fn in file "names.ml", line 77, characters 28-32
 Called from Names.Rec1.fn in file "names.ml", line 72, characters 28-34