Generate the same backtraces for method send in bytecode and native
parent
cc7b687a02
commit
07d0192b22
|
@ -628,9 +628,9 @@ and transl_apply ?(should_be_tailcall=false) ?(inlined = Default_inline)
|
|||
?(specialised = Default_specialise) lam sargs loc =
|
||||
let lapply funct args =
|
||||
match funct with
|
||||
Lsend(k, lmet, lobj, largs, loc) ->
|
||||
Lsend(k, lmet, lobj, largs, _) ->
|
||||
Lsend(k, lmet, lobj, largs @ args, loc)
|
||||
| Levent(Lsend(k, lmet, lobj, largs, loc), _) ->
|
||||
| Levent(Lsend(k, lmet, lobj, largs, _), _) ->
|
||||
Lsend(k, lmet, lobj, largs @ args, loc)
|
||||
| Lapply ap ->
|
||||
Lapply {ap with ap_args = ap.ap_args @ args; ap_loc = loc}
|
||||
|
|
|
@ -0,0 +1,28 @@
|
|||
(* TEST
|
||||
flags = "-g"
|
||||
compare_programs = "false" *)
|
||||
|
||||
let[@inline never] id x = Sys.opaque_identity x
|
||||
|
||||
class foo = object (self)
|
||||
val other = new bar "asdf"
|
||||
method go : unit =
|
||||
id (other#go 1 2 3)
|
||||
end
|
||||
and bar _v = object (self)
|
||||
method go _ _ _ : unit =
|
||||
id (self#bang)
|
||||
method bang : unit =
|
||||
raise Exit
|
||||
end
|
||||
|
||||
let () =
|
||||
Printexc.record_backtrace true;
|
||||
let obj = object (self)
|
||||
method meth : unit =
|
||||
id ((new foo)#go)
|
||||
end in
|
||||
match obj#meth with
|
||||
| _ -> assert false
|
||||
| exception Exit ->
|
||||
Printexc.print_backtrace stdout
|
|
@ -0,0 +1,5 @@
|
|||
Raised at file "methods.ml", line 16, characters 4-14
|
||||
Called from file "methods.ml", line 14, characters 7-18
|
||||
Called from file "methods.ml", line 10, characters 7-23
|
||||
Called from file "methods.ml", line 23, characters 9-23
|
||||
Called from file "methods.ml", line 25, characters 8-16
|
Loading…
Reference in New Issue