diff --git a/lambda/lambda.ml b/lambda/lambda.ml index 3bf6b176b15c..3e11e18c031e 100644 --- a/lambda/lambda.ml +++ b/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 + | [] -> "" + | scopes -> String.concat "" (to_strings [] scopes) type lambda = Lvar of Ident.t diff --git a/lambda/translcore.ml b/lambda/translcore.ml index 4808b27b0aaf..fa831ab14625 100644 --- a/lambda/translcore.ml +++ b/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; diff --git a/testsuite/tests/backtrace/methods.reference b/testsuite/tests/backtrace/methods.reference index 50e5965b5a37..f6420ee6df0d 100644 --- a/testsuite/tests/backtrace/methods.reference +++ b/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 diff --git a/testsuite/tests/backtrace/names.reference b/testsuite/tests/backtrace/names.reference index 3a2bbf6df7ff..8ded55a471a3 100644 --- a/testsuite/tests/backtrace/names.reference +++ b/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